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

module Modelling.ActivityDiagram.SelectAS (
  SelectASInstance(..),
  SelectASConfig(..),
  SelectASSolution(..),
  defaultSelectASConfig,
  checkSelectASConfig,
  selectASAlloy,
  checkSelectASInstance,
  selectActionSequence,
  selectASTask,
  selectASSyntax,
  selectASEvaluation,
  selectASSolution,
  selectAS,
  defaultSelectASInstance
) where

import qualified Data.Map as M (fromList, toList, keys, filter, map)
import qualified Data.Vector as V (fromList)

import Capabilities.Alloy               (MonadAlloy, getInstances)
import Capabilities.PlantUml            (MonadPlantUml)
import Capabilities.WriteFile           (MonadWriteFile)
import Modelling.ActivityDiagram.ActionSequences (
  generateActionSequencesWithPetri,
  generateActionSequenceWithPetriAndRepetition,
  validActionSequenceWithPetri,
  netAndMap
  )
import Modelling.ActivityDiagram.Auxiliary.ActionSequences (actionSequencesAlloy)
import Modelling.ActivityDiagram.PetriNet (convertToPetriNet)
import Modelling.ActivityDiagram.Config (
  AdConfig (..),
  checkAdConfig,
  defaultAdConfig,
  )
import Modelling.ActivityDiagram.Datatype (
  AdConnection (..),
  AdNode (..),
  UMLActivityDiagram (..),
  )
import Modelling.ActivityDiagram.Instance (parseInstance)
import Modelling.ActivityDiagram.PlantUMLConverter (
  PlantUmlConfig (..),
  defaultPlantUmlConfig,
  drawAdToFile,
  )
import Modelling.ActivityDiagram.Shuffle (shuffleAdNames)
import Modelling.Auxiliary.Common (
  TaskGenerationException (NoInstanceAvailable),
  )

import Control.Applicative (Alternative ((<|>)))
import Control.Monad.Catch              (MonadThrow, throwM)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Extra (firstJustM)
import Control.OutputCapable.Blocks (
  ArticleToUse (DefiniteArticle),
  GenericOutputCapable (..),
  LangM,
  OutputCapable,
  ($=<<),
  english,
  german,
  translate,
  translations,
  singleChoice,
  singleChoiceSyntax,
  )
import Control.Monad.Random (
  MonadRandom,
  RandT,
  RandomGen,
  uniform,
  evalRandT,
  mkStdGen
  )
import Control.Monad.Trans.Maybe (MaybeT(..), runMaybeT)
import Data.List (permutations, sortBy)
import Data.List.Extra (groupOn, nubOrd)
import Data.Ord (comparing)
import Data.Map (Map)
import Data.Monoid (Sum(..), getSum)
import Data.String.Interpolate          (i, iii)
import Data.Vector.Distance (Params(..), leastChanges)
import GHC.Generics (Generic)
import Modelling.Auxiliary.Output (
  ExtraText(..),
  addPretext,
  extra
  )
import System.Random.Shuffle (shuffleM)

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

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

defaultSelectASConfig :: SelectASConfig
defaultSelectASConfig :: SelectASConfig
defaultSelectASConfig = SelectASConfig {
  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,
  numberOfWrongAnswers :: Int
numberOfWrongAnswers = Int
2,
  answerLength :: (Int, Int)
answerLength = (Int
5, Int
6),
  printSolution :: Bool
printSolution = Bool
False,
  withActionRepetition :: Bool
withActionRepetition = Bool
False,
  extraText :: ExtraText
extraText = ExtraText
NoExtraText
}

checkSelectASConfig :: SelectASConfig -> Maybe String
checkSelectASConfig :: SelectASConfig -> Maybe String
checkSelectASConfig SelectASConfig
conf =
  AdConfig -> Maybe String
checkAdConfig (SelectASConfig -> AdConfig
adConfig SelectASConfig
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
<|> SelectASConfig -> Maybe String
checkSelectASConfig' SelectASConfig
conf

checkSelectASConfig' :: SelectASConfig -> Maybe String
checkSelectASConfig' :: SelectASConfig -> Maybe String
checkSelectASConfig' SelectASConfig {
    AdConfig
adConfig :: SelectASConfig -> AdConfig
adConfig :: AdConfig
adConfig,
    Maybe Integer
maxInstances :: SelectASConfig -> Maybe Integer
maxInstances :: Maybe Integer
maxInstances,
    Maybe Bool
objectNodeOnEveryPath :: SelectASConfig -> Maybe Bool
objectNodeOnEveryPath :: Maybe Bool
objectNodeOnEveryPath,
    Int
numberOfWrongAnswers :: SelectASConfig -> Int
numberOfWrongAnswers :: Int
numberOfWrongAnswers,
    (Int, Int)
answerLength :: SelectASConfig -> (Int, Int)
answerLength :: (Int, Int)
answerLength,
    Bool
withActionRepetition :: SelectASConfig -> Bool
withActionRepetition :: Bool
withActionRepetition
  }
  | 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"
  | Int
