{-# LANGUAGE QuasiQuotes #-}
-- | Common logic for ActivityDiagram ActionSequences tasks
module Modelling.ActivityDiagram.Auxiliary.ActionSequences (
  actionSequencesAlloy
) where

import Modelling.ActivityDiagram.Alloy (
  adConfigToAlloy,
  moduleActionSequencesRules,
  )
import Modelling.ActivityDiagram.Config (AdConfig)

import Data.String.Interpolate (i)

-- | Common Alloy generation logic for ActionSequences tasks
actionSequencesAlloy
  :: AdConfig
  -> Maybe Bool  -- ^ Whether object nodes should appear on every path
  -> String
actionSequencesAlloy :: AdConfig -> Maybe Bool -> String
actionSequencesAlloy AdConfig
adConfig Maybe Bool
objectNodeOnEveryPath
  = String -> String -> AdConfig -> String
adConfigToAlloy String
modules String
predicates AdConfig
adConfig
  where modules :: String
modules = String
moduleActionSequencesRules
        predicates :: String
predicates =
          [i|
            noActivityFinalNodes
            someActionNodesExistInEachBlock
            #{f objectNodeOnEveryPath "checkIfStudentKnowsDifferenceBetweenObjectAndActionNodes"}
          |]
        f :: Maybe Bool -> String -> String
f Maybe Bool
opt String
s =
          case Maybe Bool
opt of
            Just Bool
True -> String
s
            Just Bool
False -> [i| not #{s}|]
            Maybe Bool
Nothing -> String
""