{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE QuasiQuotes #-}

module Modelling.ActivityDiagram.EnterAS (
  EnterASInstance(..),
  EnterASConfig(..),
  EnterASSolution(..),
  defaultEnterASConfig,
  checkEnterASConfig,
  enterASAlloy,
  checkEnterASInstance,
  enterActionSequence,
  enterASTask,
  enterASInitial,
  enterASSyntax,
  enterASEvaluation,
  enterASSolution,
  enterAS,
  defaultEnterASInstance
) where

import Capabilities.Alloy               (MonadAlloy, getInstances)
import Capabilities.PlantUml            (MonadPlantUml)
import Capabilities.WriteFile           (MonadWriteFile)
import Modelling.ActivityDiagram.ActionSequences (
  generateActionSequencesWithPetri,
  netAndMap,
  computeActionSequenceLevels,
  isFinalPetriNode,
  )
import Modelling.ActivityDiagram.Auxiliary.ActionSequences (actionSequencesAlloy)
import Modelling.ActivityDiagram.Config (
  AdConfig (..),
  checkAdConfig,
  defaultAdConfig,
  )
import Modelling.ActivityDiagram.Datatype (
  AdConnection (..),
  AdNode (..),
  UMLActivityDiagram (..),
  isActionNode,
  isObjectNode,
  )
import Modelling.ActivityDiagram.Instance (parseInstance)
import Modelling.ActivityDiagram.PetriNet (
  PetriKey,
  convertToPetriNet,
  )
import Modelling.ActivityDiagram.PlantUMLConverter (
  PlantUmlConfig (..),
  defaultPlantUmlConfig,
  drawAdToFile,
  )
import Modelling.ActivityDiagram.Shuffle (shuffleAdNames)
import Modelling.Auxiliary.Common       (getFirstInstance)
import Modelling.PetriNet.Types         (Node, PetriLike)
import Modelling.PetriNet.Reach.Type (State(..), Net(start))

import Control.Applicative (Alternative ((<|>)))
import Control.Monad (unless, when)
import Control.Monad.Catch              (MonadThrow)
import Control.OutputCapable.Blocks (
  ArticleToUse (IndefiniteArticle),
  GenericOutputCapable (..),
  LangM,
  Rated,
  OutputCapable,
  ($=<<),
  english,
  german,
  translate,
  printSolutionAndAssert,
  yesNo,
  )
import Control.Monad.Random (
  RandT,
  RandomGen,
  evalRandT,
  mkStdGen,
  )
import Data.List (intercalate, intersect)
import Data.List.Extra (nubOrd)
import qualified Data.Map as M (map)
import Data.Maybe                       (isNothing, isJust)
import Data.String.Interpolate (i, iii)
import GHC.Generics (Generic)
import Modelling.Auxiliary.Output (
  ExtraText(..),
  addPretext,
  extra
  )
import System.Random.Shuffle (shuffleM)

data EnterASInstance = EnterASInstance {
  EnterASInstance -> UMLActivityDiagram
activityDiagram :: UMLActivityDiagram,
  EnterASInstance -> PetriLike Node PetriKey
petriNet :: PetriLike Node PetriKey,
  EnterASInstance -> PlantUmlConfig
drawSettings :: PlantUmlConfig,
  EnterASInstance -> [String]
sampleSequence :: [String],
  EnterASInstance -> Bool
showSolution :: Bool,
  EnterASInstance -> ExtraText
addText :: ExtraText
} deriving (EnterASInstance -> EnterASInstance -> Bool
(EnterASInstance -> EnterASInstance -> Bool)
-> (EnterASInstance -> EnterASInstance -> Bool)
-> Eq EnterASInstance
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EnterASInstance -> EnterASInstance -> Bool
== :: EnterASInstance -> EnterASInstance -> Bool
$c/= :: EnterASInstance -> EnterASInstance -> Bool
/= :: EnterASInstance -> EnterASInstance -> Bool
Eq, (forall x. EnterASInstance -> Rep EnterASInstance x)
-> (forall x. Rep EnterASInstance x -> EnterASInstance)
-> Generic EnterASInstance
forall x. Rep EnterASInstance x -> EnterASInstance
forall x. EnterASInstance -> Rep EnterASInstance x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. EnterASInstance -> Rep EnterASInstance x
from :: forall x. EnterASInstance -> Rep EnterASInstance x
$cto :: forall x. Rep EnterASInstance x -> EnterASInstance
to :: forall x. Rep EnterASInstance x -> EnterASInstance
Generic, ReadPrec [EnterASInstance]
ReadPrec EnterASInstance
Int -> ReadS EnterASInstance
ReadS [EnterASInstance]
(Int -> ReadS EnterASInstance)
-> ReadS [EnterASInstance]
-> ReadPrec EnterASInstance
-> ReadPrec [EnterASInstance]
-> Read EnterASInstance
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS EnterASInstance
readsPrec :: Int -> ReadS EnterASInstance
$creadList :: ReadS [EnterASInstance]
readList :: ReadS [EnterASInstance]
$creadPrec :: ReadPrec EnterASInstance
readPrec :: ReadPrec EnterASInstance
$creadListPrec :: ReadPrec [EnterASInstance]
readListPrec :: ReadPrec [EnterASInstance]
Read, Int -> EnterASInstance -> ShowS
[EnterASInstance] -> ShowS
EnterASInstance -> String
(Int -> EnterASInstance -> ShowS)
-> (EnterASInstance -> String)
-> ([EnterASInstance] -> ShowS)
-> Show EnterASInstance
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EnterASInstance -> ShowS
showsPrec :: Int -> EnterASInstance -> ShowS
$cshow :: EnterASInstance -> String
show :: EnterASInstance -> String
$cshowList :: [EnterASInstance] -> ShowS
showList :: [EnterASInstance] -> ShowS
Show)

data EnterASConfig = EnterASConfig {
  EnterASConfig -> AdConfig
adConfig :: AdConfig,
  EnterASConfig -> Bool
hideBranchConditions :: Bool,
  EnterASConfig -> Maybe Integer
maxInstances :: Maybe Integer,
  EnterASConfig -> Maybe Bool
objectNodeOnEveryPath :: Maybe Bool,
  EnterASConfig -> (Int, Int)
answerLength :: !(Int, Int),
  EnterASConfig -> Bool
printSolution :: Bool,
  EnterASConfig -> ExtraText
extraText :: ExtraText
} deriving ((forall x. EnterASConfig -> Rep EnterASConfig x)
-> (forall x. Rep EnterASConfig x -> EnterASConfig)
-> Generic EnterASConfig
forall x. Rep EnterASConfig x -> EnterASConfig
forall x. EnterASConfig -> Rep EnterASConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. EnterASConfig -> Rep EnterASConfig x
from :: forall x. EnterASConfig -> Rep EnterASConfig x
$cto :: forall x. Rep EnterASConfig x -> EnterASConfig
to :: forall x. Rep EnterASConfig x -> EnterASConfig
Generic, ReadPrec [EnterASConfig]
ReadPrec EnterASConfig
Int -> ReadS EnterASConfig
ReadS [EnterASConfig]
(Int -> ReadS EnterASConfig)
-> ReadS [EnterASConfig]
-> ReadPrec EnterASConfig
-> ReadPrec [EnterASConfig]
-> Read EnterASConfig
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS EnterASConfig
readsPrec :: Int -> ReadS EnterASConfig
$creadList :: ReadS [EnterASConfig]
readList :: ReadS [EnterASConfig]
$creadPrec :: ReadPrec EnterASConfig
readPrec :: ReadPrec EnterASConfig
$creadListPrec :: ReadPrec [EnterASConfig]
readListPrec :: ReadPrec [EnterASConfig]
Read, Int -> EnterASConfig -> ShowS
[EnterASConfig] -> ShowS
EnterASConfig -> String
(Int -> EnterASConfig -> ShowS)
-> (EnterASConfig -> String)
-> ([EnterASConfig] -> ShowS)
-> Show EnterASConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EnterASConfig -> ShowS
showsPrec :: Int -> EnterASConfig -> ShowS
$cshow :: EnterASConfig -> String
show :: EnterASConfig -> String
$cshowList :: [EnterASConfig] -> ShowS
showList :: [EnterASConfig] -> ShowS
Show)

defaultEnterASConfig :: EnterASConfig
defaultEnterASConfig :: EnterASConfig
defaultEnterASConfig = EnterASConfig {
  adConfig :: AdConfig
adConfig = AdConfig
defaultAdConfig {
    actionLimits :: (Int, Int)
actionLimits = (Int
6, Int
6),
    objectNodeLimits :: (Int, Int)
objectNodeLimits = (Int
1, Int
1),
    maxNamedNodes :: Int
maxNamedNodes = Int
7,
    activityFinalNodes :: Int
activityFinalNodes = Int
0,
    flowFinalNodes :: Int
flowFinalNodes = Int
2
  },
  hideBranchConditions :: Bool
hideBranchConditions = Bool
True,
  maxInstances :: Maybe Integer
maxInstances = Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
50,
  objectNodeOnEveryPath :: Maybe Bool
objectNodeOnEveryPath = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True,
  answerLength :: (Int, Int)
answerLength = (Int
5, Int
8),
  printSolution :: Bool
printSolution = Bool
False,
  extraText :: ExtraText
extraText = ExtraText
NoExtraText
}

checkEnterASConfig :: EnterASConfig -> Maybe String
checkEnterASConfig :: EnterASConfig -> Maybe String
checkEnterASConfig EnterASConfig
conf =
  AdConfig -> Maybe String
checkAdConfig (EnterASConfig -> AdConfig
adConfig EnterASConfig
conf)
  Maybe String -> Maybe String -> Maybe String
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> EnterASConfig -> Maybe String
checkEnterASConfig' EnterASConfig
conf

checkEnterASConfig' :: EnterASConfig -> Maybe String
checkEnterASConfig' :: EnterASConfig -> Maybe String
checkEnterASConfig' EnterASConfig {
    AdConfig
adConfig :: EnterASConfig -> AdConfig
adConfig :: AdConfig
adConfig,
    Maybe Integer
maxInstances :: EnterASConfig -> Maybe Integer
maxInstances :: Maybe Integer
maxInstances,
    Maybe Bool
objectNodeOnEveryPath :: EnterASConfig -> Maybe Bool
objectNodeOnEveryPath :: Maybe Bool
objectNodeOnEveryPath,
    (Int, Int)
answerLength :: EnterASConfig -> (Int, Int)
answerLength :: (Int, Int)
answerLength
  }
  | Just Integer