numberOfWrongAnswers Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1
    = String -> Maybe String
forall a. a -> Maybe a
Just String
"The parameter 'numberOfWrongAnswers' must be set to a positive value"
  | 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 or equal to
    its first value.
    |]
  | (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 Bool -> Bool -> Bool
&& (Int, Int) -> Int
forall a b. (a, b) -> a
fst (AdConfig -> (Int, Int)
actionLimits AdConfig
adConfig) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1
    = String -> Maybe String
forall a. a -> Maybe a
Just String
"If you want non-empty sequences, there must be action nodes in the first place."
  | Bool
withActionRepetition Bool -> Bool -> Bool
&& AdConfig -> Int
cycles 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 'withActionRepetition' to True requires at least 1 cycle in the activity diagram configuration"
  | Bool
withActionRepetition Bool -> Bool -> Bool
&& AdConfig -> Int
forkJoinPairs 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 'withActionRepetition' to True requires at least 1 fork/join pair in the activity diagram configuration"
  | Bool
withActionRepetition Bool -> Bool -> Bool
&& (Int, Int) -> Int
forall a b. (a, b) -> a
fst (Int, Int)
answerLength Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
2
    = String -> Maybe String
forall a. a -> Maybe a
Just String
"Setting 'withActionRepetition' to True requires sequences of at least 2 actions"
  | Bool -> Bool
not Bool
withActionRepetition Bool -> Bool -> Bool
&& (Int, Int) -> Int
forall a b. (a, b) -> b
snd (Int, Int)
answerLength Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> (Int, Int) -> Int
forall a b. (a, b) -> b
snd (AdConfig -> (Int, Int)
actionLimits AdConfig
adConfig)
    = String -> Maybe String
forall a. a -> Maybe a
Just String
"Setting 'withActionRepetition' to False prevents sequences that are longer than action nodes exist"
  | Bool -> Bool
not Bool
withActionRepetition Bool -> Bool -> Bool
&& (Int, Int) -> Int
forall a b. (a, b) -> a
fst (Int, Int)
answerLength Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> (Int, Int) -> Int
forall a b. (a, b) -> a
fst (AdConfig -> (Int, Int)
actionLimits AdConfig
adConfig)
    = String -> Maybe String
forall a. a -> Maybe a
Just String
"Setting 'withActionRepetition' to False means it doesn't make sense to have fewer action nodes than the minimum desired sequence length"
  | Bool
otherwise
    = Maybe String
forall a. Maybe a
Nothing

selectASAlloy :: SelectASConfig -> String
selectASAlloy :: SelectASConfig -> String
selectASAlloy SelectASConfig {
    AdConfig
adConfig :: SelectASConfig -> AdConfig
adConfig :: AdConfig
adConfig,
    Maybe Bool
objectNodeOnEveryPath :: SelectASConfig -> Maybe Bool
objectNodeOnEveryPath :: Maybe Bool
objectNodeOnEveryPath
  } = AdConfig -> Maybe Bool -> String
actionSequencesAlloy AdConfig
adConfig Maybe Bool
objectNodeOnEveryPath

checkSelectASInstance :: SelectASInstance -> Maybe String
checkSelectASInstance :: SelectASInstance -> Maybe String
checkSelectASInstance SelectASInstance
inst
  | PlantUmlConfig -> Bool
suppressNodeNames (SelectASInstance -> PlantUmlConfig
drawSettings SelectASInstance
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


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

{-|
Generate a set of one correct and multiple wrong sequences.
-}
selectActionSequence
  :: MonadRandom m
  => Bool
  -- ^ if sequences should contain at least one action twice
  -> Int
  -- ^ the number of wrong sequences to return
  -> (Int, Int)
  -- ^ how long the returned sequences should be
  -- specified by (lower, upper) bound
  -> UMLActivityDiagram
  -- ^ For which AD diagram the correct sequence should be valid
  -> MaybeT m SelectASSolution
selectActionSequence :: forall (m :: * -> *).
MonadRandom m =>
Bool
-> Int
-> (Int, Int)
-> UMLActivityDiagram
-> MaybeT m SelectASSolution
selectActionSequence Bool
withRepetition Int
numberOfWrongSequences (Int, Int)
lengthBounds UMLActivityDiagram
ad = m (Maybe SelectASSolution) -> MaybeT m SelectASSolution
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (m (Maybe SelectASSolution) -> MaybeT m SelectASSolution)
-> m (Maybe SelectASSolution) -> MaybeT m SelectASSolution
forall a b. (a -> b) -> a -> b
$ do
  let petri :: PetriLike Node PetriKey
petri = UMLActivityDiagram -> PetriLike Node PetriKey
forall (p :: (* -> *) -> * -> *) (n :: * -> *).
Net p n =>
UMLActivityDiagram -> p n PetriKey
convertToPetriNet UMLActivityDiagram
ad
  Maybe [String]
maybeCorrectSequence <- case (Bool
withRepetition, PetriLike Node PetriKey -> (Int, Int) -> Maybe (m [String])
forall (m :: * -> *).
MonadRandom m =>
PetriLike Node PetriKey -> (Int, Int) -> Maybe (m [String])
generateActionSequenceWithPetriAndRepetition PetriLike Node PetriKey
petri (Int, Int)
lengthBounds) of
    (Bool
True, Just m [String]
genAction) -> [String] -> Maybe [String]
forall a. a -> Maybe a
Just ([String] -> Maybe [String]) -> m [String] -> m (Maybe [String])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m [String]
genAction
    (Bool
True, Maybe (m [String])
Nothing) -> Maybe [String] -> m (Maybe [String])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [String]
forall a. Maybe a
Nothing
    (Bool
False, Maybe (m [String])
_) ->
      let
        validSequences :: [[String]]
validSequences = PetriLike Node PetriKey -> Maybe (Int, Int) -> [[String]]
generateActionSequencesWithPetri PetriLike Node PetriKey
petri ((Int, Int) -> Maybe (Int, Int)
forall a. a -> Maybe a
Just (Int, Int)
lengthBounds)
      in
        if [[String]] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[String]]
validSequences
        then
          Maybe [String] -> m (Maybe [String])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [String]
forall a. Maybe a
Nothing
        else
          [String] -> Maybe [String]
forall a. a -> Maybe a
Just ([String] -> Maybe [String]) -> m [String] -> m (Maybe [String])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[String]] -> m [String]
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadRandom m) =>
t a -> m a
uniform [[String]]
validSequences
  case Maybe [String]
