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

module Modelling.ActivityDiagram.MatchAd (
  MatchAdConfig (..),
  MatchAdInstance (..),
  MatchAdSolution (..),
  checkMatchAdConfig,
  defaultMatchAdConfig,
  defaultMatchAdInstance,
  matchAd,
  matchAdAlloy,
  matchAdEvaluation,
  matchAdInitial,
  matchAdSolution,
  matchAdSyntax,
  matchAdTask,
 ) where

import qualified Data.Map as M (fromList, keys)

import Capabilities.Alloy               (MonadAlloy, getInstances)
import Capabilities.PlantUml            (MonadPlantUml)
import Capabilities.WriteFile           (MonadWriteFile)
import Modelling.ActivityDiagram.Alloy  (adConfigToAlloy)
import Modelling.ActivityDiagram.Config (
  AdConfig (..),
  checkAdConfig,
  defaultAdConfig,
  )
import Modelling.ActivityDiagram.Datatype (
  UMLActivityDiagram(..),
  AdNode (..),
  AdConnection (..),
  isActionNode, isObjectNode, isDecisionNode, isMergeNode, isForkNode, isJoinNode, isInitialNode, isActivityFinalNode, isFlowFinalNode)
import Modelling.ActivityDiagram.Instance (parseInstance)
import Modelling.ActivityDiagram.PlantUMLConverter (
  PlantUmlConfig (..),
  defaultPlantUmlConfig,
  drawAdToFile,
  )
import Modelling.ActivityDiagram.Shuffle (shuffleAdNames)
import Modelling.Auxiliary.Common       (getFirstInstance)

import Control.Applicative (Alternative ((<|>)))
import Control.Monad.Catch              (MonadThrow)
import Control.OutputCapable.Blocks (
  ArticleToUse (DefiniteArticle),
  GenericOutputCapable (..),
  LangM,
  Language,
  Rated,
  OutputCapable,
  ($=<<),
  english,
  german,
  translate,
  translations,
  multipleChoice,
  )
import Control.Monad.Random (
  RandT,
  RandomGen,
  evalRandT,
  mkStdGen
  )
import Data.List (sort)
import Data.Map (Map)
import Data.Maybe (isJust, isNothing, fromJust)
import Data.String.Interpolate (i, iii)
import GHC.Generics (Generic)
import Modelling.Auxiliary.Output (
  addPretext,
  extra
  )
import System.Random.Shuffle (shuffleM)

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

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

defaultMatchAdConfig :: MatchAdConfig
defaultMatchAdConfig :: MatchAdConfig
defaultMatchAdConfig = MatchAdConfig {
  adConfig :: AdConfig
adConfig = AdConfig
defaultAdConfig,
  maxInstances :: Maybe Integer
maxInstances = Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
50,
  hideBranchConditions :: Bool
hideBranchConditions = Bool
False,
  withActivityFinalInForkBlocks :: Maybe Bool
withActivityFinalInForkBlocks = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True,
  printSolution :: Bool
printSolution = Bool
False,
  extraText :: Maybe (Map Language String)
extraText = Maybe (Map Language String)
forall a. Maybe a
Nothing
}

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

checkMatchAdConfig' :: MatchAdConfig -> Maybe String
checkMatchAdConfig' :: MatchAdConfig -> Maybe String
checkMatchAdConfig' MatchAdConfig {
    AdConfig
adConfig :: MatchAdConfig -> AdConfig
adConfig :: AdConfig
adConfig,
    Maybe Integer
maxInstances :: MatchAdConfig -> Maybe Integer
maxInstances :: Maybe Integer
maxInstances,
    Maybe Bool
withActivityFinalInForkBlocks :: MatchAdConfig -> Maybe Bool
withActivityFinalInForkBlocks :: Maybe Bool
withActivityFinalInForkBlocks
  }
  | Maybe Integer -> Bool
forall a. Maybe a -> Bool
isJust Maybe Integer
maxInstances Bool -> Bool -> Bool
&& Maybe Integer -> Integer
forall a. HasCallStack => Maybe a -> a
fromJust Maybe Integer
maxInstances 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
withActivityFinalInForkBlocks Maybe Bool -> Maybe Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False Bool -> Bool -> Bool
&& AdConfig -> Int
activityFinalNodes 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 'withActivityFinalInForkBlocks' to 'Just False' prohibits having more than 1 Activity Final Node"
  | Maybe Bool