instances <- Maybe Integer
maxInstances, Integer
instances Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
1
    = String -> Maybe String
forall a. a -> Maybe a
Just String
"The parameter 'maxInstances' must either be set to a positive value or to Nothing"
  | Maybe Bool
objectNodeOnEveryPath Maybe Bool -> Maybe Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True Bool -> Bool -> Bool
&& (Int, Int) -> Int
forall a b. (a, b) -> a
fst (AdConfig -> (Int, Int)
objectNodeLimits AdConfig
adConfig) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1
    = String -> Maybe String
forall a. a -> Maybe a
Just String
"Setting the parameter 'objectNodeOnEveryPath' to True implies at least 1 Object Node occurring"
  | (Int, Int) -> Int
forall a b. (a, b) -> a
fst (Int, Int)
answerLength Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0
  = String -> Maybe String
forall a. a -> Maybe a
Just String
"The parameter 'answerLength' should not contain non-negative values"
  | (Int -> Int -> Bool) -> (Int, Int) -> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
(>) (Int, Int)
answerLength
  = String -> Maybe String
forall a. a -> Maybe a
Just [iii|
    The second value of parameter 'answerLength'
    should be greater than or equal to its first value.
    |]
  | Bool
otherwise
    = Maybe String
forall a. Maybe a
Nothing