maybeCorrectSequence of
    Maybe [String]
Nothing -> Maybe SelectASSolution -> m (Maybe SelectASSolution)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe SelectASSolution
forall a. Maybe a
Nothing
    Just [String]
correctSequence -> do
      let (Net PetriKey PetriKey
net, [(String, PetriKey)]
actionNameToPetriKey) = PetriLike Node PetriKey
-> (Net PetriKey PetriKey, [(String, PetriKey)])
netAndMap PetriLike Node PetriKey
petri
          allWrongCandidates :: [[String]]
allWrongCandidates =
            ([String] -> Bool) -> [[String]] -> [[String]]
forall a. (a -> Bool) -> [a] -> [a]
filter (\[String]
actionSeq -> Bool -> Bool
not ([String] -> Net PetriKey PetriKey -> [(String, PetriKey)] -> Bool
validActionSequenceWithPetri [String]
actionSeq Net PetriKey PetriKey
net [(String, PetriKey)]
actionNameToPetriKey)) ([[String]] -> [[String]]) -> [[String]] -> [[String]]
forall a b. (a -> b) -> a -> b
$
            (if Bool
withRepetition then [[String]] -> [[String]]
forall a. Ord a => [a] -> [a]
nubOrd else [[String]] -> [[String]]
forall a. a -> a
id) ([[String]] -> [[String]]) -> [[String]] -> [[String]]
forall a b. (a -> b) -> a -> b
$
            [String] -> [[String]]
forall a. [a] -> [[a]]
permutations [String]
correctSequence
      -- Early check: reject if insufficient candidates
      if [[String]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[String]]
allWrongCandidates Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
numberOfWrongSequences
        then Maybe SelectASSolution -> m (Maybe SelectASSolution)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe SelectASSolution
forall a. Maybe a
Nothing
        else do
          let -- Precompute edit distance parameters
              editDistParams :: Params String (String, Int, String) (Sum Int)
editDistParams = [String] -> Params String (String, Int, String) (Sum Int)
asEditDistParams [String]
correctSequence
              correctSeqVec :: Vector String
correctSeqVec = [String] -> Vector String
forall a. [a] -> Vector a
V.fromList [String]
correctSequence
              -- Pair each candidate with its distance
              candidatesWithDist :: [([String], Int)]
candidatesWithDist = ([String] -> ([String], Int)) -> [[String]] -> [([String], Int)]
forall a b. (a -> b) -> [a] -> [b]
map (\[String]
actionSeq ->
                ([String]
actionSeq, Sum Int -> Int
forall a. Sum a -> a
getSum (Sum Int -> Int) -> Sum Int -> Int
forall a b. (a -> b) -> a -> b
$ (Sum Int, [(String, Int, String)]) -> Sum Int
forall a b. (a, b) -> a
fst ((Sum Int, [(String, Int, String)]) -> Sum Int)
-> (Sum Int, [(String, Int, String)]) -> Sum Int
forall a b. (a -> b) -> a -> b
$ Params String (String, Int, String) (Sum Int)
-> Vector String
-> Vector String
-> (Sum Int, [(String, Int, String)])
forall c v o.
(Monoid c, Ord c) =>
Params v o c -> Vector v -> Vector v -> (c, [o])
leastChanges Params String (String, Int, String) (Sum Int)
editDistParams Vector String
correctSeqVec ([String] -> Vector String
forall a. [a] -> Vector a
V.fromList [String]
actionSeq))) [[String]]
allWrongCandidates
              -- Sort by distance
              sortedByDist :: [([String], Int)]