withActivityFinalInForkBlocks 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
&& AdConfig -> Int
activityFinalNodes 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 'withActivityFinalInForkBlocks' to 'Just True' requires having at least 1 Activity Final Node"
  | Maybe Bool -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Bool
withActivityFinalInForkBlocks Bool -> Bool -> Bool
&& AdConfig -> Int
activityFinalNodes AdConfig
adConfig Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1
    = String -> Maybe String
forall a. a -> Maybe a
Just String
"Having no Activity Final Node means setting the parameter 'withActivityFinalInForkBlocks' to Nothing makes no sense."
  | Bool
otherwise
    = Maybe String
forall a. Maybe a
Nothing

matchAdAlloy :: MatchAdConfig -> String
matchAdAlloy :: MatchAdConfig -> String
matchAdAlloy MatchAdConfig {
    AdConfig
adConfig :: MatchAdConfig -> AdConfig
adConfig :: AdConfig
adConfig,
    Maybe Bool
withActivityFinalInForkBlocks :: MatchAdConfig -> Maybe Bool
withActivityFinalInForkBlocks :: Maybe Bool
withActivityFinalInForkBlocks
  }
  = String -> String -> AdConfig -> String
adConfigToAlloy String
"" String
predicates AdConfig
adConfig
  where
    predicates :: String
predicates =
      [i|
        #{f (not <$> withActivityFinalInForkBlocks) "noActivityFinalInForkBlocks"}
      |]
    f :: Maybe Bool -> ShowS
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
""

data MatchAdSolution = MatchAdSolution {
  MatchAdSolution -> [String]
actionNodeNames :: [String],
  MatchAdSolution -> [String]
objectNodeNames :: [String],
  MatchAdSolution -> Int
countOfDecisionNodes :: Int,
  MatchAdSolution -> Int
countOfMergeNodes :: Int,
  MatchAdSolution -> Int
countOfForks :: Int,
  MatchAdSolution -> Int
countOfJoins :: Int,
  MatchAdSolution -> Int
countOfInitialNodes :: Int,
  MatchAdSolution -> Int
countOfActivityFinalNodes :: Int,
  MatchAdSolution -> Int
countOfFlowFinalNodes :: Int
} deriving ((forall x. MatchAdSolution -> Rep MatchAdSolution x)
-> (forall x. Rep MatchAdSolution x -> MatchAdSolution)
-> Generic MatchAdSolution
forall x. Rep MatchAdSolution x -> MatchAdSolution
forall x. MatchAdSolution -> Rep MatchAdSolution x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. MatchAdSolution -> Rep MatchAdSolution x
from :: forall x. MatchAdSolution -> Rep MatchAdSolution x
$cto :: forall x. Rep MatchAdSolution x -> MatchAdSolution
to :: forall x. Rep MatchAdSolution x -> MatchAdSolution
Generic, MatchAdSolution -> MatchAdSolution -> Bool
(MatchAdSolution -> MatchAdSolution -> Bool)
-> (MatchAdSolution -> MatchAdSolution -> Bool)
-> Eq MatchAdSolution
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MatchAdSolution -> MatchAdSolution -> Bool
== :: MatchAdSolution -> MatchAdSolution -> Bool
$c/= :: MatchAdSolution -> MatchAdSolution -> Bool
/= :: MatchAdSolution -> MatchAdSolution -> Bool
Eq, Int -> MatchAdSolution -> ShowS
[MatchAdSolution] -> ShowS
MatchAdSolution -> String
(Int -> MatchAdSolution -> ShowS)
-> (MatchAdSolution -> String)
-> ([MatchAdSolution] -> ShowS)
-> Show MatchAdSolution
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MatchAdSolution -> ShowS
showsPrec :: Int -> MatchAdSolution -> ShowS
$cshow :: MatchAdSolution -> String
show :: MatchAdSolution -> String
$cshowList :: [MatchAdSolution] -> ShowS
showList :: [MatchAdSolution] -> ShowS
Show, ReadPrec [MatchAdSolution]
ReadPrec MatchAdSolution
Int -> ReadS MatchAdSolution
ReadS [MatchAdSolution]
(Int -> ReadS MatchAdSolution)
-> ReadS [MatchAdSolution]
-> ReadPrec MatchAdSolution
-> ReadPrec [MatchAdSolution]
-> Read MatchAdSolution
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS MatchAdSolution
readsPrec :: Int -> ReadS MatchAdSolution
$creadList :: ReadS [MatchAdSolution]
readList :: ReadS [MatchAdSolution]
$creadPrec :: ReadPrec MatchAdSolution
readPrec :: ReadPrec MatchAdSolution
$creadListPrec :: ReadPrec [MatchAdSolution]
readListPrec :: ReadPrec [MatchAdSolution]
Read)