enterASAlloy :: EnterASConfig -> String
enterASAlloy :: EnterASConfig -> String
enterASAlloy EnterASConfig {
    AdConfig
adConfig :: EnterASConfig -> AdConfig
adConfig :: AdConfig
adConfig,
    Maybe Bool
objectNodeOnEveryPath :: EnterASConfig -> Maybe Bool
objectNodeOnEveryPath :: Maybe Bool
objectNodeOnEveryPath
  } = AdConfig -> Maybe Bool -> String
actionSequencesAlloy AdConfig
adConfig Maybe Bool
objectNodeOnEveryPath

checkEnterASInstance :: EnterASInstance -> Maybe String
checkEnterASInstance :: EnterASInstance -> Maybe String
checkEnterASInstance EnterASInstance
inst
  | PlantUmlConfig -> Bool
suppressNodeNames (EnterASInstance -> PlantUmlConfig
drawSettings EnterASInstance
inst)
  = String -> Maybe String
forall a. a -> Maybe a
Just String
"'suppressNodeNames' must be set to 'False' for this task type"
  | Bool
otherwise
  = Maybe String
forall a. Maybe a
Nothing

checkEnterASInstanceForConfig :: EnterASInstance -> EnterASConfig -> Maybe String
checkEnterASInstanceForConfig :: EnterASInstance -> EnterASConfig -> Maybe String
checkEnterASInstanceForConfig EnterASInstance
inst EnterASConfig {
  (Int, Int)
answerLength :: EnterASConfig -> (Int, Int)
answerLength :: (Int, Int)
answerLength
  }
  | Int
solutionLength Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< (Int, Int) -> Int
forall a b. (a, b) -> a
fst (Int, Int)
answerLength
  = String -> Maybe String
forall a. a -> Maybe a
Just [iii|
    Solution should not be shorter than
    the first value of parameter 'answerLength'.
    |]
  | Int
solutionLength Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> (Int, Int) -> Int
forall a b. (a, b) -> b
snd (Int, Int)
answerLength
  = String -> Maybe String
forall a. a -> Maybe a
Just [iii|
    Solution should not be longer than
    the second value of parameter 'answerLength'.
    |]
  | Bool
otherwise
    = Maybe String
forall a. Maybe a
Nothing
  where solutionLength :: Int
solutionLength = [String] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([String] -> Int) -> [String] -> Int
forall a b. (a -> b) -> a -> b
$ EnterASInstance -> [String]
sampleSequence EnterASInstance
inst

newtype EnterASSolution = EnterASSolution {
  EnterASSolution -> [String]
sampleSolution :: [String]
} deriving (Int -> EnterASSolution -> ShowS
[EnterASSolution] -> ShowS
EnterASSolution -> String
(Int -> EnterASSolution -> ShowS)
-> (EnterASSolution -> String)
-> ([EnterASSolution] -> ShowS)
-> Show EnterASSolution
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EnterASSolution -> ShowS
showsPrec :: Int -> EnterASSolution -> ShowS
$cshow :: EnterASSolution -> String
show :: EnterASSolution -> String
$cshowList :: [EnterASSolution] -> ShowS
showList :: [EnterASSolution] -> ShowS
Show, EnterASSolution -> EnterASSolution -> Bool
(EnterASSolution -> EnterASSolution -> Bool)
-> (EnterASSolution -> EnterASSolution -> Bool)
-> Eq EnterASSolution
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EnterASSolution -> EnterASSolution -> Bool
== :: EnterASSolution -> EnterASSolution -> Bool
$c/= :: EnterASSolution -> EnterASSolution -> Bool
/= :: EnterASSolution -> EnterASSolution -> Bool
Eq)

enterActionSequence :: PetriLike Node PetriKey -> EnterASSolution
enterActionSequence :: PetriLike Node PetriKey -> EnterASSolution
enterActionSequence PetriLike Node PetriKey
petri =
  EnterASSolution {sampleSolution :: [String]
sampleSolution = [[String]] -> [String]
forall a. HasCallStack => [a] -> a
head ([[String]] -> [String]) -> [[String]] -> [String]
forall a b. (a -> b) -> a -> b
$ PetriLike Node PetriKey -> Maybe (Int, Int) -> [[String]]
generateActionSequencesWithPetri PetriLike Node PetriKey
petri Maybe (Int, Int)
forall a. Maybe a
Nothing}