sortedByDist = (([String], Int) -> ([String], Int) -> Ordering)
-> [([String], Int)] -> [([String], Int)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ((([String], Int) -> Int)
-> ([String], Int) -> ([String], Int) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing ([String], Int) -> Int
forall a b. (a, b) -> b
snd) [([String], Int)]
candidatesWithDist
              -- Group by distance
              groupedByDist :: [[([String], Int)]]
groupedByDist = (([String], Int) -> Int)
-> [([String], Int)] -> [[([String], Int)]]
forall k a. Eq k => (a -> k) -> [a] -> [[a]]
groupOn ([String], Int) -> Int
forall a b. (a, b) -> b
snd [([String], Int)]
sortedByDist
              -- Determine how many groups we need
              ([[String]]
fullGroups, Maybe (Int, [[String]])
maybePartialGroup) = Int -> [[([String], Int)]] -> ([[String]], Maybe (Int, [[String]]))
forall a b. Int -> [[(a, b)]] -> ([a], Maybe (Int, [a]))
takeGroupsUntil Int
numberOfWrongSequences [[([String], Int)]]
groupedByDist
          -- Only shuffle the last group if it's partial, keep full groups as-is
          [[String]]
wrongSequences <- case Maybe (Int, [[String]])
maybePartialGroup of
            Maybe (Int, [[String]])
Nothing -> [[String]] -> m [[String]]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return [[String]]
fullGroups
            Just (Int
numberLeft, [[String]]
lastGroup) -> do
              [[String]]
shuffledLast <- [[String]] -> m [[String]]
forall (m :: * -> *) a. MonadRandom m => [a] -> m [a]
shuffleM [[String]]
lastGroup
              return (Int -> [[String]] -> [[String]]
forall a. Int -> [a] -> [a]
take Int
numberLeft [[String]]
shuffledLast [[String]] -> [[String]] -> [[String]]
forall a. [a] -> [a] -> [a]
++ [[String]]
fullGroups)
          return $ SelectASSolution -> Maybe SelectASSolution
forall a. a -> Maybe a
Just SelectASSolution {correctSequence :: [String]
correctSequence = [String]
correctSequence, wrongSequences :: [[String]]
wrongSequences = [[String]]
wrongSequences}
  where
    -- Helper to take groups until we have enough elements
    -- Returns (fullGroupsWeNeed, maybePartialGroupToShuffle)
    takeGroupsUntil :: Int -> [[(a,b)]] -> ([a], Maybe (Int, [a]))
    takeGroupsUntil :: forall a b. Int -> [[(a, b)]] -> ([a], Maybe (Int, [a]))
takeGroupsUntil Int
_ [] = ([], Maybe (Int, [a])
forall a. Maybe a
Nothing)
    takeGroupsUntil Int
n ([(a, b)]
g:[[(a, b)]]
gs)
      | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = ([], Maybe (Int, [a])
forall a. Maybe a
Nothing)
      | [(a, b)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(a, b)]
g Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
n = ([], (Int, [a]) -> Maybe (Int, [a])
forall a. a -> Maybe a
Just (Int
n, ((a, b) -> a) -> [(a, b)] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (a, b) -> a
forall a b. (a, b) -> a
fst [(a, b)]
g))  -- This group is enough, needs shuffling
      | Bool
otherwise = let ([a]
rest, Maybe (Int, [a])
partial) = Int -> [[(a, b)]] -> ([a], Maybe (Int, [a]))
forall a b. Int -> [[(a, b)]] -> ([a], Maybe (Int, [a]))
takeGroupsUntil (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- [(a, b)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(a, b)]
g) [[(a, b)]]
gs
                    in (((a, b) -> a) -> [(a, b)] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (a, b) -> a
forall a b. (a, b) -> a
fst [(a, b)]
g [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
rest, Maybe (Int, [a])
partial)

asEditDistParams :: [String] -> Params String (String, Int, String) (Sum Int)
asEditDistParams :: [String] -> Params String (String, Int, String) (Sum Int)
asEditDistParams [String]
xs = Params
    { equivalent :: String -> String -> Bool
equivalent = String -> String -> Bool
forall a. Eq a => a -> a -> Bool
(==)
    , delete :: Int -> String -> (String, Int, String)
delete     = \Int
n String
s    -> (String
"delete", Int
n, String
s)
    , insert :: Int -> String -> (String, Int, String)
insert     = \Int
n String
s    -> (String
"insert", Int
n, String
s)
    , substitute :: Int -> String -> String -> (String, Int, String)
substitute = \Int
n String
_ String
s' -> (String
"replace", Int
n, String
s')
    , cost :: (String, Int, String) -> Sum Int
cost = \ (String
_, Int
n, String
_) -> Int -> Sum Int
forall a. a -> Sum a
Sum (Int -> Sum Int) -> Int -> Sum Int
forall a b. (a -> b) -> a -> b
$ Int -> Int
forall a. Num a => a -> a
abs (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- ([String] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
xs Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2))
    , positionOffset :: (String, Int, String) -> Int
positionOffset = \ (String
op, Int
_, String
_) -> if String
op String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"delete" then Int
0 else Int
1
    }

selectASTask
  :: (MonadPlantUml m, MonadWriteFile m, OutputCapable m)
  => FilePath
  -> SelectASInstance
  -> LangM m
selectASTask :: forall (m :: * -> *).
(MonadPlantUml m, MonadWriteFile m, OutputCapable m) =>
String -> SelectASInstance -> LangM m
selectASTask String
path SelectASInstance
task = do
  let mapping :: [(Int, [String])]
mapping = Map Int [String] -> [(Int, [String])]
forall k a. Map k a -> [(k, a)]
M.toList (Map Int [String] -> [(Int, [String])])
-> Map Int [String] -> [(Int, [String])]
forall a b. (a -> b) -> a -> b
$ ((Bool, [String]) -> [String])
-> Map Int (Bool, [String]) -> Map Int [String]
forall a b k. (a -> b) -> Map k a -> Map k b
M.map (Bool, [String]) -> [String]
forall a b. (a, b) -> b
snd (Map Int (Bool, [String]) -> Map Int [String])
-> Map Int (Bool, [String]) -> Map Int [String]
forall a b. (a -> b) -> a -> b
$ SelectASInstance -> Map Int (Bool, [String])
actionSequences SelectASInstance
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
$ 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 (SelectASInstance -> PlantUmlConfig
drawSettings SelectASInstance
task) (UMLActivityDiagram -> m String) -> UMLActivityDiagram -> m String
forall a b. (a -> b) -> a -> b
$ SelectASInstance -> UMLActivityDiagram
activityDiagram SelectASInstance
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
$ 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 sequences given here:"
    String -> State (Map Language String) ()
german String
"Betrachten Sie die hier gegebenen Folgen:"
  (Int -> LangM m) -> [(Int, LangM m)] -> LangM m
forall a. (a -> LangM m) -> [(a, LangM m)] -> LangM m
forall l (m :: * -> *) a.
GenericOutputCapable l m =>
(a -> GenericLangM l m ())
-> [(a, GenericLangM l m ())] -> GenericLangM l m ()
enumerateM (String -> LangM m
forall l (m :: * -> *).
GenericOutputCapable l m =>
String -> GenericLangM l m ()
code (String -> LangM m) -> (Int -> String) -> Int -> LangM m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show) ([(Int, LangM m)] -> LangM m) -> [(Int, LangM m)] -> LangM m
forall a b. (a -> b) -> a -> b
$ ((Int, [String]) -> (Int, LangM m))
-> [(Int, [String])] -> [(Int, LangM m)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Int
n,[String]
xs) -> (Int
n, 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]
xs)) [(Int, [String])]
mapping
  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 [i|Which of these sequences is a valid action sequence?
State your answer by giving a number indicating the one valid action sequence among the above sequences.|]
    String -> State (Map Language String) ()