matchAdSolution :: MatchAdInstance -> MatchAdSolution
matchAdSolution :: MatchAdInstance -> MatchAdSolution
matchAdSolution MatchAdInstance
task =
  let ad :: UMLActivityDiagram
ad = MatchAdInstance -> UMLActivityDiagram
activityDiagram MatchAdInstance
task
  in MatchAdSolution {
        actionNodeNames :: [String]
actionNodeNames = [String] -> [String]
forall a. Ord a => [a] -> [a]
sort ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ (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
isActionNode ([AdNode] -> [AdNode]) -> [AdNode] -> [AdNode]
forall a b. (a -> b) -> a -> b
$ UMLActivityDiagram -> [AdNode]
nodes UMLActivityDiagram
ad,
        objectNodeNames :: [String]
objectNodeNames = [String] -> [String]
forall a. Ord a => [a] -> [a]
sort ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ (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
ad,
        countOfDecisionNodes :: Int
countOfDecisionNodes = [AdNode] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([AdNode] -> Int) -> [AdNode] -> Int
forall a b. (a -> b) -> a -> b
$ (AdNode -> Bool) -> [AdNode] -> [AdNode]
forall a. (a -> Bool) -> [a] -> [a]
filter AdNode -> Bool
isDecisionNode  ([AdNode] -> [AdNode]) -> [AdNode] -> [AdNode]
forall a b. (a -> b) -> a -> b
$ UMLActivityDiagram -> [AdNode]
nodes UMLActivityDiagram
ad,
        countOfMergeNodes :: Int
countOfMergeNodes = [AdNode] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([AdNode] -> Int) -> [AdNode] -> Int
forall a b. (a -> b) -> a -> b
$ (AdNode -> Bool) -> [AdNode] -> [AdNode]
forall a. (a -> Bool) -> [a] -> [a]
filter AdNode -> Bool
isMergeNode ([AdNode] -> [AdNode]) -> [AdNode] -> [AdNode]
forall a b. (a -> b) -> a -> b
$ UMLActivityDiagram -> [AdNode]
nodes UMLActivityDiagram
ad,
        countOfForks :: Int
countOfForks = [AdNode] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([AdNode] -> Int) -> [AdNode] -> Int
forall a b. (a -> b) -> a -> b
$ (AdNode -> Bool) -> [AdNode] -> [AdNode]
forall a. (a -> Bool) -> [a] -> [a]
filter AdNode -> Bool
isForkNode ([AdNode] -> [AdNode]) -> [AdNode] -> [AdNode]
forall a b. (a -> b) -> a -> b
$ UMLActivityDiagram -> [AdNode]
nodes UMLActivityDiagram
ad,
        countOfJoins :: Int
countOfJoins = [AdNode] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([AdNode] -> Int) -> [AdNode] -> Int
forall a b. (a -> b) -> a -> b
$ (AdNode -> Bool) -> [AdNode] -> [AdNode]
forall a. (a -> Bool) -> [a] -> [a]
filter AdNode -> Bool
isJoinNode  ([AdNode] -> [AdNode]) -> [AdNode] -> [AdNode]
forall a b. (a -> b) -> a -> b
$ UMLActivityDiagram -> [AdNode]
nodes UMLActivityDiagram
ad,
        countOfInitialNodes :: Int
countOfInitialNodes = [AdNode] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([AdNode] -> Int) -> [AdNode] -> Int
forall a b. (a -> b) -> a -> b
$ (AdNode -> Bool) -> [AdNode] -> [AdNode]
forall a. (a -> Bool) -> [a] -> [a]
filter AdNode -> Bool
isInitialNode ([AdNode] -> [AdNode]) -> [AdNode] -> [AdNode]
forall a b. (a -> b) -> a -> b
$ UMLActivityDiagram -> [AdNode]
nodes UMLActivityDiagram
ad,
        countOfActivityFinalNodes :: Int
countOfActivityFinalNodes = [AdNode] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([AdNode] -> Int) -> [AdNode] -> Int
forall a b. (a -> b) -> a -> b
$ (AdNode -> Bool) -> [AdNode] -> [AdNode]
forall a. (a -> Bool) -> [a] -> [a]
filter AdNode -> Bool
isActivityFinalNode ([AdNode] -> [AdNode]) -> [AdNode] -> [AdNode]
forall a b. (a -> b) -> a -> b
$ UMLActivityDiagram -> [AdNode]
nodes UMLActivityDiagram
ad,
        countOfFlowFinalNodes :: Int
countOfFlowFinalNodes = [AdNode] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([AdNode] -> Int) -> [AdNode] -> Int
forall a b. (a -> b) -> a -> b
$ (AdNode -> Bool) -> [AdNode] -> [AdNode]
forall a. (a -> Bool) -> [a] -> [a]
filter AdNode -> Bool
isFlowFinalNode ([AdNode] -> [AdNode]) -> [AdNode] -> [AdNode]
forall a b. (a -> b) -> a -> b
$ UMLActivityDiagram -> [AdNode]
nodes UMLActivityDiagram
ad
    }

matchAdTask
  :: (MonadPlantUml m, MonadWriteFile m, OutputCapable m)
  => FilePath
  -> MatchAdInstance
  -> LangM m
matchAdTask :: forall (m :: * -> *).
(MonadPlantUml m, MonadWriteFile m, OutputCapable m) =>
String -> MatchAdInstance -> LangM m
matchAdTask String
path MatchAdInstance
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 (MatchAdInstance -> PlantUmlConfig
plantUMLConf MatchAdInstance
task) (UMLActivityDiagram -> m String) -> UMLActivityDiagram -> m String
forall a b. (a -> b) -> a -> b
$ MatchAdInstance -> UMLActivityDiagram
activityDiagram MatchAdInstance
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 [iii|
      State the names of all action nodes, the names of all object nodes,
      and the count of each other kind of element for the given activity diagram.
      |]
    String -> State (Map Language String) ()
german [iii|
      Geben Sie die Namen aller Aktionsknoten, die Namen aller Objektknoten,
      sowie die Anzahl jeder anderen Art von Element für
      das gegebene Aktivitätsdiagramm an.
      |]
  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|To do this, enter your answer as in the following example:|]
      String -> State (Map Language String) ()
german [i|Geben Sie dazu Ihre Antwort wie im folgenden Beispiel an:|]
    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
$ MatchAdSolution -> String
forall a. Show a => a -> String
show MatchAdSolution
matchAdInitial
    pure ()

  Maybe (Map Language String) -> LangM m
forall (m :: * -> *).
OutputCapable m =>
Maybe (Map Language String) -> LangM m
extra (Maybe (Map Language String) -> LangM m)
-> Maybe (Map Language String) -> LangM m
forall a b. (a -> b) -> a -> b
$ MatchAdInstance -> Maybe (Map Language String)
addText MatchAdInstance
task

  pure ()

matchAdInitial :: MatchAdSolution
matchAdInitial :: MatchAdSolution
matchAdInitial = MatchAdSolution {
  actionNodeNames :: [String]
actionNodeNames = [String
"A", String
"B"],
  objectNodeNames :: [String]
objectNodeNames = [String
"C", String
"D"],
  countOfDecisionNodes :: Int
countOfDecisionNodes = Int
2,
  countOfMergeNodes :: Int
countOfMergeNodes = Int
2,
  countOfForks :: Int
countOfForks = Int
0,
  countOfJoins :: Int
countOfJoins = Int
0,
  countOfInitialNodes :: Int
countOfInitialNodes = Int
1,
  countOfActivityFinalNodes :: Int
countOfActivityFinalNodes = Int
1,
  countOfFlowFinalNodes :: Int
countOfFlowFinalNodes = Int
0
}

matchAdSyntax
  :: OutputCapable m
  => MatchAdInstance
  -> MatchAdSolution
  -> LangM m
matchAdSyntax :: forall (m :: * -> *).
OutputCapable m =>
MatchAdInstance -> MatchAdSolution -> LangM m
matchAdSyntax MatchAdInstance
task MatchAdSolution
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
$ MatchAdInstance -> UMLActivityDiagram
activityDiagram MatchAdInstance
task
      subNames :: [String]
subNames = MatchAdSolution -> [String]
actionNodeNames MatchAdSolution
sub [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ MatchAdSolution -> [String]
objectNodeNames MatchAdSolution
sub
  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]
subNames) (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?"

matchAdEvaluation
  :: OutputCapable m
  => MatchAdInstance
  -> MatchAdSolution
  -> Rated m
matchAdEvaluation :: forall (m :: * -> *).
OutputCapable m =>
MatchAdInstance -> MatchAdSolution -> Rated m
matchAdEvaluation MatchAdInstance
task MatchAdSolution
sub = LangM' m Rational -> LangM' m Rational
forall (m :: * -> *) a. OutputCapable m => LangM' m a -> LangM' m a
addPretext (LangM' m Rational -> LangM' m Rational)
-> LangM' m Rational -> LangM' m Rational
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
"answer parts"
        String -> State (Map Language String) ()
german String
"Teilantworten"
      sol :: MatchAdSolution
sol = MatchAdInstance -> MatchAdSolution
matchAdSolution MatchAdInstance
task
      solutionString :: Maybe String
solutionString =
        if MatchAdInstance -> Bool
showSolution MatchAdInstance
task
        then String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ MatchAdSolution -> String
forall a. Show a => a -> String
show MatchAdSolution
sol
        else Maybe String
forall a. Maybe a
Nothing
      solution :: Map (Int, Either [String] Int) Bool
solution = MatchAdSolution -> Map (Int, Either [String] Int) Bool
matchAdSolutionMap MatchAdSolution
sol
      sub' :: [(Int, Either [String] Int)]
sub' = Map (Int, Either [String] Int) Bool -> [(Int, Either [String] Int)]
forall k a. Map k a -> [k]
M.keys (Map (Int, Either [String] Int) Bool
 -> [(Int, Either [String] Int)])
-> Map (Int, Either [String] Int) Bool
-> [(Int, Either [String] Int)]
forall a b. (a -> b) -> a -> b
$ MatchAdSolution -> Map (Int, Either [String] Int) Bool
matchAdSolutionMap MatchAdSolution
sub
  ArticleToUse
-> Map Language String
-> Maybe String
-> Map (Int, Either [String] Int) Bool
-> [(Int, Either [String] Int)]
-> LangM' m Rational
forall (m :: * -> *) a.
(OutputCapable m, Ord a) =>
ArticleToUse
-> Map Language String
-> Maybe String
-> Map a Bool
-> [a]
-> Rated m
multipleChoice ArticleToUse
DefiniteArticle Map Language String
as Maybe String
solutionString Map (Int, Either [String] Int) Bool
solution [(Int, Either [String] Int)]
sub'

matchAdSolutionMap
  :: MatchAdSolution
  -> Map (Int, Either [String] Int) Bool
matchAdSolutionMap :: MatchAdSolution -> Map (Int, Either [String] Int) Bool
matchAdSolutionMap MatchAdSolution
sol =
  let xs :: [Either [String] Int]
xs = [
        [String] -> Either [String] Int
forall a b. a -> Either a b
Left ([String] -> Either [String] Int)
-> [String] -> Either [String] Int
forall a b. (a -> b) -> a -> b
$ [String] -> [String]
forall a. Ord a => [a] -> [a]
sort ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ MatchAdSolution -> [String]
actionNodeNames MatchAdSolution
sol,
        [String] -> Either [String] Int
forall a b. a -> Either a b
Left ([String] -> Either [String] Int)
-> [String] -> Either [String] Int
forall a b. (a -> b) -> a -> b
$ [String] -> [String]
forall a. Ord a => [a] -> [a]
sort ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ MatchAdSolution -> [String]
objectNodeNames MatchAdSolution
sol,
        Int -> Either [String] Int
forall a b. b -> Either a b
Right (Int -> Either [String] Int) -> Int -> Either [String] Int
forall a b. (a -> b) -> a -> b
$ MatchAdSolution -> Int
countOfDecisionNodes MatchAdSolution
sol,
        Int -> Either [String] Int
forall a b. b -> Either a b
Right (Int -> Either [String] Int) -> Int -> Either [String] Int
forall a b. (a -> b) -> a -> b
$ MatchAdSolution -> Int
countOfMergeNodes MatchAdSolution
sol,
        Int -> Either [String] Int
forall a b. b -> Either a b
Right (Int -> Either [String] Int) -> Int -> Either [String] Int
forall a b. (a -> b) -> a -> b
$ MatchAdSolution -> Int
countOfForks MatchAdSolution
sol,
        Int -> Either [String] Int
forall a b. b -> Either a b
Right (Int -> Either [String] Int) -> Int -> Either [String] Int
forall a b. (a -> b) -> a -> b
$ MatchAdSolution -> Int
countOfJoins MatchAdSolution
sol,
        Int -> Either [String] Int
forall a b. b -> Either a b
Right (Int -> Either [String] Int) -> Int -> Either [String] Int
forall a b. (a -> b) -> a -> b
$ MatchAdSolution -> Int
countOfInitialNodes MatchAdSolution
sol,
        Int -> Either [String] Int
forall a b. b -> Either a b
Right (Int -> Either [String] Int) -> Int -> Either [String] Int
forall a b. (a -> b) -> a -> b
$ MatchAdSolution -> Int
countOfActivityFinalNodes MatchAdSolution
sol,
        Int -> Either [String] Int
forall a b. b -> Either a b
Right (Int -> Either [String] Int) -> Int -> Either [String] Int
forall a b. (a -> b) -> a -> b
$ MatchAdSolution -> Int
countOfFlowFinalNodes MatchAdSolution
sol
        ]
  in [((Int, Either [String] Int), Bool)]
-> Map (Int, Either [String] Int) Bool
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([((Int, Either [String] Int), Bool)]
 -> Map (Int, Either [String] Int) Bool)
-> [((Int, Either [String] Int), Bool)]
-> Map (Int, Either [String] Int) Bool
forall a b. (a -> b) -> a -> b
$ (Int -> Either [String] Int -> ((Int, Either [String] Int), Bool))
-> [Int]
-> [Either [String] Int]
-> [((Int, Either [String] Int), Bool)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (((Int, Either [String] Int) -> ((Int, Either [String] Int), Bool))
-> Int -> Either [String] Int -> ((Int, Either [String] Int), Bool)
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (,Bool
True)) [Int
1..] [Either [String] Int]
xs

matchAd
  :: (MonadAlloy m, MonadThrow m)
  => MatchAdConfig
  -> Int
  -> Int
  -> m MatchAdInstance
matchAd :: forall (m :: * -> *).
(MonadAlloy m, MonadThrow m) =>
MatchAdConfig -> Int -> Int -> m MatchAdInstance
matchAd MatchAdConfig
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 MatchAdInstance -> StdGen -> m MatchAdInstance
forall (m :: * -> *) g a. Monad m => RandT g m a -> g -> m a
evalRandT (MatchAdConfig -> RandT StdGen m MatchAdInstance
forall (m :: * -> *) g.
(MonadAlloy m, MonadThrow m, RandomGen g) =>
MatchAdConfig -> RandT g m MatchAdInstance
getMatchAdTask MatchAdConfig
config) StdGen
g

getMatchAdTask
  :: (MonadAlloy m, MonadThrow m, RandomGen g)
  => MatchAdConfig
  -> RandT g m MatchAdInstance
getMatchAdTask :: forall (m :: * -> *) g.
(MonadAlloy m, MonadThrow m, RandomGen g) =>
MatchAdConfig -> RandT g m MatchAdInstance
getMatchAdTask MatchAdConfig
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
    (MatchAdConfig -> Maybe Integer
maxInstances MatchAdConfig
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
$ MatchAdConfig -> String
matchAdAlloy MatchAdConfig
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 RandT g m [UMLActivityDiagram]
-> ([UMLActivityDiagram] -> 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
>>= [UMLActivityDiagram] -> RandT g m UMLActivityDiagram
forall (m :: * -> *) a. MonadThrow m => [a] -> m a
getFirstInstance
  return $ MatchAdInstance {
    activityDiagram :: UMLActivityDiagram
activityDiagram = UMLActivityDiagram
ad,
    plantUMLConf :: PlantUmlConfig
plantUMLConf = PlantUmlConfig
defaultPlantUmlConfig {
      suppressBranchConditions :: Bool
suppressBranchConditions = MatchAdConfig -> Bool
hideBranchConditions MatchAdConfig
config
      },
    showSolution :: Bool
showSolution = MatchAdConfig -> Bool
printSolution MatchAdConfig
config,
    addText :: Maybe (Map Language String)
addText = MatchAdConfig -> Maybe (Map Language String)
extraText MatchAdConfig
config
  }

defaultMatchAdInstance :: MatchAdInstance
defaultMatchAdInstance :: MatchAdInstance
defaultMatchAdInstance = MatchAdInstance {
  activityDiagram :: UMLActivityDiagram
activityDiagram = 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
"B"},
      AdActionNode {label :: Int
label = Int
3, name :: String
name = String
"C"},
      AdActionNode {label :: Int
label = Int
4, name :: String
name = String
"D"},
      AdObjectNode {label :: Int
label = Int
5, name :: String
name = String
"E"},
      AdObjectNode {label :: Int
label = Int
6, name :: String
name = String
"F"},
      AdObjectNode {label :: Int
label = Int
7, name :: String
name = String
"G"},
      AdObjectNode {label :: Int
label = Int
8, name :: String
name = String
"H"},
      AdDecisionNode {label :: Int
label = Int
9},
      AdDecisionNode {label :: Int
label = Int
10},
      AdMergeNode {label :: Int
label = Int
11},
      AdMergeNode {label :: Int
label = Int
12},
      AdForkNode {label :: Int
label = Int
13},
      AdJoinNode {label :: Int
label = Int
14},
      AdActivityFinalNode {label :: Int
label = Int
15},
      AdFlowFinalNode {label :: Int
label = Int
16},
      AdInitialNode {label :: Int
label = Int
17}
    ],
    connections :: [AdConnection]
connections = [
      AdConnection {from :: Int
from = Int
1, to :: Int
to = Int
14, guard :: String
guard = String
""},
      AdConnection {from :: Int
from = Int
2, to :: Int
to = Int
11, guard :: String
guard = String
""},
      AdConnection {from :: Int
from = Int
3, to :: Int
to = Int
14, 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
11, 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
16, guard :: String
guard = String
""},
      AdConnection {from :: Int
from = Int
8, to :: Int
to = Int
12, guard :: String
guard = String
""},
      AdConnection {from :: Int
from = Int
9, to :: Int
to = Int
10, guard :: String
guard = String
"a"},
      AdConnection {from :: Int
from = Int
9, to :: Int
to = Int
12, guard :: String
guard = String
"b"},
      AdConnection {from :: Int
from = Int
10, to :: Int
to = Int
2, guard :: String
guard = String
"b"},
      AdConnection {from :: Int
from = Int
10, to :: Int
to = Int
5, guard :: String
guard = String
"a"},
      AdConnection {from :: Int
from = Int
11, to :: Int
to = Int
13, guard :: String
guard = String
""},
      AdConnection {from :: Int
from = Int
12, to :: Int
to = Int
6, guard :: String
guard = String
""},
      AdConnection {from :: Int
from = Int
13, to :: Int
to = Int
1, guard :: String
guard = String
""},
      AdConnection {from :: Int
from = Int
13, to :: Int
to = Int
3, guard :: String
guard = String
""},
      AdConnection {from :: Int
from = Int
13, to :: Int
to = Int
7, guard :: String
guard = String
""},
      AdConnection {from :: Int
from = Int
14, to :: Int
to = Int
15, guard :: String
guard = String
""},
      AdConnection {from :: Int
from = Int
17, to :: Int
to = Int
4, guard :: String
guard = String
""}
    ]
  },
  plantUMLConf :: PlantUmlConfig
plantUMLConf = PlantUmlConfig
defaultPlantUmlConfig,
  showSolution :: Bool
showSolution = Bool
False,
  addText :: Maybe (Map Language String)
addText = Maybe (Map Language String)
forall a. Maybe a
Nothing
}