enterASTask
  :: (MonadPlantUml m, MonadWriteFile m, OutputCapable m)
  => FilePath
  -> EnterASInstance
  -> LangM m
enterASTask :: forall (m :: * -> *).
(MonadPlantUml m, MonadWriteFile m, OutputCapable m) =>
String -> EnterASInstance -> LangM m
enterASTask String
path EnterASInstance
task = do
  LangM m -> LangM m
forall l (m :: * -> *).
GenericOutputCapable l m =>
GenericLangM l m () -> GenericLangM l m ()
paragraph (LangM m -> LangM m) -> LangM m -> LangM m
forall a b. (a -> b) -> a -> b
$ State (Map Language String) () -> LangM m
forall l (m :: * -> *).
GenericOutputCapable l m =>
State (Map l String) () -> GenericLangM l m ()
translate (State (Map Language String) () -> LangM m)
-> State (Map Language String) () -> LangM m
forall a b. (a -> b) -> a -> b
$ do
    String -> State (Map Language String) ()
english String
"Consider the following activity diagram:"
    String -> State (Map Language String) ()
german String
"Betrachten Sie folgendes Aktivitätsdiagramm:"
  String -> LangM m
forall l (m :: * -> *).
GenericOutputCapable l m =>
String -> GenericLangM l m ()
image (String -> LangM m) -> m String -> LangM m
forall (m :: * -> *) a l b.
Monad m =>
(a -> GenericLangM l m b) -> m a -> GenericLangM l m b
$=<< String -> PlantUmlConfig -> UMLActivityDiagram -> m String
forall (m :: * -> *).
(MonadPlantUml m, MonadWriteFile m) =>
String -> PlantUmlConfig -> UMLActivityDiagram -> m String
drawAdToFile String
path (EnterASInstance -> PlantUmlConfig
drawSettings EnterASInstance
task) (UMLActivityDiagram -> m String) -> UMLActivityDiagram -> m String
forall a b. (a -> b) -> a -> b
$ EnterASInstance -> UMLActivityDiagram
activityDiagram EnterASInstance
task
  LangM m -> LangM m
forall l (m :: * -> *).
GenericOutputCapable l m =>
GenericLangM l m () -> GenericLangM l m ()
paragraph (LangM m -> LangM m) -> LangM m -> LangM m
forall a b. (a -> b) -> a -> b
$ do
    State (Map Language String) () -> LangM m
forall l (m :: * -> *).
GenericOutputCapable l m =>
State (Map l String) () -> GenericLangM l m ()
translate (State (Map Language String) () -> LangM m)
-> State (Map Language String) () -> LangM m
forall a b. (a -> b) -> a -> b
$ do
      String -> State (Map Language String) ()
english [iii|
        State an action sequence (i.e., a sequence of action nodes)
        which lets all flows terminate in an execution of this diagram,
        by entering a list of action names.
        \n
        For example, |]
      String -> State (Map Language String) ()
german [iii|
        Geben Sie eine Aktionsfolge (d.h., eine Folge von Aktionsknoten) an,
        welche in einem Ablauf dieses Diagramms alle Flüsse terminieren lässt,
        indem Sie eine Liste von Aktionsnamen angeben.
        \n
        Zum Beispiel drückt |]
    String -> LangM m
forall l (m :: * -> *).
GenericOutputCapable l m =>
String -> GenericLangM l m ()
code (String -> LangM m) -> String -> LangM m
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall a. Show a => a -> String
show [String]
enterASInitial
    State (Map Language String) () -> LangM m
forall l (m :: * -> *).
GenericOutputCapable l m =>
State (Map l String) () -> GenericLangM l m ()
translate (State (Map Language String) () -> LangM m)
-> State (Map Language String) () -> LangM m
forall a b. (a -> b) -> a -> b
$ do
      String -> State (Map Language String) ()
english [i|expresses the execution of A followed by B (under the assumption that both are action nodes of the diagram).|]
      String -> State (Map Language String) ()
german [i|die Ausführung von A gefolgt von B aus (unter der Annahme, dass beides Aktionsknoten des Diagramms sind).|]
    pure ()
  ExtraText -> LangM m
forall (m :: * -> *). OutputCapable m => ExtraText -> LangM m
extra (ExtraText -> LangM m) -> ExtraText -> LangM m
forall a b. (a -> b) -> a -> b
$ EnterASInstance -> ExtraText
addText EnterASInstance
task
  pure ()

enterASInitial :: [String]
enterASInitial :: [String]
enterASInitial = [String
"A", String
"B"]

enterASSyntax
  :: OutputCapable m
  => EnterASInstance
  -> [String]
  -> LangM m
enterASSyntax :: forall (m :: * -> *).
OutputCapable m =>
EnterASInstance -> [String] -> LangM m
enterASSyntax EnterASInstance
task [String]
sub = LangM' m () -> LangM' m ()
forall (m :: * -> *) a. OutputCapable m => LangM' m a -> LangM' m a
addPretext (LangM' m () -> LangM' m ()) -> LangM' m () -> LangM' m ()
forall a b. (a -> b) -> a -> b
$ do
  let adNames :: [String]
adNames = (AdNode -> String) -> [AdNode] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map AdNode -> String
name
        ([AdNode] -> [String]) -> [AdNode] -> [String]