german [i|Welche dieser Folgen ist eine gültige Aktionsfolge?
Geben Sie Ihre Antwort als Zahl an, welche die eine gültige Aktionsfolge unter den obigen Folgen repräsentiert.|]
  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 [i|For example,|]
      String -> State (Map Language String) ()
german [i|Zum Beispiel würde|]
    String -> LangM m
forall l (m :: * -> *).
GenericOutputCapable l m =>
String -> GenericLangM l m ()
code String
"2"
    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|
        would indicate that sequence 2 is an executable sequence of action nodes.
        |]
      String -> State (Map Language String) ()
german  [i|
        bedeuten, dass Folge 2 eine ausführbare Folge von Aktionsknoten ist.
        |]
    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
$ SelectASInstance -> ExtraText
addText SelectASInstance
task
  pure ()

selectASSolutionToMap
  :: (MonadRandom m)
  => SelectASSolution
  -> m (Map Int (Bool, [String]))
selectASSolutionToMap :: forall (m :: * -> *).
MonadRandom m =>
SelectASSolution -> m (Map Int (Bool, [String]))
selectASSolutionToMap SelectASSolution
sol = do
  let xs :: [(Bool, [String])]
xs = (Bool
True, SelectASSolution -> [String]
correctSequence SelectASSolution
sol) (Bool, [String]) -> [(Bool, [String])] -> [(Bool, [String])]
forall a. a -> [a] -> [a]
: ([String] -> (Bool, [String])) -> [[String]] -> [(Bool, [String])]
forall a b. (a -> b) -> [a] -> [b]
map (Bool
False, ) (SelectASSolution -> [[String]]
wrongSequences SelectASSolution
sol)
  [(Bool, [String])]