forall a b. (a -> b) -> a -> b
$ (AdNode -> Bool) -> [AdNode] -> [AdNode]
forall a. (a -> Bool) -> [a] -> [a]
filter (\AdNode
n -> AdNode -> Bool
isActionNode AdNode
n Bool -> Bool -> Bool
|| AdNode -> Bool
isObjectNode AdNode
n)
        ([AdNode] -> [AdNode]) -> [AdNode] -> [AdNode]
forall a b. (a -> b) -> a -> b
$ UMLActivityDiagram -> [AdNode]
nodes
        (UMLActivityDiagram -> [AdNode]) -> UMLActivityDiagram -> [AdNode]
forall a b. (a -> b) -> a -> b
$ EnterASInstance -> UMLActivityDiagram
activityDiagram EnterASInstance
task
  Bool -> LangM' m () -> LangM' m ()
forall l (m :: * -> *).
GenericOutputCapable l m =>
Bool -> GenericLangM l m () -> GenericLangM l m ()
assertion ((String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
adNames) [String]
sub) (LangM' m () -> LangM' m ()) -> LangM' m () -> LangM' m ()
forall a b. (a -> b) -> a -> b
$ State (Map Language String) () -> LangM' m ()
forall l (m :: * -> *).
GenericOutputCapable l m =>
State (Map l String) () -> GenericLangM l m ()
translate (State (Map Language String) () -> LangM' m ())
-> State (Map Language String) () -> LangM' m ()
forall a b. (a -> b) -> a -> b
$ do
    String -> State (Map Language String) ()
english String
"Referenced node names are part of the given activity diagram?"
    String -> State (Map Language String) ()
german String
"Referenzierte Knotennamen sind Bestandteil des gegebenen Aktivitätsdiagramms?"

enterASEvaluation
  :: OutputCapable m
  => EnterASInstance
  -> [String]
  -> Rated m
enterASEvaluation :: forall (m :: * -> *).
OutputCapable m =>
EnterASInstance -> [String] -> Rated m
enterASEvaluation EnterASInstance
task [String]
sub = do
  let objectNames :: [String]
objectNames = (AdNode -> String) -> [AdNode] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map AdNode -> String
name ([AdNode] -> [String]) -> [AdNode] -> [String]
forall a b. (a -> b) -> a -> b
$ (AdNode -> Bool) -> [AdNode] -> [AdNode]
forall a. (a -> Bool) -> [a] -> [a]
filter AdNode -> Bool
isObjectNode ([AdNode] -> [AdNode]) -> [AdNode] -> [AdNode]
forall a b. (a -> b) -> a -> b
$ UMLActivityDiagram -> [AdNode]
nodes (UMLActivityDiagram -> [AdNode]) -> UMLActivityDiagram -> [AdNode]
forall a b. (a -> b) -> a -> b
$ EnterASInstance -> UMLActivityDiagram
activityDiagram EnterASInstance
task
      objectNamesInSubmission :: [String]
objectNamesInSubmission = [String] -> [String]
forall a. Ord a => [a] -> [a]
nubOrd ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ [String]
sub [String] -> [String] -> [String]
forall a. Eq a => [a] -> [a] -> [a]
`intersect` [String]
objectNames
      (Net PetriKey PetriKey
net, [(String, PetriKey)]
actionNameToPetriKey) = PetriLike Node PetriKey
-> (Net PetriKey PetriKey, [(String, PetriKey)])
netAndMap (EnterASInstance -> PetriLike Node PetriKey
petriNet EnterASInstance
task)
      zeroState :: State PetriKey
zeroState = Map PetriKey Int -> State PetriKey
forall s. Map s Int -> State s
State (Map PetriKey Int -> State PetriKey)
-> Map PetriKey Int -> State PetriKey
forall a b. (a -> b) -> a -> b
$ (Int -> Int) -> Map PetriKey Int -> Map PetriKey Int
forall a b k. (a -> b) -> Map k a -> Map k b
M.map (Int -> Int -> Int
forall a b. a -> b -> a
const Int
0) (Map PetriKey Int -> Map PetriKey Int)
-> Map PetriKey Int -> Map PetriKey Int
forall a b. (a -> b) -> a -> b
$ State PetriKey -> Map PetriKey Int
forall s. State s -> Map s Int
unState (State PetriKey -> Map PetriKey Int)
-> State PetriKey -> Map PetriKey Int
forall a b. (a -> b) -> a -> b
$ Net PetriKey PetriKey -> State PetriKey
forall s t. Net s t -> State s
start Net PetriKey PetriKey
net
      levels :: [[(State PetriKey, [PetriKey])]]
levels = [String]
-> Net PetriKey PetriKey
-> [(String, PetriKey)]
-> [[(State PetriKey, [PetriKey])]]
computeActionSequenceLevels [String]
sub Net PetriKey PetriKey
net [(String, PetriKey)]
actionNameToPetriKey
      reachesZeroState :: Bool
reachesZeroState = ([(State PetriKey, [PetriKey])] -> Bool)
-> [[(State PetriKey, [PetriKey])]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Maybe [PetriKey] -> Bool
forall a. Maybe a -> Bool
isJust (Maybe [PetriKey] -> Bool)
-> ([(State PetriKey, [PetriKey])] -> Maybe [PetriKey])
-> [(State PetriKey, [PetriKey])]
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State PetriKey
-> [(State PetriKey, [PetriKey])] -> Maybe [PetriKey]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup State PetriKey
zeroState) [[(State PetriKey, [PetriKey])]]
levels
      correct :: Bool
correct = [String] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
objectNamesInSubmission Bool -> Bool -> Bool
&& Bool
reachesZeroState
      points :: Rational
points = if Bool
correct then Rational
1 else Rational
0
      maybeSolutionString :: Maybe String
maybeSolutionString =
        if EnterASInstance -> Bool
showSolution EnterASInstance
task
        then String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall a. Show a => a -> String
show ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ EnterASInstance -> [String]
sampleSequence EnterASInstance
task
        else Maybe String
forall a. Maybe a
Nothing

  Bool -> LangM m -> LangM m
forall (m :: * -> *). OutputCapable m => Bool -> LangM m -> LangM m
yesNo Bool
correct (LangM m -> LangM m) -> LangM m -> LangM m
forall a b. (a -> b) -> a -> b
$ State (Map Language String) () -> LangM m
forall l (m :: * -> *).
GenericOutputCapable l m =>
State (Map l String) () -> GenericLangM l m ()
translate (State (Map Language String) () -> LangM m)
-> State (Map Language String) () -> LangM m
forall a b. (a -> b) -> a -> b
$ do
    String -> State (Map Language String) ()
english String
"The submitted action sequence is correct?"
    String -> State (Map Language String) ()
german String
"Die eingereichte Aktionsfolge ist korrekt?"

  -- Provide specific feedback for sequences that terminate some but not all flows
  Bool -> LangM m -> LangM m
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([String] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
objectNamesInSubmission Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
reachesZeroState) (LangM m -> LangM m) -> LangM m -> LangM m
forall a b. (a -> b) -> a -> b
$ do
    let finalNodeReached :: Bool
finalNodeReached = ([(State PetriKey, [PetriKey])] -> Bool)
-> [[(State PetriKey, [PetriKey])]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (((State PetriKey, [PetriKey]) -> Bool)
-> [(State PetriKey, [PetriKey])] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\(State PetriKey
_, [PetriKey]
path) -> (PetriKey -> Bool) -> [PetriKey] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any PetriKey -> Bool
isFinalPetriNode [PetriKey]
path)) [[(State PetriKey, [PetriKey])]]
levels
    Bool -> LangM m -> LangM m
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
finalNodeReached (LangM m -> LangM m) -> LangM m -> LangM m
forall a b. (a -> b) -> a -> b
$ do
      LangM m -> LangM m
forall l (m :: * -> *).
GenericOutputCapable l m =>
GenericLangM l m () -> GenericLangM l m ()
paragraph (LangM m -> LangM m) -> LangM m -> LangM m
forall a b. (a -> b) -> a -> b
$ State (Map Language String) () -> LangM m
forall l (m :: * -> *).
GenericOutputCapable l m =>
State (Map l String) () -> GenericLangM l m ()
translate (State (Map Language String) () -> LangM m)
-> State (Map Language String) () -> LangM m
forall a b. (a -> b) -> a -> b
$ do
        String -> State (Map Language String) ()
german [iii|
          Die eingereichte Sequenz erreicht ein Flussende, aber terminiert nicht alle Flüsse.
          Beachten Sie, dass das Erreichen eines Flussendes nur den hineinlaufenden Kontrollfluss beendet,
          während andere Flüsse (z.B. von einem Fork-Knoten) weiterhin aktiv bleiben können.
          Eine vollständige Lösung muss alle im Diagramm vorhandenen Flüsse terminieren.
          |]
        String -> State (Map Language String) ()
english [iii|
          The submitted sequence reaches a flow final node but does not terminate all flows.
          Note that reaching a flow final node only terminates the incoming control flow,
          while other flows (e.g., from a fork node) may remain active.
          A complete solution must terminate all flows present in the diagram.
          |]
      pure ()

  Bool -> LangM m -> LangM m
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([String] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
objectNamesInSubmission) (LangM m -> LangM m) -> LangM m -> LangM m
forall a b. (a -> b) -> a -> b
$ do
    State (Map Language String) () -> LangM m
forall l (m :: * -> *).
GenericOutputCapable l m =>
State (Map l String) () -> GenericLangM l m ()
translate (State (Map Language String) () -> LangM m)
-> State (Map Language String) () -> LangM m
forall a b. (a -> b) -> a -> b
$ do
      String -> State (Map Language String) ()
english String
"The following referenced nodes are object nodes and thus not actions:"
      String -> State (Map Language String) ()
german String
"Die folgenden referenzierten Knoten sind Objektknoten und damit keine Aktionen:"
    String -> LangM m
forall l (m :: * -> *).
GenericOutputCapable l m =>
String -> GenericLangM l m ()
code (String -> LangM m) -> String -> LangM m
forall a b. (a -> b) -> a -> b
$ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " [String]
objectNamesInSubmission
    pure ()

  ArticleToUse -> Maybe String -> Rational -> Rated m
forall (m :: * -> *).
OutputCapable m =>
ArticleToUse -> Maybe String -> Rational -> Rated m
printSolutionAndAssert ArticleToUse
IndefiniteArticle Maybe String
maybeSolutionString Rational
points

  pure Rational
points

enterASSolution
  :: EnterASInstance
  -> [String]
enterASSolution :: EnterASInstance -> [String]
enterASSolution = EnterASInstance -> [String]
sampleSequence

enterAS
  :: (MonadAlloy m, MonadThrow m)
  => EnterASConfig
  -> Int
  -> Int
  -> m EnterASInstance
enterAS :: forall (m :: * -> *).
(MonadAlloy m, MonadThrow m) =>
EnterASConfig -> Int -> Int -> m EnterASInstance
enterAS EnterASConfig
config Int
segment Int
seed = do
  let g :: StdGen
g = Int -> StdGen
mkStdGen (Int -> StdGen) -> Int -> StdGen
forall a b. (a -> b) -> a -> b
$ (Int
segment Int -> Int -> Int
forall a. Num a => a -> a -> a
+) (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
seed
  RandT StdGen m EnterASInstance -> StdGen -> m EnterASInstance
forall (m :: * -> *) g a. Monad m => RandT g m a -> g -> m a
evalRandT (EnterASConfig -> RandT StdGen m EnterASInstance
forall (m :: * -> *) g.
(MonadAlloy m, MonadThrow m, RandomGen g) =>
EnterASConfig -> RandT g m EnterASInstance
getEnterASTask EnterASConfig
config) StdGen
g

getEnterASTask
  :: (MonadAlloy m, MonadThrow m, RandomGen g)
  => EnterASConfig
  -> RandT g m EnterASInstance
getEnterASTask :: forall (m :: * -> *) g.
(MonadAlloy m, MonadThrow m, RandomGen g) =>
EnterASConfig -> RandT g m EnterASInstance
getEnterASTask EnterASConfig
config = do
  [AlloyInstance]
alloyInstances <- Maybe Integer -> Maybe Int -> String -> RandT g m [AlloyInstance]
forall (m :: * -> *).
MonadAlloy m =>
Maybe Integer -> Maybe Int -> String -> m [AlloyInstance]
getInstances
    (EnterASConfig -> Maybe Integer
maxInstances EnterASConfig
config)
    Maybe Int
forall a. Maybe a
Nothing
    (String -> RandT g m [AlloyInstance])
-> String -> RandT g m [AlloyInstance]
forall a b. (a -> b) -> a -> b
$ EnterASConfig -> String
enterASAlloy EnterASConfig
config
  [UMLActivityDiagram]
randomInstances <- [AlloyInstance] -> RandT g m [AlloyInstance]
forall (m :: * -> *) a. MonadRandom m => [a] -> m [a]
shuffleM [AlloyInstance]
alloyInstances RandT g m [AlloyInstance]
-> ([AlloyInstance] -> RandT g m [UMLActivityDiagram])
-> RandT g m [UMLActivityDiagram]
forall a b. RandT g m a -> (a -> RandT g m b) -> RandT g m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (AlloyInstance -> RandT g m UMLActivityDiagram)
-> [AlloyInstance] -> RandT g m [UMLActivityDiagram]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM AlloyInstance -> RandT g m UMLActivityDiagram
forall (m :: * -> *).
MonadThrow m =>
AlloyInstance -> m UMLActivityDiagram
parseInstance
  [UMLActivityDiagram]
ad <- (UMLActivityDiagram -> RandT g m UMLActivityDiagram)
-> [UMLActivityDiagram] -> RandT g m [UMLActivityDiagram]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (((Map String String, UMLActivityDiagram) -> UMLActivityDiagram)
-> RandT g m (Map String String, UMLActivityDiagram)
-> RandT g m UMLActivityDiagram
forall a b. (a -> b) -> RandT g m a -> RandT g m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Map String String, UMLActivityDiagram) -> UMLActivityDiagram
forall a b. (a, b) -> b
snd (RandT g m (Map String String, UMLActivityDiagram)
 -> RandT g m UMLActivityDiagram)
-> (UMLActivityDiagram
    -> RandT g m (Map String String, UMLActivityDiagram))
-> UMLActivityDiagram
-> RandT g m UMLActivityDiagram
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UMLActivityDiagram
-> RandT g m (Map String String, UMLActivityDiagram)
forall (m :: * -> *).
MonadRandom m =>
UMLActivityDiagram -> m (Map String String, UMLActivityDiagram)
shuffleAdNames) [UMLActivityDiagram]
randomInstances
  [EnterASInstance] -> RandT g m EnterASInstance
forall (m :: * -> *) a. MonadThrow m => [a] -> m a
getFirstInstance
        ([EnterASInstance] -> RandT g m EnterASInstance)
-> [EnterASInstance] -> RandT g m EnterASInstance
forall a b. (a -> b) -> a -> b
$ (EnterASInstance -> Bool) -> [EnterASInstance] -> [EnterASInstance]
forall a. (a -> Bool) -> [a] -> [a]
filter (Maybe String -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe String -> Bool)
-> (EnterASInstance -> Maybe String) -> EnterASInstance -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EnterASInstance -> EnterASConfig -> Maybe String
`checkEnterASInstanceForConfig` EnterASConfig
config))
        ([EnterASInstance] -> [EnterASInstance])
-> [EnterASInstance] -> [EnterASInstance]
forall a b. (a -> b) -> a -> b
$ (UMLActivityDiagram -> EnterASInstance)
-> [UMLActivityDiagram] -> [EnterASInstance]
forall a b. (a -> b) -> [a] -> [b]
map (\UMLActivityDiagram
x -> let petri :: PetriLike Node PetriKey
petri = UMLActivityDiagram -> PetriLike Node PetriKey
forall (p :: (* -> *) -> * -> *) (n :: * -> *).
Net p n =>
UMLActivityDiagram -> p n PetriKey
convertToPetriNet UMLActivityDiagram
x
                     in EnterASInstance {
          activityDiagram :: UMLActivityDiagram
activityDiagram=UMLActivityDiagram
x,
          petriNet :: PetriLike Node PetriKey
petriNet=PetriLike Node PetriKey
petri,
          drawSettings :: PlantUmlConfig
drawSettings = PlantUmlConfig
defaultPlantUmlConfig {
            suppressBranchConditions :: Bool
suppressBranchConditions = EnterASConfig -> Bool
hideBranchConditions EnterASConfig
config
            },
          sampleSequence :: [String]
sampleSequence = EnterASSolution -> [String]
sampleSolution (EnterASSolution -> [String]) -> EnterASSolution -> [String]
forall a b. (a -> b) -> a -> b
$ PetriLike Node PetriKey -> EnterASSolution
enterActionSequence PetriLike Node PetriKey
petri,
          showSolution :: Bool
showSolution = EnterASConfig -> Bool
printSolution EnterASConfig
config,
          addText :: ExtraText
addText = EnterASConfig -> ExtraText
extraText EnterASConfig
config
        }) [UMLActivityDiagram]