solution <- [(Bool, [String])] -> m [(Bool, [String])]
forall (m :: * -> *) a. MonadRandom m => [a] -> m [a]
shuffleM [(Bool, [String])]
xs
  return $ [(Int, (Bool, [String]))] -> Map Int (Bool, [String])
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Int, (Bool, [String]))] -> Map Int (Bool, [String]))
-> [(Int, (Bool, [String]))] -> Map Int (Bool, [String])
forall a b. (a -> b) -> a -> b
$ [Int] -> [(Bool, [String])] -> [(Int, (Bool, [String]))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1..] [(Bool, [String])]
solution

selectASSyntax
  :: OutputCapable m
  => SelectASInstance
  -> Int
  -> LangM m
selectASSyntax :: forall (m :: * -> *).
OutputCapable m =>
SelectASInstance -> Int -> LangM m
selectASSyntax SelectASInstance
task Int
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 options :: [Int]
options = Map Int (Bool, [String]) -> [Int]
forall k a. Map k a -> [k]
M.keys (Map Int (Bool, [String]) -> [Int])
-> Map Int (Bool, [String]) -> [Int]
forall a b. (a -> b) -> a -> b
$ SelectASInstance -> Map Int (Bool, [String])
actionSequences SelectASInstance
task
  Bool -> [Int] -> Int -> LangM' m ()
forall (m :: * -> *) a.
(OutputCapable m, Eq a, Show a) =>
Bool -> [a] -> a -> LangM m
singleChoiceSyntax Bool
False [Int]
options Int
sub

selectASEvaluation
  :: OutputCapable m
  => SelectASInstance
  -> Int
  -> LangM m
selectASEvaluation :: forall (m :: * -> *).
OutputCapable m =>
SelectASInstance -> Int -> LangM m
selectASEvaluation SelectASInstance
task Int
n = 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 as :: Map Language String
as = State (Map Language String) () -> Map Language String
forall l a. State (Map l a) () -> Map l a
translations (State (Map Language String) () -> Map Language String)
-> State (Map Language String) () -> Map Language String
forall a b. (a -> b) -> a -> b
$ do
        String -> State (Map Language String) ()
english String
"action sequence"
        String -> State (Map Language String) ()
german String
"Aktionsfolge"
      solMap :: Map Int (Bool, [String])
solMap = SelectASInstance -> Map Int (Bool, [String])
actionSequences SelectASInstance
task
      (Int
solution, [String]
validAS) = [(Int, [String])] -> (Int, [String])
forall a. HasCallStack => [a] -> a
head ([(Int, [String])] -> (Int, [String]))
-> [(Int, [String])] -> (Int, [String])
forall a b. (a -> b) -> a -> b
$ Map Int [String] -> [(Int, [String])]
forall k a. Map k a -> [(k, a)]
M.toList (Map Int [String] -> [(Int, [String])])
-> Map Int [String] -> [(Int, [String])]
forall a b. (a -> b) -> a -> b
$ ((Bool, [String]) -> [String])
-> Map Int (Bool, [String]) -> Map Int [String]
forall a b k. (a -> b) -> Map k a -> Map k b
M.map (Bool, [String]) -> [String]
forall a b. (a, b) -> b
snd (Map Int (Bool, [String]) -> Map Int [String])
-> Map Int (Bool, [String]) -> Map Int [String]
forall a b. (a -> b) -> a -> b
$ ((Bool, [String]) -> Bool)
-> Map Int (Bool, [String]) -> Map Int (Bool, [String])
forall a k. (a -> Bool) -> Map k a -> Map k a
M.filter (Bool, [String]) -> Bool
forall a b. (a, b) -> a
fst Map Int (Bool, [String])
solMap
      solutionString :: Maybe String
solutionString =
        if SelectASInstance -> Bool
showSolution SelectASInstance
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]
validAS
        else Maybe String
forall a. Maybe a
Nothing
  ArticleToUse
-> Map Language String -> Maybe String -> Int -> Int -> LangM' m ()
forall (m :: * -> *) a.
(OutputCapable m, Eq a) =>
ArticleToUse
-> Map Language String -> Maybe String -> a -> a -> LangM m
singleChoice ArticleToUse
DefiniteArticle Map Language String
as Maybe String
solutionString Int
solution Int
n

selectASSolution
  :: SelectASInstance
  -> Int
selectASSolution :: SelectASInstance -> Int
selectASSolution = [Int] -> Int
forall a. HasCallStack => [a] -> a
head ([Int] -> Int)
-> (SelectASInstance -> [Int]) -> SelectASInstance -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Int (Bool, [String]) -> [Int]
forall k a. Map k a -> [k]
M.keys (Map Int (Bool, [String]) -> [Int])
-> (SelectASInstance -> Map Int (Bool, [String]))
-> SelectASInstance
-> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Bool, [String]) -> Bool)
-> Map Int (Bool, [String]) -> Map Int (Bool, [String])
forall a k. (a -> Bool) -> Map k a -> Map k a
M.filter (Bool, [String]) -> Bool
forall a b. (a, b) -> a
fst (Map Int (Bool, [String]) -> Map Int (Bool, [String]))
-> (SelectASInstance -> Map Int (Bool, [String]))
-> SelectASInstance
-> Map Int (Bool, [String])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SelectASInstance -> Map Int (Bool, [String])
actionSequences