ad

defaultEnterASInstance :: EnterASInstance
defaultEnterASInstance :: EnterASInstance
defaultEnterASInstance =
 let
  ad :: UMLActivityDiagram
ad = UMLActivityDiagram {
    nodes :: [AdNode]
nodes = [
      AdActionNode {label :: Int
label = Int
1, name :: String
name = String
"A"},
      AdActionNode {label :: Int
label = Int
2, name :: String
name = String
"E"},
      AdActionNode {label :: Int
label = Int
3, name :: String
name = String
"F"},
      AdActionNode {label :: Int
label = Int
4, name :: String
name = String
"G"},
      AdActionNode {label :: Int
label = Int
5, name :: String
name = String
"D"},
      AdActionNode {label :: Int
label = Int
6, name :: String
name = String
"B"},
      AdObjectNode {label :: Int
label = Int
7, name :: String
name = String
"C"},
      AdDecisionNode {label :: Int
label = Int
8},
      AdDecisionNode {label :: Int
label = Int
9},
      AdMergeNode {label :: Int
label = Int
10},
      AdMergeNode {label :: Int
label = Int
11},
      AdForkNode {label :: Int
label = Int
12},
      AdJoinNode {label :: Int
label = Int
13},
      AdFlowFinalNode {label :: Int
label = Int
14},
      AdFlowFinalNode {label :: Int
label = Int
15},
      AdInitialNode {label :: Int
label = Int
16}
    ],
    connections :: [AdConnection]
connections = [
      AdConnection {from :: Int
from = Int
1, to :: Int
to = Int
10, guard :: String
guard = String
""},
      AdConnection {from :: Int
from = Int
2, to :: Int
to = Int
13, guard :: String
guard = String
""},
      AdConnection {from :: Int
from = Int
3, to :: Int
to = Int
10, guard :: String
guard = String
""},
      AdConnection {from :: Int
from = Int
4, to :: Int
to = Int
8, guard :: String
guard = String
""},
      AdConnection {from :: Int
from = Int
5, to :: Int
to = Int
12, guard :: String
guard = String
""},
      AdConnection {from :: Int
from = Int
6, to :: Int
to = Int
9, guard :: String
guard = String
""},
      AdConnection {from :: Int
from = Int
7, to :: Int
to = Int
5, guard :: String
guard = String
""},
      AdConnection {from :: Int
from = Int
8, to :: Int
to = Int
11, guard :: String
guard = String
"a"},
      AdConnection {from :: Int
from = Int
8, to :: Int
to = Int
13, guard :: String
guard = String
"b"},
      AdConnection {from :: Int
from = Int
9, to :: Int
to = Int
1, guard :: String
guard = String
"a"},
      AdConnection {from :: Int
from = Int
9, to :: Int
to = Int
3, guard :: String
guard = String
"b"},
      AdConnection {from :: Int
from = Int
10, to :: Int
to = Int
15, guard :: String
guard = String
""},
      AdConnection {from :: Int
from = Int
11, to :: Int
to = Int
4, guard :: String
guard = String
""},
      AdConnection {from :: Int
from = Int
12, to :: Int
to = Int
2, guard :: String
guard = String
""},
      AdConnection {from :: Int
from = Int
12, to :: Int
to = Int
6, guard :: String
guard = String
""},
      AdConnection {from :: Int
from = Int
12, to :: Int
to = Int
11, guard :: String
guard = String
""},
      AdConnection {from :: Int
from = Int
13, to :: Int
to = Int
14, guard :: String
guard = String
""},
      AdConnection {from :: Int
from = Int
16, to :: Int
to = Int
7, guard :: String
guard = String
""}
    ]
  }
 in
  EnterASInstance {
  activityDiagram :: UMLActivityDiagram
activityDiagram = UMLActivityDiagram
ad,
  petriNet :: PetriLike Node PetriKey
petriNet = UMLActivityDiagram -> PetriLike Node PetriKey
forall (p :: (* -> *) -> * -> *) (n :: * -> *).
Net p n =>
UMLActivityDiagram -> p n PetriKey
convertToPetriNet UMLActivityDiagram
ad,
  drawSettings :: PlantUmlConfig
drawSettings = PlantUmlConfig
defaultPlantUmlConfig,
  sampleSequence :: [String]
sampleSequence = [String
"D",String
"E",String
"G",String
"B",String
"F"],
  showSolution :: Bool
showSolution = Bool
False,
  addText :: ExtraText
addText = ExtraText
NoExtraText
}