selectAS
  :: (MonadAlloy m, MonadThrow m)
  => SelectASConfig
  -> Int
  -> Int
  -> m SelectASInstance
selectAS :: forall (m :: * -> *).
(MonadAlloy m, MonadThrow m) =>
SelectASConfig -> Int -> Int -> m SelectASInstance
selectAS SelectASConfig
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 SelectASInstance -> StdGen -> m SelectASInstance
forall (m :: * -> *) g a. Monad m => RandT g m a -> g -> m a
evalRandT (SelectASConfig -> RandT StdGen m SelectASInstance
forall (m :: * -> *) g.
(MonadAlloy m, MonadThrow m, RandomGen g) =>
SelectASConfig -> RandT g m SelectASInstance
getSelectASTask SelectASConfig
config) StdGen
g

getSelectASTask
  :: (MonadAlloy m, MonadThrow m, RandomGen g)
  => SelectASConfig
  -> RandT g m SelectASInstance
getSelectASTask :: forall (m :: * -> *) g.
(MonadAlloy m, MonadThrow m, RandomGen g) =>
SelectASConfig -> RandT g m SelectASInstance
getSelectASTask SelectASConfig
config = do
  [AlloyInstance]
instances <- Maybe Integer -> Maybe Int -> String -> RandT g m [AlloyInstance]
forall (m :: * -> *).
MonadAlloy m =>
Maybe Integer -> Maybe Int -> String -> m [AlloyInstance]
getInstances
    (SelectASConfig -> Maybe Integer
maxInstances SelectASConfig
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
$ SelectASConfig -> String
selectASAlloy SelectASConfig
config
  [UMLActivityDiagram]
randomInstances <- [AlloyInstance] -> RandT g m [AlloyInstance]
forall (m :: * -> *) a. MonadRandom m => [a] -> m [a]
shuffleM [AlloyInstance]
instances 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
  Maybe SelectASInstance
validInstances <- (UMLActivityDiagram -> RandT g m (Maybe SelectASInstance))
-> [UMLActivityDiagram] -> RandT g m (Maybe SelectASInstance)
forall (m :: * -> *) a b.
Monad m =>
(a -> m (Maybe b)) -> [a] -> m (Maybe b)
firstJustM (\UMLActivityDiagram
x -> MaybeT (RandT g m) SelectASInstance
-> RandT g m (Maybe SelectASInstance)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT (RandT g m) SelectASInstance
 -> RandT g m (Maybe SelectASInstance))
-> MaybeT (RandT g m) SelectASInstance
-> RandT g m (Maybe SelectASInstance)
forall a b. (a -> b) -> a -> b
$ do
      SelectASSolution
solution <- Bool
-> Int
-> (Int, Int)
-> UMLActivityDiagram
-> MaybeT (RandT g m) SelectASSolution
forall (m :: * -> *).
MonadRandom m =>
Bool
-> Int
-> (Int, Int)
-> UMLActivityDiagram
-> MaybeT m SelectASSolution
selectActionSequence (SelectASConfig -> Bool
withActionRepetition SelectASConfig
config) (SelectASConfig -> Int
numberOfWrongAnswers SelectASConfig
config) (SelectASConfig -> (Int, Int)
answerLength SelectASConfig
config) UMLActivityDiagram
x
      Map Int (Bool, [String])
actionSequences <- RandT g m (Map Int (Bool, [String]))
-> MaybeT (RandT g m) (Map Int (Bool, [String]))
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (RandT g m (Map Int (Bool, [String]))
 -> MaybeT (RandT g m) (Map Int (Bool, [String])))
-> RandT g m (Map Int (Bool, [String]))
-> MaybeT (RandT g m) (Map Int (Bool, [String]))
forall a b. (a -> b) -> a -> b
$ SelectASSolution -> RandT g m (Map Int (Bool, [String]))
forall (m :: * -> *).
MonadRandom m =>
SelectASSolution -> m (Map Int (Bool, [String]))
selectASSolutionToMap SelectASSolution
solution
      return SelectASInstance {
            activityDiagram :: UMLActivityDiagram
activityDiagram = UMLActivityDiagram
x,
            actionSequences :: Map Int (Bool, [String])
actionSequences = Map Int (Bool, [String])
actionSequences,
            drawSettings :: PlantUmlConfig
drawSettings = PlantUmlConfig
defaultPlantUmlConfig {
              suppressBranchConditions :: Bool
suppressBranchConditions = SelectASConfig -> Bool
hideBranchConditions SelectASConfig
config
              },
            showSolution :: Bool
showSolution = SelectASConfig -> Bool
printSolution SelectASConfig
config,
            addText :: ExtraText
addText = SelectASConfig -> ExtraText
extraText SelectASConfig
config
          }
    ) [UMLActivityDiagram]
ad
  case Maybe SelectASInstance
validInstances of
    Just SelectASInstance
x -> SelectASInstance -> RandT g m SelectASInstance
forall a. a -> RandT g m a
forall (m :: * -> *) a. Monad m => a -> m a
return SelectASInstance
x
    Maybe SelectASInstance
Nothing -> TaskGenerationException -> RandT g m SelectASInstance
forall e a. Exception e => e -> RandT g m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM TaskGenerationException
NoInstanceAvailable

defaultSelectASInstance :: SelectASInstance
defaultSelectASInstance :: SelectASInstance
defaultSelectASInstance = SelectASInstance {
  activityDiagram :: UMLActivityDiagram
activityDiagram = UMLActivityDiagram {
    nodes :: [AdNode]
nodes = [
      AdActionNode {label :: Int
label = Int
1, name :: String
name = String
"E"},
      AdActionNode {label :: Int
label = Int
2, name :: String
name = String
"D"},
      AdActionNode {label :: Int
label = Int
3, name :: String
name = String
"A"},
      AdActionNode {label :: Int
label = Int
4, name :: String
name = String
"C"},
      AdActionNode {label :: Int
label = Int
5, name :: String
name = String
"F"},
      AdActionNode {label :: Int
label = Int
6, name :: String
name = String
"B"},
      AdDecisionNode {label :: Int
label = Int
7},
      AdDecisionNode {label :: Int
label = Int
8},
      AdMergeNode {label :: Int
label = Int
9},
      AdMergeNode {label :: Int
label = Int
10},
      AdForkNode {label :: Int
label = Int
11},
      AdJoinNode {label :: Int
label = Int
12},
      AdFlowFinalNode {label :: Int
label = Int
13},
      AdFlowFinalNode {label :: Int
label = Int
14},
      AdInitialNode {label :: Int
label = Int
15}
    ],
    connections :: [AdConnection]
connections = [
      AdConnection {from :: Int
from = Int
1, to :: Int
to = Int
8, guard :: String
guard = String
""},
      AdConnection {from :: Int
from = Int
2, to :: Int
to = Int
14, guard :: String
guard = String
""},
      AdConnection {from :: Int
from = Int
3, to :: Int
to = Int
11, guard :: String
guard = String
""},
      AdConnection {from :: Int
from = Int
4, to :: Int
to = Int
12, guard :: String
guard = String
""},
      AdConnection {from :: Int
from = Int
5, to :: Int
to = Int
10, guard :: String
guard = String
""},
      AdConnection {from :: Int
from = Int
6, to :: Int
to = Int
12, guard :: String
guard = String
""},
      AdConnection {from :: Int
from = Int
7, to :: Int
to = Int
5, guard :: String
guard = String
"c"},
      AdConnection {from :: Int
from = Int
7, to :: Int
to = Int
9, guard :: String
guard = String
"a"},
      AdConnection {from :: Int
from = Int
8, to :: Int
to = Int
9, guard :: String
guard = String
"c"},
      AdConnection {from :: Int
from = Int
8, to :: Int
to = Int
10, guard :: String
guard = String
"b"},
      AdConnection {from :: Int
from = Int
9, to :: Int
to = Int
1, guard :: String
guard = String
""},
      AdConnection {from :: Int
from = Int
10, to :: Int
to = Int
3, guard :: String
guard = String
""},
      AdConnection {from :: Int
from = Int
11, to :: Int
to = Int
2, guard :: String
guard = String
""},
      AdConnection {from :: Int
from = Int
11, to :: Int
to = Int
4, guard :: String
guard = String
""},
      AdConnection {from :: Int
from = Int
11, to :: Int
to = Int
6, guard :: String
guard = String
""},
      AdConnection {from :: Int
from = Int
12, to :: Int
to = Int
13, guard :: String
guard = String
""},
      AdConnection {from :: Int
from = Int
15, to :: Int
to = Int
7, guard :: String
guard = String
""}
    ]
  },
  actionSequences :: Map Int (Bool, [String])
actionSequences = [(Int, (Bool, [String]))] -> Map Int (Bool, [String])
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [
    (Int
1, (Bool
False,[String
"F",String
"B",String
"A",String
"C",String
"D"])),
    (Int
2, (Bool
True,[String
"F",String
"A",String
"B",String
"C",String
"D"])),
    (Int
3, (Bool
False,[String
"A",String
"F",String
"B",String
"C",String
"D"]))
    ],
  drawSettings :: PlantUmlConfig
drawSettings = PlantUmlConfig
defaultPlantUmlConfig,
  showSolution :: Bool
showSolution = Bool
False,
  addText :: ExtraText
addText = ExtraText
NoExtraText
}