{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TupleSections #-}
module Modelling.CdOd.MatchCdOd (
  MatchCdOdConfig (..),
  MatchCdOdInstance (..),
  MatchCdOdTaskTextElement (..),
  checkMatchCdOdConfig,
  checkMatchCdOdInstance,
  defaultMatchCdOdConfig,
  defaultMatchCdOdInstance,
  getMatchCdOdTask,
  getODInstances,
  matchCdOd,
  matchCdOdEvaluation,
  matchCdOdSolution,
  matchCdOdSyntax,
  matchCdOdTask,
  matchingShow,
  takeRandomInstances,
  ) where

import qualified Modelling.CdOd.CdAndChanges.Transform as Changes (transform)

import qualified Data.Bimap                       as BM (fromList)
import qualified Data.Map                         as M (
  adjust,
  elems,
  foldrWithKey,
  fromAscList,
  fromList,
  keys,
  lookup,
  toList,
  traverseWithKey,
  )

import Capabilities.Alloy               (MonadAlloy, getInstances)
import Capabilities.Cache               (MonadCache)
import Capabilities.Diagrams            (MonadDiagrams)
import Capabilities.Graphviz            (MonadGraphviz)
import Modelling.Auxiliary.Common (
  Randomise (randomise),
  RandomiseLayout (randomiseLayout),
  RandomiseNames (hasRandomisableNames, randomiseNames),
  )
import Modelling.Auxiliary.Output (
  addPretext,
  directionsAdvice,
  hoveringInformation,
  simplifiedInformation,
  uniform,
  )
import Modelling.Auxiliary.Shuffle.All  (shuffleEverything)
import Modelling.CdOd.CD2Alloy.Transform (
  LinguisticReuse (None),
  combineParts,
  createRunCommand,
  mergeParts,
  transform,
  )
import Modelling.CdOd.CdAndChanges.Instance (
  GenericClassDiagramInstance (..),
  fromInstanceWithNameOverlap,
  nameClassDiagramInstance,
  validChangeClassDiagram,
  )
import Modelling.CdOd.Auxiliary.Util (
  alloyInstanceToOd,
  )
import Modelling.CdOd.Output            (cacheCd, cacheOd)
import Modelling.CdOd.Types (
  Cd,
  CdDrawSettings (..),
  CdMutation (..),
  ClassConfig (..),
  ClassDiagram (..),
  LimitedLinking (..),
  Link (..),
  Object (..),
  ObjectConfig (..),
  ObjectDiagram (..),
  ObjectProperties (..),
  Od,
  OmittedDefaultMultiplicities (..),
  Relationship (..),
  RelationshipMutation (ChangeKind),
  allCdMutations,
  anonymiseObjects,
  associationNames,
  checkCdDrawSettings,
  checkCdMutations,
  checkClassConfigAndObjectProperties,
  checkClassConfigWithProperties,
  checkObjectDiagram,
  checkObjectProperties,
  checkOmittedDefaultMultiplicities,
  classNames,
  defaultOmittedDefaultMultiplicities,
  defaultProperties,
  fromClassDiagram,
  isObjectDiagramRandomisable,
  linkLabels,
  relationshipName,
  renameClassesAndRelationships,
  renameObjectsWithClassesAndLinksInOd,
  shuffleCdNames,
  shuffleClassAndConnectionOrder,
  shuffleObjectAndLinkOrder,
  )
import Modelling.Types (
  Letters (Letters, lettersList),
  showLetters,
  )

import Control.Applicative              (Alternative ((<|>)))
import Control.Exception                (Exception)
import Control.Monad                    ((<=<))
import Control.Monad.Catch              (MonadCatch, MonadThrow, throwM)
#if __GLASGOW_HASKELL__ < 808
import Control.Monad.Fail               (MonadFail)
#endif
import Control.OutputCapable.Blocks (
  ArticleToUse (DefiniteArticle),
  GenericOutputCapable (..),
  LangM,
  Language,
  OutputCapable,
  Rated,
  ($=<<),
  english,
  german,
  multipleChoice,
  translate,
  translations,
  )
import Control.OutputCapable.Blocks.Generic.Type (
  GenericOutput (Code, Paragraph, Special, Translated),
  )
import Control.OutputCapable.Blocks.Type (
  SpecialOutput,
  specialToOutputCapable,
  )
import Control.Monad.Random (
  MonadRandom,
  evalRandT,
  mkStdGen,
  )
import Data.Bifunctor                   (Bifunctor (second))
import Data.Bitraversable               (bimapM)
import Data.Containers.ListUtils        (nubOrd)
import Data.GraphViz                    (DirType (Forward))
import Data.List                        (singleton)
import Data.Map                         (Map)
import Data.Maybe                       (fromJust, isJust, listToMaybe, mapMaybe)
import Data.Ratio                       ((%))
import Data.String.Interpolate          (iii)
import GHC.Generics                     (Generic)
import Language.Alloy.Call              (AlloyInstance)
import System.Random.Shuffle            (shuffleM)

instance Exception MatchCdOdException

data MatchCdOdException = InvalidMatchCdOdInstance
  deriving Int -> MatchCdOdException -> ShowS
[MatchCdOdException] -> ShowS
MatchCdOdException -> String
(Int -> MatchCdOdException -> ShowS)
-> (MatchCdOdException -> String)
-> ([MatchCdOdException] -> ShowS)
-> Show MatchCdOdException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MatchCdOdException -> ShowS
showsPrec :: Int -> MatchCdOdException -> ShowS
$cshow :: MatchCdOdException -> String
show :: MatchCdOdException -> String
$cshowList :: [MatchCdOdException] -> ShowS
showList :: [MatchCdOdException] -> ShowS
Show

data MatchCdOdInstance
  = MatchCdOdInstance {
    MatchCdOdInstance -> CdDrawSettings
cdDrawSettings :: !CdDrawSettings,
    MatchCdOdInstance -> Map Int Cd
diagrams       :: Map Int Cd,
    MatchCdOdInstance -> Map Char ([Int], Od)
instances      :: Map Char ([Int], Od),
    MatchCdOdInstance -> Bool
showSolution   :: !Bool,
    MatchCdOdInstance -> MatchCdOdTaskText
taskText       :: !MatchCdOdTaskText,
    MatchCdOdInstance -> Maybe (Map Language String)
addText        :: Maybe (Map Language String)
  } deriving (MatchCdOdInstance -> MatchCdOdInstance -> Bool
(MatchCdOdInstance -> MatchCdOdInstance -> Bool)
-> (MatchCdOdInstance -> MatchCdOdInstance -> Bool)
-> Eq MatchCdOdInstance
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MatchCdOdInstance -> MatchCdOdInstance -> Bool
== :: MatchCdOdInstance -> MatchCdOdInstance -> Bool
$c/= :: MatchCdOdInstance -> MatchCdOdInstance -> Bool
/= :: MatchCdOdInstance -> MatchCdOdInstance -> Bool
Eq, (forall x. MatchCdOdInstance -> Rep MatchCdOdInstance x)
-> (forall x. Rep MatchCdOdInstance x -> MatchCdOdInstance)
-> Generic MatchCdOdInstance
forall x. Rep MatchCdOdInstance x -> MatchCdOdInstance
forall x. MatchCdOdInstance -> Rep MatchCdOdInstance x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. MatchCdOdInstance -> Rep MatchCdOdInstance x
from :: forall x. MatchCdOdInstance -> Rep MatchCdOdInstance x
$cto :: forall x. Rep MatchCdOdInstance x -> MatchCdOdInstance
to :: forall x. Rep MatchCdOdInstance x -> MatchCdOdInstance
Generic, ReadPrec [MatchCdOdInstance]
ReadPrec MatchCdOdInstance
Int -> ReadS MatchCdOdInstance
ReadS [MatchCdOdInstance]
(Int -> ReadS MatchCdOdInstance)
-> ReadS [MatchCdOdInstance]
-> ReadPrec MatchCdOdInstance
-> ReadPrec [MatchCdOdInstance]
-> Read MatchCdOdInstance
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS MatchCdOdInstance
readsPrec :: Int -> ReadS MatchCdOdInstance
$creadList :: ReadS [MatchCdOdInstance]
readList :: ReadS [MatchCdOdInstance]
$creadPrec :: ReadPrec MatchCdOdInstance
readPrec :: ReadPrec MatchCdOdInstance
$creadListPrec :: ReadPrec [MatchCdOdInstance]
readListPrec :: ReadPrec [MatchCdOdInstance]
Read, Int -> MatchCdOdInstance -> ShowS
[MatchCdOdInstance] -> ShowS
MatchCdOdInstance -> String
(Int -> MatchCdOdInstance -> ShowS)
-> (MatchCdOdInstance -> String)
-> ([MatchCdOdInstance] -> ShowS)
-> Show MatchCdOdInstance
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MatchCdOdInstance -> ShowS
showsPrec :: Int -> MatchCdOdInstance -> ShowS
$cshow :: MatchCdOdInstance -> String
show :: MatchCdOdInstance -> String
$cshowList :: [MatchCdOdInstance] -> ShowS
showList :: [MatchCdOdInstance] -> ShowS
Show)

data MatchCdOdConfig
  = MatchCdOdConfig {
    MatchCdOdConfig -> [CdMutation]
allowedCdMutations :: ![CdMutation],
    MatchCdOdConfig -> ClassConfig
classConfig      :: ClassConfig,
    MatchCdOdConfig -> Maybe Integer
maxInstances     :: Maybe Integer,
    MatchCdOdConfig -> ObjectConfig
objectConfig     :: ObjectConfig,
    MatchCdOdConfig -> ObjectProperties
objectProperties :: ObjectProperties,
    MatchCdOdConfig -> OmittedDefaultMultiplicities
omittedDefaultMultiplicities :: OmittedDefaultMultiplicities,
    MatchCdOdConfig -> Bool
printSolution    :: Bool,
    MatchCdOdConfig -> Maybe Int
timeout          :: Maybe Int,
    MatchCdOdConfig -> Maybe Bool
withNonTrivialInheritance :: Maybe Bool,
    MatchCdOdConfig -> Maybe (Map Language String)
extraText        :: Maybe (Map Language String)
  } deriving ((forall x. MatchCdOdConfig -> Rep MatchCdOdConfig x)
-> (forall x. Rep MatchCdOdConfig x -> MatchCdOdConfig)
-> Generic MatchCdOdConfig
forall x. Rep MatchCdOdConfig x -> MatchCdOdConfig
forall x. MatchCdOdConfig -> Rep MatchCdOdConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. MatchCdOdConfig -> Rep MatchCdOdConfig x
from :: forall x. MatchCdOdConfig -> Rep MatchCdOdConfig x
$cto :: forall x. Rep MatchCdOdConfig x -> MatchCdOdConfig
to :: forall x. Rep MatchCdOdConfig x -> MatchCdOdConfig
Generic, ReadPrec [MatchCdOdConfig]
ReadPrec MatchCdOdConfig
Int -> ReadS MatchCdOdConfig
ReadS [MatchCdOdConfig]
(Int -> ReadS MatchCdOdConfig)
-> ReadS [MatchCdOdConfig]
-> ReadPrec MatchCdOdConfig
-> ReadPrec [MatchCdOdConfig]
-> Read MatchCdOdConfig
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS MatchCdOdConfig
readsPrec :: Int -> ReadS MatchCdOdConfig
$creadList :: ReadS [MatchCdOdConfig]
readList :: ReadS [MatchCdOdConfig]
$creadPrec :: ReadPrec MatchCdOdConfig
readPrec :: ReadPrec MatchCdOdConfig
$creadListPrec :: ReadPrec [MatchCdOdConfig]
readListPrec :: ReadPrec [MatchCdOdConfig]
Read, Int -> MatchCdOdConfig -> ShowS
[MatchCdOdConfig] -> ShowS
MatchCdOdConfig -> String
(Int -> MatchCdOdConfig -> ShowS)
-> (MatchCdOdConfig -> String)
-> ([MatchCdOdConfig] -> ShowS)
-> Show MatchCdOdConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MatchCdOdConfig -> ShowS
showsPrec :: Int -> MatchCdOdConfig -> ShowS
$cshow :: MatchCdOdConfig -> String
show :: MatchCdOdConfig -> String
$cshowList :: [MatchCdOdConfig] -> ShowS
showList :: [MatchCdOdConfig] -> ShowS
Show)

defaultMatchCdOdConfig :: MatchCdOdConfig
defaultMatchCdOdConfig :: MatchCdOdConfig
defaultMatchCdOdConfig
  = MatchCdOdConfig {
    allowedCdMutations :: [CdMutation]
allowedCdMutations = [CdMutation]
allCdMutations,
    classConfig :: ClassConfig
classConfig  = ClassConfig {
        classLimits :: (Int, Int)
classLimits        = (Int
4, Int
4),
        aggregationLimits :: (Int, Maybe Int)
aggregationLimits  = (Int
1, Int -> Maybe Int
forall a. a -> Maybe a
Just Int
2),
        associationLimits :: (Int, Maybe Int)
associationLimits  = (Int
0, Int -> Maybe Int
forall a. a -> Maybe a
Just Int
1),
        compositionLimits :: (Int, Maybe Int)
compositionLimits  = (Int
1, Int -> Maybe Int
forall a. a -> Maybe a
Just Int
1),
        inheritanceLimits :: (Int, Maybe Int)
inheritanceLimits  = (Int
1, Int -> Maybe Int
forall a. a -> Maybe a
Just Int
2),
        relationshipLimits :: (Int, Maybe Int)
relationshipLimits = (Int
3, Int -> Maybe Int
forall a. a -> Maybe a
Just Int
4)
      },
    maxInstances :: Maybe Integer
maxInstances     = Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
200,
    objectConfig :: ObjectConfig
objectConfig = ObjectConfig {
      linkLimits :: (Int, Maybe Int)
linkLimits           = (Int
4, Int -> Maybe Int
forall a. a -> Maybe a
Just Int
10),
      linksPerObjectLimits :: (Int, Maybe Int)
linksPerObjectLimits = (Int
0, Int -> Maybe Int
forall a. a -> Maybe a
Just Int
4),
      objectLimits :: (Int, Int)
objectLimits         = (Int
2, Int
4)
      },
    objectProperties :: ObjectProperties
objectProperties = ObjectProperties {
      anonymousObjectProportion :: Rational
anonymousObjectProportion = Integer
1 Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
3,
      completelyInhabited :: Maybe Bool
completelyInhabited = Maybe Bool
forall a. Maybe a
Nothing,
      hasLimitedIsolatedObjects :: Bool
hasLimitedIsolatedObjects = Bool
True,
      hasSelfLoops :: Maybe Bool
hasSelfLoops = Maybe Bool
forall a. Maybe a
Nothing,
      usesEveryRelationshipName :: Maybe Bool
usesEveryRelationshipName = Maybe Bool
forall a. Maybe a
Nothing
      },
    omittedDefaultMultiplicities :: OmittedDefaultMultiplicities
omittedDefaultMultiplicities = OmittedDefaultMultiplicities
defaultOmittedDefaultMultiplicities,
    printSolution :: Bool
printSolution    = Bool
False,
    timeout :: Maybe Int
timeout          = Maybe Int
forall a. Maybe a
Nothing,
    withNonTrivialInheritance :: Maybe Bool
withNonTrivialInheritance = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True,
    extraText :: Maybe (Map Language String)
extraText        = Maybe (Map Language String)
forall a. Maybe a
Nothing
  }

toMatching :: Map Char [Int] -> Map (Int, Char) Bool
toMatching :: Map Char [Int] -> Map (Int, Char) Bool
toMatching Map Char [Int]
m =
  [((Int, Char), Bool)] -> Map (Int, Char) Bool
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [((Int
cd, Char
od), ([Int] -> Bool) -> Maybe [Int] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Int
cd Int -> [Int] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem`) (Maybe [Int] -> Bool) -> Maybe [Int] -> Bool
forall a b. (a -> b) -> a -> b
$ Char -> Map Char [Int] -> Maybe [Int]
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Char
od Map Char [Int]
m) | Int
cd <- [Int]
cds, Char
od <- String
ods]
  where
    cds :: [Int]
cds = Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
take Int
2 [Int
1 ..]
    ods :: String
ods = Int -> ShowS
forall a. Int -> [a] -> [a]
take Int
5 [Char
'a' ..]

checkMatchCdOdConfig :: MatchCdOdConfig -> Maybe String
checkMatchCdOdConfig :: MatchCdOdConfig -> Maybe String
checkMatchCdOdConfig MatchCdOdConfig {Bool
[CdMutation]
Maybe Bool
Maybe Int
Maybe Integer
Maybe (Map Language String)
ObjectProperties
ObjectConfig
OmittedDefaultMultiplicities
ClassConfig
allowedCdMutations :: MatchCdOdConfig -> [CdMutation]
classConfig :: MatchCdOdConfig -> ClassConfig
maxInstances :: MatchCdOdConfig -> Maybe Integer
objectConfig :: MatchCdOdConfig -> ObjectConfig
objectProperties :: MatchCdOdConfig -> ObjectProperties
omittedDefaultMultiplicities :: MatchCdOdConfig -> OmittedDefaultMultiplicities
printSolution :: MatchCdOdConfig -> Bool
timeout :: MatchCdOdConfig -> Maybe Int
withNonTrivialInheritance :: MatchCdOdConfig -> Maybe Bool
extraText :: MatchCdOdConfig -> Maybe (Map Language String)
allowedCdMutations :: [CdMutation]
classConfig :: ClassConfig
maxInstances :: Maybe Integer
objectConfig :: ObjectConfig
objectProperties :: ObjectProperties
omittedDefaultMultiplicities :: OmittedDefaultMultiplicities
printSolution :: Bool
timeout :: Maybe Int
withNonTrivialInheritance :: Maybe Bool
extraText :: Maybe (Map Language String)
..}
  | Just Bool
True <- ObjectProperties -> Maybe Bool
hasSelfLoops ObjectProperties
objectProperties
  = String -> Maybe String
forall a. a -> Maybe a
Just [iii|
    Enforcing self-loops in all object diagrams is not supported.
    You might want to change 'hasSelfLoops' to 'Nothing' in order
    to have self-loops (by chance) in some (or even all) of the object diagrams.
    |]
  | Maybe Bool -> Bool
forall a. Maybe a -> Bool
isJust (ObjectProperties -> Maybe Bool
usesEveryRelationshipName ObjectProperties
objectProperties)
  , (CdMutation -> Bool) -> [CdMutation] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any
    (CdMutation -> [CdMutation] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [CdMutation]
allowedCdMutations)
    [CdMutation
AddRelationship, CdMutation
RemoveRelationship, RelationshipMutation -> CdMutation
MutateRelationship RelationshipMutation
ChangeKind]
  = String -> Maybe String
forall a. a -> Maybe a
Just [iii|
    Setting 'usesEveryRelationshipName' to anything but 'Nothing' is not
    supported, if relationship names are not forcibly the same across all
    class diagrams, i.e. if 'allowedCdMutations' include any of
    'AddRelationship', 'RemoveRelationship' or 'MutateRelationship ChangeKind'.
    |]
  | Bool
otherwise
  = ClassConfig -> RelationshipProperties -> Maybe String
checkClassConfigWithProperties ClassConfig
classConfig RelationshipProperties
defaultProperties
  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
<|> [CdMutation] -> Maybe String
checkCdMutations [CdMutation]
allowedCdMutations
  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
<|> ObjectProperties -> Maybe String
checkObjectProperties ObjectProperties
objectProperties
  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
<|> ClassConfig -> ObjectProperties -> Maybe String
checkClassConfigAndObjectProperties ClassConfig
classConfig ObjectProperties
objectProperties
  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
<|> OmittedDefaultMultiplicities -> Maybe String
checkOmittedDefaultMultiplicities OmittedDefaultMultiplicities
omittedDefaultMultiplicities

checkMatchCdOdInstance :: MatchCdOdInstance -> Maybe String
checkMatchCdOdInstance :: MatchCdOdInstance -> Maybe String
checkMatchCdOdInstance MatchCdOdInstance {Bool
MatchCdOdTaskText
Maybe (Map Language String)
Map Char ([Int], Od)
Map Int Cd
CdDrawSettings
cdDrawSettings :: MatchCdOdInstance -> CdDrawSettings
diagrams :: MatchCdOdInstance -> Map Int Cd
instances :: MatchCdOdInstance -> Map Char ([Int], Od)
showSolution :: MatchCdOdInstance -> Bool
taskText :: MatchCdOdInstance -> MatchCdOdTaskText
addText :: MatchCdOdInstance -> Maybe (Map Language String)
cdDrawSettings :: CdDrawSettings
diagrams :: Map Int Cd
instances :: Map Char ([Int], Od)
showSolution :: Bool
taskText :: MatchCdOdTaskText
addText :: Maybe (Map Language String)
..}
  | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ CdDrawSettings -> Bool
printNames CdDrawSettings
cdDrawSettings
  = String -> Maybe String
forall a. a -> Maybe a
Just [iii|printNames has to be set to True for this task type.|]
  | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ CdDrawSettings -> Bool
printNavigations CdDrawSettings
cdDrawSettings
  = String -> Maybe String
forall a. a -> Maybe a
Just [iii|printNavigations has to be set to True for this task type.|]
  | Bool
otherwise
  = (([Int], Od) -> Maybe String -> Maybe String)
-> Maybe String -> [([Int], Od)] -> Maybe String
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Maybe String -> Maybe String -> Maybe String
forall a. Semigroup a => a -> a -> a
(<>) (Maybe String -> Maybe String -> Maybe String)
-> (([Int], Od) -> Maybe String)
-> ([Int], Od)
-> Maybe String
-> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Od -> Maybe String
forall objectName className linkLabel.
Ord objectName =>
ObjectDiagram objectName className linkLabel -> Maybe String
checkObjectDiagram (Od -> Maybe String)
-> (([Int], Od) -> Od) -> ([Int], Od) -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Int], Od) -> Od
forall a b. (a, b) -> b
snd) Maybe String
forall a. Maybe a
Nothing (Map Char ([Int], Od) -> [([Int], Od)]
forall k a. Map k a -> [a]
M.elems Map Char ([Int], Od)
instances)
  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
<|> CdDrawSettings -> Maybe String
checkCdDrawSettings CdDrawSettings
cdDrawSettings

type MatchCdOdTaskText = [SpecialOutput MatchCdOdTaskTextElement]

data MatchCdOdTaskTextElement
  = GivenCds
  | GivenOds
  deriving (MatchCdOdTaskTextElement
MatchCdOdTaskTextElement
-> MatchCdOdTaskTextElement -> Bounded MatchCdOdTaskTextElement
forall a. a -> a -> Bounded a
$cminBound :: MatchCdOdTaskTextElement
minBound :: MatchCdOdTaskTextElement
$cmaxBound :: MatchCdOdTaskTextElement
maxBound :: MatchCdOdTaskTextElement
Bounded, Int -> MatchCdOdTaskTextElement
MatchCdOdTaskTextElement -> Int
MatchCdOdTaskTextElement -> [MatchCdOdTaskTextElement]
MatchCdOdTaskTextElement -> MatchCdOdTaskTextElement
MatchCdOdTaskTextElement
-> MatchCdOdTaskTextElement -> [MatchCdOdTaskTextElement]
MatchCdOdTaskTextElement
-> MatchCdOdTaskTextElement
-> MatchCdOdTaskTextElement
-> [MatchCdOdTaskTextElement]
(MatchCdOdTaskTextElement -> MatchCdOdTaskTextElement)
-> (MatchCdOdTaskTextElement -> MatchCdOdTaskTextElement)
-> (Int -> MatchCdOdTaskTextElement)
-> (MatchCdOdTaskTextElement -> Int)
-> (MatchCdOdTaskTextElement -> [MatchCdOdTaskTextElement])
-> (MatchCdOdTaskTextElement
    -> MatchCdOdTaskTextElement -> [MatchCdOdTaskTextElement])
-> (MatchCdOdTaskTextElement
    -> MatchCdOdTaskTextElement -> [MatchCdOdTaskTextElement])
-> (MatchCdOdTaskTextElement
    -> MatchCdOdTaskTextElement
    -> MatchCdOdTaskTextElement
    -> [MatchCdOdTaskTextElement])
-> Enum MatchCdOdTaskTextElement
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: MatchCdOdTaskTextElement -> MatchCdOdTaskTextElement
succ :: MatchCdOdTaskTextElement -> MatchCdOdTaskTextElement
$cpred :: MatchCdOdTaskTextElement -> MatchCdOdTaskTextElement
pred :: MatchCdOdTaskTextElement -> MatchCdOdTaskTextElement
$ctoEnum :: Int -> MatchCdOdTaskTextElement
toEnum :: Int -> MatchCdOdTaskTextElement
$cfromEnum :: MatchCdOdTaskTextElement -> Int
fromEnum :: MatchCdOdTaskTextElement -> Int
$cenumFrom :: MatchCdOdTaskTextElement -> [MatchCdOdTaskTextElement]
enumFrom :: MatchCdOdTaskTextElement -> [MatchCdOdTaskTextElement]
$cenumFromThen :: MatchCdOdTaskTextElement
-> MatchCdOdTaskTextElement -> [MatchCdOdTaskTextElement]
enumFromThen :: MatchCdOdTaskTextElement
-> MatchCdOdTaskTextElement -> [MatchCdOdTaskTextElement]
$cenumFromTo :: MatchCdOdTaskTextElement
-> MatchCdOdTaskTextElement -> [MatchCdOdTaskTextElement]
enumFromTo :: MatchCdOdTaskTextElement
-> MatchCdOdTaskTextElement -> [MatchCdOdTaskTextElement]
$cenumFromThenTo :: MatchCdOdTaskTextElement
-> MatchCdOdTaskTextElement
-> MatchCdOdTaskTextElement
-> [MatchCdOdTaskTextElement]
enumFromThenTo :: MatchCdOdTaskTextElement
-> MatchCdOdTaskTextElement
-> MatchCdOdTaskTextElement
-> [MatchCdOdTaskTextElement]
Enum, MatchCdOdTaskTextElement -> MatchCdOdTaskTextElement -> Bool
(MatchCdOdTaskTextElement -> MatchCdOdTaskTextElement -> Bool)
-> (MatchCdOdTaskTextElement -> MatchCdOdTaskTextElement -> Bool)
-> Eq MatchCdOdTaskTextElement
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MatchCdOdTaskTextElement -> MatchCdOdTaskTextElement -> Bool
== :: MatchCdOdTaskTextElement -> MatchCdOdTaskTextElement -> Bool
$c/= :: MatchCdOdTaskTextElement -> MatchCdOdTaskTextElement -> Bool
/= :: MatchCdOdTaskTextElement -> MatchCdOdTaskTextElement -> Bool
Eq, (forall x.
 MatchCdOdTaskTextElement -> Rep MatchCdOdTaskTextElement x)
-> (forall x.
    Rep MatchCdOdTaskTextElement x -> MatchCdOdTaskTextElement)
-> Generic MatchCdOdTaskTextElement
forall x.
Rep MatchCdOdTaskTextElement x -> MatchCdOdTaskTextElement
forall x.
MatchCdOdTaskTextElement -> Rep MatchCdOdTaskTextElement x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
MatchCdOdTaskTextElement -> Rep MatchCdOdTaskTextElement x
from :: forall x.
MatchCdOdTaskTextElement -> Rep MatchCdOdTaskTextElement x
$cto :: forall x.
Rep MatchCdOdTaskTextElement x -> MatchCdOdTaskTextElement
to :: forall x.
Rep MatchCdOdTaskTextElement x -> MatchCdOdTaskTextElement
Generic, Eq MatchCdOdTaskTextElement
Eq MatchCdOdTaskTextElement
-> (MatchCdOdTaskTextElement
    -> MatchCdOdTaskTextElement -> Ordering)
-> (MatchCdOdTaskTextElement -> MatchCdOdTaskTextElement -> Bool)
-> (MatchCdOdTaskTextElement -> MatchCdOdTaskTextElement -> Bool)
-> (MatchCdOdTaskTextElement -> MatchCdOdTaskTextElement -> Bool)
-> (MatchCdOdTaskTextElement -> MatchCdOdTaskTextElement -> Bool)
-> (MatchCdOdTaskTextElement
    -> MatchCdOdTaskTextElement -> MatchCdOdTaskTextElement)
-> (MatchCdOdTaskTextElement
    -> MatchCdOdTaskTextElement -> MatchCdOdTaskTextElement)
-> Ord MatchCdOdTaskTextElement
MatchCdOdTaskTextElement -> MatchCdOdTaskTextElement -> Bool
MatchCdOdTaskTextElement -> MatchCdOdTaskTextElement -> Ordering
MatchCdOdTaskTextElement
-> MatchCdOdTaskTextElement -> MatchCdOdTaskTextElement
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: MatchCdOdTaskTextElement -> MatchCdOdTaskTextElement -> Ordering
compare :: MatchCdOdTaskTextElement -> MatchCdOdTaskTextElement -> Ordering
$c< :: MatchCdOdTaskTextElement -> MatchCdOdTaskTextElement -> Bool
< :: MatchCdOdTaskTextElement -> MatchCdOdTaskTextElement -> Bool
$c<= :: MatchCdOdTaskTextElement -> MatchCdOdTaskTextElement -> Bool
<= :: MatchCdOdTaskTextElement -> MatchCdOdTaskTextElement -> Bool
$c> :: MatchCdOdTaskTextElement -> MatchCdOdTaskTextElement -> Bool
> :: MatchCdOdTaskTextElement -> MatchCdOdTaskTextElement -> Bool
$c>= :: MatchCdOdTaskTextElement -> MatchCdOdTaskTextElement -> Bool
>= :: MatchCdOdTaskTextElement -> MatchCdOdTaskTextElement -> Bool
$cmax :: MatchCdOdTaskTextElement
-> MatchCdOdTaskTextElement -> MatchCdOdTaskTextElement
max :: MatchCdOdTaskTextElement
-> MatchCdOdTaskTextElement -> MatchCdOdTaskTextElement
$cmin :: MatchCdOdTaskTextElement
-> MatchCdOdTaskTextElement -> MatchCdOdTaskTextElement
min :: MatchCdOdTaskTextElement
-> MatchCdOdTaskTextElement -> MatchCdOdTaskTextElement
Ord, ReadPrec [MatchCdOdTaskTextElement]
ReadPrec MatchCdOdTaskTextElement
Int -> ReadS MatchCdOdTaskTextElement
ReadS [MatchCdOdTaskTextElement]
(Int -> ReadS MatchCdOdTaskTextElement)
-> ReadS [MatchCdOdTaskTextElement]
-> ReadPrec MatchCdOdTaskTextElement
-> ReadPrec [MatchCdOdTaskTextElement]
-> Read MatchCdOdTaskTextElement
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS MatchCdOdTaskTextElement
readsPrec :: Int -> ReadS MatchCdOdTaskTextElement
$creadList :: ReadS [MatchCdOdTaskTextElement]
readList :: ReadS [MatchCdOdTaskTextElement]
$creadPrec :: ReadPrec MatchCdOdTaskTextElement
readPrec :: ReadPrec MatchCdOdTaskTextElement
$creadListPrec :: ReadPrec [MatchCdOdTaskTextElement]
readListPrec :: ReadPrec [MatchCdOdTaskTextElement]
Read, Int -> MatchCdOdTaskTextElement -> ShowS
[MatchCdOdTaskTextElement] -> ShowS
MatchCdOdTaskTextElement -> String
(Int -> MatchCdOdTaskTextElement -> ShowS)
-> (MatchCdOdTaskTextElement -> String)
-> ([MatchCdOdTaskTextElement] -> ShowS)
-> Show MatchCdOdTaskTextElement
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MatchCdOdTaskTextElement -> ShowS
showsPrec :: Int -> MatchCdOdTaskTextElement -> ShowS
$cshow :: MatchCdOdTaskTextElement -> String
show :: MatchCdOdTaskTextElement -> String
$cshowList :: [MatchCdOdTaskTextElement] -> ShowS
showList :: [MatchCdOdTaskTextElement] -> ShowS
Show)

matchCdOdTask
  :: (
    MonadCache m,
    MonadDiagrams m,
    MonadGraphviz m,
    MonadThrow m,
    OutputCapable m
    )
  => FilePath
  -> MatchCdOdInstance
  -> LangM m
matchCdOdTask :: forall (m :: * -> *).
(MonadCache m, MonadDiagrams m, MonadGraphviz m, MonadThrow m,
 OutputCapable m) =>
String -> MatchCdOdInstance -> LangM m
matchCdOdTask String
path MatchCdOdInstance
task = do
  String -> MatchCdOdInstance -> LangM m
forall (m :: * -> *).
(MonadCache m, MonadDiagrams m, MonadGraphviz m, MonadThrow m,
 OutputCapable m) =>
String -> MatchCdOdInstance -> LangM m
toTaskText String
path MatchCdOdInstance
task
  LangM m -> LangM m
forall l (m :: * -> *).
GenericOutputCapable l m =>
GenericLangM l m () -> GenericLangM l m ()
paragraph LangM m
forall (m :: * -> *). OutputCapable m => LangM m
simplifiedInformation
  LangM m -> LangM m
forall l (m :: * -> *).
GenericOutputCapable l m =>
GenericLangM l m () -> GenericLangM l m ()
paragraph LangM m
forall (m :: * -> *). OutputCapable m => LangM m
directionsAdvice
  LangM m -> LangM m
forall l (m :: * -> *).
GenericOutputCapable l m =>
GenericLangM l m () -> GenericLangM l m ()
paragraph LangM m
forall (m :: * -> *). OutputCapable m => LangM m
hoveringInformation
  pure ()

toTaskText
  :: (
    MonadCache m,
    MonadDiagrams m,
    MonadGraphviz m,
    MonadThrow m,
    OutputCapable m
    )
  => FilePath
  -> MatchCdOdInstance
  -> LangM m
toTaskText :: forall (m :: * -> *).
(MonadCache m, MonadDiagrams m, MonadGraphviz m, MonadThrow m,
 OutputCapable m) =>
String -> MatchCdOdInstance -> LangM m
toTaskText String
path MatchCdOdInstance
task =
  (MatchCdOdTaskTextElement -> LangM m)
-> MatchCdOdTaskText -> LangM m
forall (m :: * -> *) element.
OutputCapable m =>
(element -> LangM m) -> [SpecialOutput element] -> LangM m
specialToOutputCapable (String -> MatchCdOdInstance -> MatchCdOdTaskTextElement -> LangM m
forall (m :: * -> *).
(MonadCache m, MonadDiagrams m, MonadGraphviz m, MonadThrow m,
 OutputCapable m) =>
String -> MatchCdOdInstance -> MatchCdOdTaskTextElement -> LangM m
toTaskSpecificText String
path MatchCdOdInstance
task) (MatchCdOdInstance -> MatchCdOdTaskText
taskText MatchCdOdInstance
task)

toTaskSpecificText
  :: (
    MonadCache m,
    MonadDiagrams m,
    MonadGraphviz m,
    MonadThrow m,
    OutputCapable m
    )
  => FilePath
  -> MatchCdOdInstance
  -> MatchCdOdTaskTextElement
  -> LangM m
toTaskSpecificText :: forall (m :: * -> *).
(MonadCache m, MonadDiagrams m, MonadGraphviz m, MonadThrow m,
 OutputCapable m) =>
String -> MatchCdOdInstance -> MatchCdOdTaskTextElement -> LangM m
toTaskSpecificText String
path MatchCdOdInstance {Bool
MatchCdOdTaskText
Maybe (Map Language String)
Map Char ([Int], Od)
Map Int Cd
CdDrawSettings
cdDrawSettings :: MatchCdOdInstance -> CdDrawSettings
diagrams :: MatchCdOdInstance -> Map Int Cd
instances :: MatchCdOdInstance -> Map Char ([Int], Od)
showSolution :: MatchCdOdInstance -> Bool
taskText :: MatchCdOdInstance -> MatchCdOdTaskText
addText :: MatchCdOdInstance -> Maybe (Map Language String)
cdDrawSettings :: CdDrawSettings
diagrams :: Map Int Cd
instances :: Map Char ([Int], Od)
showSolution :: Bool
taskText :: MatchCdOdTaskText
addText :: Maybe (Map Language String)
..} = \case
  MatchCdOdTaskTextElement
GivenCds -> (Int -> String) -> ShowS -> Map Int String -> LangM m
forall k a. (k -> String) -> (a -> String) -> Map k a -> LangM m
forall l (m :: * -> *) k a.
GenericOutputCapable l m =>
(k -> String) -> (a -> String) -> Map k a -> GenericLangM l m ()
images Int -> String
forall a. Show a => a -> String
show ShowS
forall a. a -> a
id
    (Map Int String -> LangM m) -> m (Map Int String) -> LangM m
forall (m :: * -> *) a l b.
Monad m =>
(a -> GenericLangM l m b) -> m a -> GenericLangM l m b
$=<< (\Int
_ Cd
cd -> CdDrawSettings -> Style V2 Double -> AnyCd -> String -> m String
forall (m :: * -> *).
(MonadCache m, MonadDiagrams m, MonadGraphviz m) =>
CdDrawSettings -> Style V2 Double -> AnyCd -> String -> m String
cacheCd CdDrawSettings
cdDrawSettings Style V2 Double
forall a. Monoid a => a
mempty (Cd -> AnyCd
forall className relationshipName.
ClassDiagram className relationshipName
-> AnyClassDiagram className relationshipName
fromClassDiagram Cd
cd) String
path)
    (Int -> Cd -> m String) -> Map Int Cd -> m (Map Int String)
forall (t :: * -> *) k a b.
Applicative t =>
(k -> a -> t b) -> Map k a -> t (Map k b)
`M.traverseWithKey` Map Int Cd
diagrams
  MatchCdOdTaskTextElement
GivenOds -> (Char -> String)
-> (([Int], String) -> String)
-> Map Char ([Int], String)
-> LangM m
forall k a. (k -> String) -> (a -> String) -> Map k a -> LangM m
forall l (m :: * -> *) k a.
GenericOutputCapable l m =>
(k -> String) -> (a -> String) -> Map k a -> GenericLangM l m ()
images (Char -> ShowS
forall a. a -> [a] -> [a]
:[]) ([Int], String) -> String
forall a b. (a, b) -> b
snd
    (Map Char ([Int], String) -> LangM m)
-> m (Map Char ([Int], String)) -> LangM m
forall (m :: * -> *) a l b.
Monad m =>
(a -> GenericLangM l m b) -> m a -> GenericLangM l m b
$=<< (\Char
_ ([Int]
is,Od
o) -> ([Int]
is,) (String -> ([Int], String)) -> m String -> m ([Int], String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Od -> DirType -> Bool -> String -> m String
forall (m :: * -> *).
(MonadCache m, MonadDiagrams m, MonadGraphviz m, MonadThrow m) =>
Od -> DirType -> Bool -> String -> m String
cacheOd Od
o DirType
Forward Bool
True String
path)
    (Char -> ([Int], Od) -> m ([Int], String))
-> Map Char ([Int], Od) -> m (Map Char ([Int], String))
forall (t :: * -> *) k a b.
Applicative t =>
(k -> a -> t b) -> Map k a -> t (Map k b)
`M.traverseWithKey` Map Char ([Int], Od)
instances

defaultMatchCdOdTaskText :: MatchCdOdTaskText
defaultMatchCdOdTaskText :: MatchCdOdTaskText
defaultMatchCdOdTaskText = [
  MatchCdOdTaskText
-> GenericOutput Language MatchCdOdTaskTextElement
forall language element.
[GenericOutput language element] -> GenericOutput language element
Paragraph (MatchCdOdTaskText
 -> GenericOutput Language MatchCdOdTaskTextElement)
-> MatchCdOdTaskText
-> GenericOutput Language MatchCdOdTaskTextElement
forall a b. (a -> b) -> a -> b
$ GenericOutput Language MatchCdOdTaskTextElement
-> MatchCdOdTaskText
forall a. a -> [a]
singleton (GenericOutput Language MatchCdOdTaskTextElement
 -> MatchCdOdTaskText)
-> GenericOutput Language MatchCdOdTaskTextElement
-> MatchCdOdTaskText
forall a b. (a -> b) -> a -> b
$ Map Language String
-> GenericOutput Language MatchCdOdTaskTextElement
forall language element.
Map language String -> GenericOutput language element
Translated (Map Language String
 -> GenericOutput Language MatchCdOdTaskTextElement)
-> Map Language String
-> GenericOutput Language MatchCdOdTaskTextElement
forall a b. (a -> b) -> a -> b
$ 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
"Consider the following two (valid) class diagrams:"
    String -> State (Map Language String) ()
german String
"Betrachten Sie die folgenden zwei (gültigen) Klassendiagramme:",
  MatchCdOdTaskTextElement
-> GenericOutput Language MatchCdOdTaskTextElement
forall language element. element -> GenericOutput language element
Special MatchCdOdTaskTextElement
GivenCds,
  MatchCdOdTaskText
-> GenericOutput Language MatchCdOdTaskTextElement
forall language element.
[GenericOutput language element] -> GenericOutput language element
Paragraph (MatchCdOdTaskText
 -> GenericOutput Language MatchCdOdTaskTextElement)
-> MatchCdOdTaskText
-> GenericOutput Language MatchCdOdTaskTextElement
forall a b. (a -> b) -> a -> b
$ GenericOutput Language MatchCdOdTaskTextElement
-> MatchCdOdTaskText
forall a. a -> [a]
singleton (GenericOutput Language MatchCdOdTaskTextElement
 -> MatchCdOdTaskText)
-> GenericOutput Language MatchCdOdTaskTextElement
-> MatchCdOdTaskText
forall a b. (a -> b) -> a -> b
$ Map Language String
-> GenericOutput Language MatchCdOdTaskTextElement
forall language element.
Map language String -> GenericOutput language element
Translated (Map Language String
 -> GenericOutput Language MatchCdOdTaskTextElement)
-> Map Language String
-> GenericOutput Language MatchCdOdTaskTextElement
forall a b. (a -> b) -> a -> b
$ 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 [iii|
      Which of the following five object diagrams conform to which class diagram?
      \n
      An object diagram can conform to neither, either, or both class diagrams.
      |]
    String -> State (Map Language String) ()
german [iii|
      Welche der folgenden fünf Objektdiagramme
      passen zu welchem Klassendiagramm?
      \n
      Ein Objektdiagramm kann zu keinem,
      einem oder beiden Klassendiagrammen passen.
      |],
  MatchCdOdTaskTextElement
-> GenericOutput Language MatchCdOdTaskTextElement
forall language element. element -> GenericOutput language element
Special MatchCdOdTaskTextElement
GivenOds,
  MatchCdOdTaskText
-> GenericOutput Language MatchCdOdTaskTextElement
forall language element.
[GenericOutput language element] -> GenericOutput language element
Paragraph [
    Map Language String
-> GenericOutput Language MatchCdOdTaskTextElement
forall language element.
Map language String -> GenericOutput language element
Translated (Map Language String
 -> GenericOutput Language MatchCdOdTaskTextElement)
-> Map Language String
-> GenericOutput Language MatchCdOdTaskTextElement
forall a b. (a -> b) -> a -> b
$ 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 [iii|
        Please state your answer by giving a list of pairs,
        each comprising of a class diagram number and object diagram letters.
        \n
        Each pair indicates that the mentioned object diagrams conform to the
        respective class diagram.
        \n
        For example,#{" "}|]
      String -> State (Map Language String) ()
german [iii|
        Bitte geben Sie Ihre Antwort in Form einer Liste von Paaren an,
        die jeweils aus einer Klassendiagrammnummer und
        aus Objektdiagrammbuchstaben bestehen.
        \n
        Jedes Paar gibt an, dass die genannten Objektdiagramme
        zu dem jeweiligen Klassendiagramm passen.
        \n
        Zum Beispiel drückt#{" "}|],
    Map Language String
-> GenericOutput Language MatchCdOdTaskTextElement
forall language element.
Map language String -> GenericOutput language element
Code (Map Language String
 -> GenericOutput Language MatchCdOdTaskTextElement)
-> ([(Int, ShowLetters)] -> Map Language String)
-> [(Int, ShowLetters)]
-> GenericOutput Language MatchCdOdTaskTextElement
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Map Language String
forall a. a -> Map Language a
uniform (String -> Map Language String)
-> ([(Int, ShowLetters)] -> String)
-> [(Int, ShowLetters)]
-> Map Language String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Int, ShowLetters)] -> String
forall a. Show a => a -> String
show ([(Int, ShowLetters)]
 -> GenericOutput Language MatchCdOdTaskTextElement)
-> [(Int, ShowLetters)]
-> GenericOutput Language MatchCdOdTaskTextElement
forall a b. (a -> b) -> a -> b
$ [(Int, Letters)] -> [(Int, ShowLetters)]
matchingShow [(Int, Letters)]
matchCdOdInitial,
    Map Language String
-> GenericOutput Language MatchCdOdTaskTextElement
forall language element.
Map language String -> GenericOutput language element
Translated (Map Language String
 -> GenericOutput Language MatchCdOdTaskTextElement)
-> Map Language String
-> GenericOutput Language MatchCdOdTaskTextElement
forall a b. (a -> b) -> a -> b
$ 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 [iii|
        expresses that among the offered choices exactly
        the object diagrams a and b are instances of class diagram 1 and
        that none of the offered object diagrams
        are instances of class diagram 2.
        |]
      String -> State (Map Language String) ()
german [iii|
        aus, dass unter den angebotenen Auswahlmöglichkeiten
        genau die Objektdiagramme a und b Instanzen des Klassendiagramms 1 sind
        und dass keines der angebotenen Objektdiagramme
        Instanz des Klassendiagramms 2 ist.
        |]
    ]
  ]

newtype ShowLetters = ShowLetters { ShowLetters -> Letters
showLetters' :: Letters }

instance Show ShowLetters where
  show :: ShowLetters -> String
show = Letters -> String
showLetters (Letters -> String)
-> (ShowLetters -> Letters) -> ShowLetters -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowLetters -> Letters
showLetters'

matchingShow :: [(Int, Letters)] -> [(Int, ShowLetters)]
matchingShow :: [(Int, Letters)] -> [(Int, ShowLetters)]
matchingShow = ((Int, Letters) -> (Int, ShowLetters))
-> [(Int, Letters)] -> [(Int, ShowLetters)]
forall a b. (a -> b) -> [a] -> [b]
map ((Letters -> ShowLetters) -> (Int, Letters) -> (Int, ShowLetters)
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second Letters -> ShowLetters
ShowLetters)

matchCdOdInitial :: [(Int, Letters)]
matchCdOdInitial :: [(Int, Letters)]
matchCdOdInitial = [(Int
1, String -> Letters
Letters String
"ab"), (Int
2, String -> Letters
Letters String
"")]

matchCdOdSyntax
  :: (Foldable t, OutputCapable m)
  => MatchCdOdInstance
  -> t (Int, Letters)
  -> LangM m
matchCdOdSyntax :: forall (t :: * -> *) (m :: * -> *).
(Foldable t, OutputCapable m) =>
MatchCdOdInstance -> t (Int, Letters) -> LangM m
matchCdOdSyntax MatchCdOdInstance
task t (Int, Letters)
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
  Bool -> LangM' m () -> LangM' m ()
forall l (m :: * -> *).
GenericOutputCapable l m =>
Bool -> GenericLangM l m () -> GenericLangM l m ()
assertion (((Int, Letters) -> Bool) -> t (Int, Letters) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Int -> Bool
availableCd (Int -> Bool) -> ((Int, Letters) -> Int) -> (Int, Letters) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Letters) -> Int
forall a b. (a, b) -> a
fst) t (Int, Letters)
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 class diagrams were provided within task?"
    String -> State (Map Language String) ()
german [iii|
      Referenzierte Klassendiagramme sind Bestandteil der Aufgabenstellung?
      |]
  Bool -> LangM' m () -> LangM' m ()
forall l (m :: * -> *).
GenericOutputCapable l m =>
Bool -> GenericLangM l m () -> GenericLangM l m ()
assertion (((Int, Letters) -> Bool) -> t (Int, Letters) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
availableOd (String -> Bool)
-> ((Int, Letters) -> String) -> (Int, Letters) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Letters -> String
lettersList (Letters -> String)
-> ((Int, Letters) -> Letters) -> (Int, Letters) -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Letters) -> Letters
forall a b. (a, b) -> b
snd) t (Int, Letters)
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 object diagrams were provided within task?"
    String -> State (Map Language String) ()
german String
"Referenzierte Objektdiagramme sind Bestandteil der Aufgabenstellung?"
  pure ()
  where
    availableCd :: Int -> Bool
availableCd = (Int -> [Int] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Map Int Cd -> [Int]
forall k a. Map k a -> [k]
M.keys (MatchCdOdInstance -> Map Int Cd
diagrams MatchCdOdInstance
task))
    availableOd :: Char -> Bool
availableOd = (Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Map Char ([Int], Od) -> String
forall k a. Map k a -> [k]
M.keys (MatchCdOdInstance -> Map Char ([Int], Od)
instances MatchCdOdInstance
task))

matchCdOdEvaluation
  :: (Foldable t, OutputCapable m)
  => MatchCdOdInstance
  -> t (Int, Letters)
  -> Rated m
matchCdOdEvaluation :: forall (t :: * -> *) (m :: * -> *).
(Foldable t, OutputCapable m) =>
MatchCdOdInstance -> t (Int, Letters) -> Rated m
matchCdOdEvaluation MatchCdOdInstance
task t (Int, Letters)
sub' = do
  let sub :: [(Int, Char)]
sub = t (Int, Letters) -> [(Int, Char)]
forall (f :: * -> *).
Foldable f =>
f (Int, Letters) -> [(Int, Char)]
toMatching' t (Int, Letters)
sub'
      sol :: Map Char [Int]
sol = ([Int], Od) -> [Int]
forall a b. (a, b) -> a
fst (([Int], Od) -> [Int]) -> Map Char ([Int], Od) -> Map Char [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MatchCdOdInstance -> Map Char ([Int], Od)
instances MatchCdOdInstance
task
      matching :: Map (Int, Char) Bool
matching = Map Char [Int] -> Map (Int, Char) Bool
toMatching Map Char [Int]
sol
      what :: Map Language String
what = 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
"instances"
        String -> State (Map Language String) ()
german String
"Instanzen"
      solution :: Maybe String
solution =
        if MatchCdOdInstance -> Bool
showSolution MatchCdOdInstance
task
        then String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String)
-> ([(Int, Letters)] -> String) -> [(Int, Letters)] -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Int, ShowLetters)] -> String
forall a. Show a => a -> String
show ([(Int, ShowLetters)] -> String)
-> ([(Int, Letters)] -> [(Int, ShowLetters)])
-> [(Int, Letters)]
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Int, Letters)] -> [(Int, ShowLetters)]
matchingShow ([(Int, Letters)] -> Maybe String)
-> [(Int, Letters)] -> Maybe String
forall a b. (a -> b) -> a -> b
$ MatchCdOdInstance -> [(Int, Letters)]
matchCdOdSolution MatchCdOdInstance
task
        else Maybe String
forall a. Maybe a
Nothing
  ArticleToUse
-> Map Language String
-> Maybe String
-> Map (Int, Char) Bool
-> [(Int, Char)]
-> Rated m
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
what Maybe String
solution Map (Int, Char) Bool
matching [(Int, Char)]
sub
  where
    toMatching' :: Foldable f => f (Int, Letters) -> [(Int, Char)]
    toMatching' :: forall (f :: * -> *).
Foldable f =>
f (Int, Letters) -> [(Int, Char)]
toMatching' =
      ((Int, Letters) -> [(Int, Char)] -> [(Int, Char)])
-> [(Int, Char)] -> f (Int, Letters) -> [(Int, Char)]
forall a b. (a -> b -> b) -> b -> f a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(Int
c, Letters
ys) [(Int, Char)]
xs -> (Char -> [(Int, Char)] -> [(Int, Char)])
-> [(Int, Char)] -> String -> [(Int, Char)]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((:) ((Int, Char) -> [(Int, Char)] -> [(Int, Char)])
-> (Char -> (Int, Char)) -> Char -> [(Int, Char)] -> [(Int, Char)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int
c,)) [(Int, Char)]
xs (Letters -> String
lettersList Letters
ys)) []

matchCdOdSolution :: MatchCdOdInstance -> [(Int, Letters)]
matchCdOdSolution :: MatchCdOdInstance -> [(Int, Letters)]
matchCdOdSolution = Map Int Letters -> [(Int, Letters)]
forall k a. Map k a -> [(k, a)]
M.toList (Map Int Letters -> [(Int, Letters)])
-> (MatchCdOdInstance -> Map Int Letters)
-> MatchCdOdInstance
-> [(Int, Letters)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Char [Int] -> Map Int Letters
reverseMapping (Map Char [Int] -> Map Int Letters)
-> (MatchCdOdInstance -> Map Char [Int])
-> MatchCdOdInstance
-> Map Int Letters
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([Int], Od) -> [Int]) -> Map Char ([Int], Od) -> Map Char [Int]
forall a b. (a -> b) -> Map Char a -> Map Char b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Int], Od) -> [Int]
forall a b. (a, b) -> a
fst (Map Char ([Int], Od) -> Map Char [Int])
-> (MatchCdOdInstance -> Map Char ([Int], Od))
-> MatchCdOdInstance
-> Map Char [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MatchCdOdInstance -> Map Char ([Int], Od)
instances
  where
    reverseMapping :: Map Char [Int] -> Map Int Letters
    reverseMapping :: Map Char [Int] -> Map Int Letters
reverseMapping = (Map Int String -> Map Int Letters)
-> (Map Char [Int] -> Map Int String)
-> Map Char [Int]
-> Map Int Letters
forall a b.
(a -> b) -> (Map Char [Int] -> a) -> Map Char [Int] -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((String -> Letters) -> Map Int String -> Map Int Letters
forall a b. (a -> b) -> Map Int a -> Map Int b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Letters
Letters) ((Map Char [Int] -> Map Int String)
 -> Map Char [Int] -> Map Int Letters)
-> (Map Int String -> Map Char [Int] -> Map Int String)
-> Map Int String
-> Map Char [Int]
-> Map Int Letters
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> [Int] -> Map Int String -> Map Int String)
-> Map Int String -> Map Char [Int] -> Map Int String
forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
M.foldrWithKey
      (\Char
x [Int]
ys Map Int String
xs -> (Int -> Map Int String -> Map Int String)
-> Map Int String -> [Int] -> Map Int String
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (ShowS -> Int -> Map Int String -> Map Int String
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
M.adjust (Char
xChar -> ShowS
forall a. a -> [a] -> [a]
:)) Map Int String
xs [Int]
ys)
      (Map Int String -> Map Char [Int] -> Map Int Letters)
-> Map Int String -> Map Char [Int] -> Map Int Letters
forall a b. (a -> b) -> a -> b
$ [(Int, String)] -> Map Int String
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(Int
1, []), (Int
2, [])]

matchCdOd
  :: (MonadAlloy m, MonadCatch m, MonadFail m)
  => MatchCdOdConfig
  -> Int
  -> Int
  -> m MatchCdOdInstance
matchCdOd :: forall (m :: * -> *).
(MonadAlloy m, MonadCatch m, MonadFail m) =>
MatchCdOdConfig -> Int -> Int -> m MatchCdOdInstance
matchCdOd MatchCdOdConfig
config Int
segment Int
seed = (RandT StdGen m MatchCdOdInstance -> StdGen -> m MatchCdOdInstance)
-> StdGen
-> RandT StdGen m MatchCdOdInstance
-> m MatchCdOdInstance
forall a b c. (a -> b -> c) -> b -> a -> c
flip RandT StdGen m MatchCdOdInstance -> StdGen -> m MatchCdOdInstance
forall (m :: * -> *) g a. Monad m => RandT g m a -> g -> m a
evalRandT StdGen
g (RandT StdGen m MatchCdOdInstance -> m MatchCdOdInstance)
-> RandT StdGen m MatchCdOdInstance -> m MatchCdOdInstance
forall a b. (a -> b) -> a -> b
$ do
  MatchCdOdInstance
inst <- (MatchCdOdConfig
 -> RandT StdGen m (Map Int Cd, Map Char ([Int], AlloyInstance)))
-> MatchCdOdConfig -> RandT StdGen m MatchCdOdInstance
forall (m :: * -> *).
(MonadCatch m, MonadRandom m) =>
(MatchCdOdConfig
 -> m (Map Int Cd, Map Char ([Int], AlloyInstance)))
-> MatchCdOdConfig -> m MatchCdOdInstance
getMatchCdOdTask MatchCdOdConfig
-> RandT StdGen m (Map Int Cd, Map Char ([Int], AlloyInstance))
forall (m :: * -> *).
(MonadAlloy m, MonadFail m, MonadRandom m, MonadThrow m) =>
MatchCdOdConfig -> m (Map Int Cd, Map Char ([Int], AlloyInstance))
getRandomTask MatchCdOdConfig
config
  MatchCdOdInstance -> RandT StdGen m MatchCdOdInstance
forall (m :: * -> *) a.
(MonadRandom m, MonadThrow m, Randomise a, RandomiseLayout a,
 RandomiseNames a) =>
a -> m a
shuffleEverything MatchCdOdInstance
inst
  where
    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

getMatchCdOdTask
  :: (MonadCatch m, MonadRandom m)
  => (MatchCdOdConfig
    -> m (Map Int Cd, Map Char ([Int], AlloyInstance)))
  -> MatchCdOdConfig
  -> m MatchCdOdInstance
getMatchCdOdTask :: forall (m :: * -> *).
(MonadCatch m, MonadRandom m) =>
(MatchCdOdConfig
 -> m (Map Int Cd, Map Char ([Int], AlloyInstance)))
-> MatchCdOdConfig -> m MatchCdOdInstance
getMatchCdOdTask MatchCdOdConfig -> m (Map Int Cd, Map Char ([Int], AlloyInstance))
f config :: MatchCdOdConfig
config@MatchCdOdConfig {Bool
[CdMutation]
Maybe Bool
Maybe Int
Maybe Integer
Maybe (Map Language String)
ObjectProperties
ObjectConfig
OmittedDefaultMultiplicities
ClassConfig
allowedCdMutations :: MatchCdOdConfig -> [CdMutation]
classConfig :: MatchCdOdConfig -> ClassConfig
maxInstances :: MatchCdOdConfig -> Maybe Integer
objectConfig :: MatchCdOdConfig -> ObjectConfig
objectProperties :: MatchCdOdConfig -> ObjectProperties
omittedDefaultMultiplicities :: MatchCdOdConfig -> OmittedDefaultMultiplicities
printSolution :: MatchCdOdConfig -> Bool
timeout :: MatchCdOdConfig -> Maybe Int
withNonTrivialInheritance :: MatchCdOdConfig -> Maybe Bool
extraText :: MatchCdOdConfig -> Maybe (Map Language String)
allowedCdMutations :: [CdMutation]
classConfig :: ClassConfig
maxInstances :: Maybe Integer
objectConfig :: ObjectConfig
objectProperties :: ObjectProperties
omittedDefaultMultiplicities :: OmittedDefaultMultiplicities
printSolution :: Bool
timeout :: Maybe Int
withNonTrivialInheritance :: Maybe Bool
extraText :: Maybe (Map Language String)
..} = do
  (Map Int Cd
cds, Map Char ([Int], AlloyInstance)
ods) <- MatchCdOdConfig -> m (Map Int Cd, Map Char ([Int], AlloyInstance))
f MatchCdOdConfig
config
  let possibleLinkNames :: [String]
possibleLinkNames = (Cd -> [String]) -> Map Int Cd -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap
        ((Relationship String String -> Maybe String)
-> [Relationship String String] -> [String]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Relationship String String -> Maybe String
forall c r. Relationship c r -> Maybe r
relationshipName ([Relationship String String] -> [String])
-> (Cd -> [Relationship String String]) -> Cd -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cd -> [Relationship String String]
forall className relationshipName.
ClassDiagram className relationshipName
-> [Relationship className relationshipName]
relationships)
        Map Int Cd
cds
  Map Char ([Int], Od)
ods' <- (([Int], AlloyInstance) -> m ([Int], Od))
-> Map Char ([Int], AlloyInstance) -> m (Map Char ([Int], Od))
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) -> Map Char a -> m (Map Char b)
mapM ((AlloyInstance -> m Od) -> ([Int], AlloyInstance) -> m ([Int], Od)
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) -> ([Int], a) -> m ([Int], b)
mapM ((AlloyInstance -> m Od)
 -> ([Int], AlloyInstance) -> m ([Int], Od))
-> (AlloyInstance -> m Od)
-> ([Int], AlloyInstance)
-> m ([Int], Od)
forall a b. (a -> b) -> a -> b
$ [String] -> AlloyInstance -> m Od
forall {m :: * -> *}.
(MonadRandom m, MonadCatch m) =>
[String] -> AlloyInstance -> m Od
toOd [String]
possibleLinkNames) Map Char ([Int], AlloyInstance)
ods
  return $ MatchCdOdInstance {
        cdDrawSettings :: CdDrawSettings
cdDrawSettings = CdDrawSettings {
          omittedDefaults :: OmittedDefaultMultiplicities
omittedDefaults = OmittedDefaultMultiplicities
omittedDefaultMultiplicities,
          printNames :: Bool
printNames = Bool
True,
          printNavigations :: Bool
printNavigations = Bool
True
          },
        diagrams :: Map Int Cd
diagrams       = Map Int Cd
cds,
        instances :: Map Char ([Int], Od)
instances      = Map Char ([Int], Od)
ods',
        showSolution :: Bool
showSolution = Bool
printSolution,
        taskText :: MatchCdOdTaskText
taskText = MatchCdOdTaskText
defaultMatchCdOdTaskText,
        addText :: Maybe (Map Language String)
addText = Maybe (Map Language String)
extraText
        }
  where
    toOd :: [String] -> AlloyInstance -> m Od
toOd [String]
possibleLinkNames =
      Rational -> Od -> m Od
forall (m :: * -> *) className relationshipName linkLabel.
MonadRandom m =>
Rational
-> ObjectDiagram className relationshipName linkLabel
-> m (ObjectDiagram className relationshipName linkLabel)
anonymiseObjects (ObjectProperties -> Rational
anonymousObjectProportion ObjectProperties
objectProperties)
      (Od -> m Od) -> (AlloyInstance -> m Od) -> AlloyInstance -> m Od
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Maybe [String] -> [String] -> AlloyInstance -> m Od
forall (m :: * -> *).
MonadCatch m =>
Maybe [String] -> [String] -> AlloyInstance -> m Od
alloyInstanceToOd Maybe [String]
forall a. Maybe a
Nothing [String]
possibleLinkNames

{-|
A 'defaultMatchCdOdInstance' as generated using 'defaultMatchCdOdConfig'.
-}
defaultMatchCdOdInstance :: MatchCdOdInstance
defaultMatchCdOdInstance :: MatchCdOdInstance
defaultMatchCdOdInstance = MatchCdOdInstance {
  cdDrawSettings :: CdDrawSettings
cdDrawSettings = CdDrawSettings {
    omittedDefaults :: OmittedDefaultMultiplicities
omittedDefaults = OmittedDefaultMultiplicities {
      aggregationWholeOmittedDefaultMultiplicity :: Maybe (Int, Maybe Int)
aggregationWholeOmittedDefaultMultiplicity = (Int, Maybe Int) -> Maybe (Int, Maybe Int)
forall a. a -> Maybe a
Just (Int
0, Maybe Int
forall a. Maybe a
Nothing),
      associationOmittedDefaultMultiplicity :: Maybe (Int, Maybe Int)
associationOmittedDefaultMultiplicity = (Int, Maybe Int) -> Maybe (Int, Maybe Int)
forall a. a -> Maybe a
Just (Int
0, Maybe Int
forall a. Maybe a
Nothing),
      compositionWholeOmittedDefaultMultiplicity :: Maybe (Int, Maybe Int)
compositionWholeOmittedDefaultMultiplicity = (Int, Maybe Int) -> Maybe (Int, Maybe Int)
forall a. a -> Maybe a
Just (Int
1, Int -> Maybe Int
forall a. a -> Maybe a
Just Int
1)
      },
    printNames :: Bool
printNames = Bool
True,
    printNavigations :: Bool
printNavigations = Bool
True
    },
  diagrams :: Map Int Cd
diagrams = [(Int, Cd)] -> Map Int Cd
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [
    (Int
1, ClassDiagram {
      classNames :: [String]
classNames = [String
"C", String
"D", String
"B", String
"A"],
      relationships :: [Relationship String String]
relationships = [
        Aggregation {
          aggregationName :: String
aggregationName = String
"z",
          aggregationPart :: LimitedLinking String
aggregationPart = LimitedLinking {
            linking :: String
linking = String
"B",
            limits :: (Int, Maybe Int)
limits = (Int
0, Int -> Maybe Int
forall a. a -> Maybe a
Just Int
2)
            },
          aggregationWhole :: LimitedLinking String
aggregationWhole = LimitedLinking {
            linking :: String
linking = String
"A",
            limits :: (Int, Maybe Int)
limits = (Int
1, Maybe Int
forall a. Maybe a
Nothing)
            }
          },
        Association {
          associationName :: String
associationName = String
"w",
          associationFrom :: LimitedLinking String
associationFrom = LimitedLinking {
            linking :: String
linking = String
"C",
            limits :: (Int, Maybe Int)
limits = (Int
1, Maybe Int
forall a. Maybe a
Nothing)
            },
          associationTo :: LimitedLinking String
associationTo = LimitedLinking {
            linking :: String
linking = String
"D",
            limits :: (Int, Maybe Int)
limits = (Int
1, Maybe Int
forall a. Maybe a
Nothing)
            }
          },
        Composition {
          compositionName :: String
compositionName = String
"x",
          compositionPart :: LimitedLinking String
compositionPart = LimitedLinking {
            linking :: String
linking = String
"D",
            limits :: (Int, Maybe Int)
limits = (Int
1, Int -> Maybe Int
forall a. a -> Maybe a
Just Int
2)
            },
          compositionWhole :: LimitedLinking String
compositionWhole = LimitedLinking {
            linking :: String
linking = String
"A",
            limits :: (Int, Maybe Int)
limits = (Int
0, Int -> Maybe Int
forall a. a -> Maybe a
Just Int
1)
            }
          },
        Inheritance {
          subClass :: String
subClass = String
"C",
          superClass :: String
superClass = String
"A"
          }
        ]
      }),
    (Int
2, ClassDiagram {
      classNames :: [String]
classNames = [String
"B", String
"D", String
"A", String
"C"],
      relationships :: [Relationship String String]
relationships = [
        Association {
          associationName :: String
associationName = String
"w",
          associationFrom :: LimitedLinking String
associationFrom = LimitedLinking {
            linking :: String
linking = String
"C",
            limits :: (Int, Maybe Int)
limits = (Int
1, Maybe Int
forall a. Maybe a
Nothing)
            },
          associationTo :: LimitedLinking String
associationTo = LimitedLinking {
            linking :: String
linking = String
"D",
            limits :: (Int, Maybe Int)
limits = (Int
1, Maybe Int
forall a. Maybe a
Nothing)
            }
          },
        Aggregation {
          aggregationName :: String
aggregationName = String
"z",
          aggregationPart :: LimitedLinking String
aggregationPart = LimitedLinking {
            linking :: String
linking = String
"B",
            limits :: (Int, Maybe Int)
limits = (Int
0, Int -> Maybe Int
forall a. a -> Maybe a
Just Int
2)
            },
          aggregationWhole :: LimitedLinking String
aggregationWhole = LimitedLinking {
            linking :: String
linking = String
"A",
            limits :: (Int, Maybe Int)
limits = (Int
1, Maybe Int
forall a. Maybe a
Nothing)
            }
          },
        Composition {
          compositionName :: String
compositionName = String
"x",
          compositionPart :: LimitedLinking String
compositionPart = LimitedLinking {
            linking :: String
linking = String
"A",
            limits :: (Int, Maybe Int)
limits = (Int
2, Maybe Int
forall a. Maybe a
Nothing)
            },
          compositionWhole :: LimitedLinking String
compositionWhole = LimitedLinking {
            linking :: String
linking = String
"D",
            limits :: (Int, Maybe Int)
limits = (Int
0, Int -> Maybe Int
forall a. a -> Maybe a
Just Int
1)
            }
          },
        Inheritance {
          subClass :: String
subClass = String
"C",
          superClass :: String
superClass = String
"A"
          }
        ]
      })
    ],
  instances :: Map Char ([Int], Od)
instances = [(Char, ([Int], Od))] -> Map Char ([Int], Od)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [
    (Char
'a', ([Int
1], ObjectDiagram {
      objects :: [Object String String]
objects = [
        Object {isAnonymous :: Bool
isAnonymous = Bool
False, objectName :: String
objectName = String
"b", objectClass :: String
objectClass = String
"B"},
        Object {isAnonymous :: Bool
isAnonymous = Bool
False, objectName :: String
objectName = String
"d", objectClass :: String
objectClass = String
"D"},
        Object {isAnonymous :: Bool
isAnonymous = Bool
False, objectName :: String
objectName = String
"c", objectClass :: String
objectClass = String
"C"},
        Object {isAnonymous :: Bool
isAnonymous = Bool
True, objectName :: String
objectName = String
"b1", objectClass :: String
objectClass = String
"B"}
        ],
      links :: [Link String String]
links = [
        Link {linkLabel :: String
linkLabel = String
"z", linkFrom :: String
linkFrom = String
"b1", linkTo :: String
linkTo = String
"c"},
        Link {linkLabel :: String
linkLabel = String
"z", linkFrom :: String
linkFrom = String
"b", linkTo :: String
linkTo = String
"c"},
        Link {linkLabel :: String
linkLabel = String
"x", linkFrom :: String
linkFrom = String
"d", linkTo :: String
linkTo = String
"c"},
        Link {linkLabel :: String
linkLabel = String
"w", linkFrom :: String
linkFrom = String
"c", linkTo :: String
linkTo = String
"d"}
        ]
      })),
    (Char
'b', ([], ObjectDiagram {
      objects :: [Object String String]
objects = [
        Object {isAnonymous :: Bool
isAnonymous = Bool
False, objectName :: String
objectName = String
"d", objectClass :: String
objectClass = String
"D"},
        Object {isAnonymous :: Bool
isAnonymous = Bool
True, objectName :: String
objectName = String
"c", objectClass :: String
objectClass = String
"C"},
        Object {isAnonymous :: Bool
isAnonymous = Bool
False, objectName :: String
objectName = String
"b", objectClass :: String
objectClass = String
"B"},
        Object {isAnonymous :: Bool
isAnonymous = Bool
False, objectName :: String
objectName = String
"a", objectClass :: String
objectClass = String
"A"}
        ],
      links :: [Link String String]
links = [
        Link {linkLabel :: String
linkLabel = String
"w", linkFrom :: String
linkFrom = String
"c", linkTo :: String
linkTo = String
"d"},
        Link {linkLabel :: String
linkLabel = String
"z", linkFrom :: String
linkFrom = String
"b", linkTo :: String
linkTo = String
"c"},
        Link {linkLabel :: String
linkLabel = String
"z", linkFrom :: String
linkFrom = String
"b", linkTo :: String
linkTo = String
"a"},
        Link {linkLabel :: String
linkLabel = String
"x", linkFrom :: String
linkFrom = String
"a", linkTo :: String
linkTo = String
"d"}
        ]
      })),
    (Char
'c', ([Int
2], ObjectDiagram {
      objects :: [Object String String]
objects = [
        Object {isAnonymous :: Bool
isAnonymous = Bool
False, objectName :: String
objectName = String
"c", objectClass :: String
objectClass = String
"C"},
        Object {isAnonymous :: Bool
isAnonymous = Bool
True, objectName :: String
objectName = String
"a1", objectClass :: String
objectClass = String
"A"},
        Object {isAnonymous :: Bool
isAnonymous = Bool
False, objectName :: String
objectName = String
"a", objectClass :: String
objectClass = String
"A"},
        Object {isAnonymous :: Bool
isAnonymous = Bool
False, objectName :: String
objectName = String
"d", objectClass :: String
objectClass = String
"D"}
        ],
      links :: [Link String String]
links = [
        Link {linkLabel :: String
linkLabel = String
"w", linkFrom :: String
linkFrom = String
"c", linkTo :: String
linkTo = String
"d"},
        Link {linkLabel :: String
linkLabel = String
"x", linkFrom :: String
linkFrom = String
"c", linkTo :: String
linkTo = String
"d"},
        Link {linkLabel :: String
linkLabel = String
"x", linkFrom :: String
linkFrom = String
"a1", linkTo :: String
linkTo = String
"d"},
        Link {linkLabel :: String
linkLabel = String
"x", linkFrom :: String
linkFrom = String
"a", linkTo :: String
linkTo = String
"d"}
        ]
      })),
    (Char
'd', ([Int
2], ObjectDiagram {
      objects :: [Object String String]
objects = [
        Object {isAnonymous :: Bool
isAnonymous = Bool
False, objectName :: String
objectName = String
"d", objectClass :: String
objectClass = String
"D"},
        Object {isAnonymous :: Bool
isAnonymous = Bool
True, objectName :: String
objectName = String
"c", objectClass :: String
objectClass = String
"C"},
        Object {isAnonymous :: Bool
isAnonymous = Bool
False, objectName :: String
objectName = String
"c1", objectClass :: String
objectClass = String
"C"},
        Object {isAnonymous :: Bool
isAnonymous = Bool
False, objectName :: String
objectName = String
"a", objectClass :: String
objectClass = String
"A"}
        ],
      links :: [Link String String]
links = [
        Link {linkLabel :: String
linkLabel = String
"w", linkFrom :: String
linkFrom = String
"c", linkTo :: String
linkTo = String
"d"},
        Link {linkLabel :: String
linkLabel = String
"w", linkFrom :: String
linkFrom = String
"c1", linkTo :: String
linkTo = String
"d"},
        Link {linkLabel :: String
linkLabel = String
"x", linkFrom :: String
linkFrom = String
"c", linkTo :: String
linkTo = String
"d"},
        Link {linkLabel :: String
linkLabel = String
"x", linkFrom :: String
linkFrom = String
"c1", linkTo :: String
linkTo = String
"d"}
        ]
      })),
    (Char
'e', ([Int
1], ObjectDiagram {
      objects :: [Object String String]
objects = [
        Object {isAnonymous :: Bool
isAnonymous = Bool
False, objectName :: String
objectName = String
"d", objectClass :: String
objectClass = String
"D"},
        Object {isAnonymous :: Bool
isAnonymous = Bool
True, objectName :: String
objectName = String
"d1", objectClass :: String
objectClass = String
"D"},
        Object {isAnonymous :: Bool
isAnonymous = Bool
False, objectName :: String
objectName = String
"a", objectClass :: String
objectClass = String
"A"},
        Object {isAnonymous :: Bool
isAnonymous = Bool
False, objectName :: String
objectName = String
"c", objectClass :: String
objectClass = String
"C"}
        ],
      links :: [Link String String]
links = [
        Link {linkLabel :: String
linkLabel = String
"w", linkFrom :: String
linkFrom = String
"c", linkTo :: String
linkTo = String
"d"},
        Link {linkLabel :: String
linkLabel = String
"w", linkFrom :: String
linkFrom = String
"c", linkTo :: String
linkTo = String
"d1"},
        Link {linkLabel :: String
linkLabel = String
"x", linkFrom :: String
linkFrom = String
"d", linkTo :: String
linkTo = String
"a"},
        Link {linkLabel :: String
linkLabel = String
"x", linkFrom :: String
linkFrom = String
"d1", linkTo :: String
linkTo = String
"c"}
        ]
      }))
    ],
  showSolution :: Bool
showSolution = Bool
False,
  taskText :: MatchCdOdTaskText
taskText = MatchCdOdTaskText
defaultMatchCdOdTaskText,
  addText :: Maybe (Map Language String)
addText = Maybe (Map Language String)
forall a. Maybe a
Nothing
  }

classAndNonInheritanceNames :: MatchCdOdInstance -> ([String], [String])
classAndNonInheritanceNames :: MatchCdOdInstance -> ([String], [String])
classAndNonInheritanceNames MatchCdOdInstance
inst =
  let names :: [String]
names = [String] -> [String]
forall a. Ord a => [a] -> [a]
nubOrd ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ (Cd -> [String]) -> Map Int Cd -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Cd -> [String]
forall className relationshipName.
ClassDiagram className relationshipName -> [className]
classNames (MatchCdOdInstance -> Map Int Cd
diagrams MatchCdOdInstance
inst)
      nonInheritances :: [String]
nonInheritances = [String] -> [String]
forall a. Ord a => [a] -> [a]
nubOrd ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ (Cd -> [String]) -> Map Int Cd -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Cd -> [String]
associationNames (MatchCdOdInstance -> Map Int Cd
diagrams MatchCdOdInstance
inst)
        [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ (([Int], Od) -> [String]) -> Map Char ([Int], Od) -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Od -> [String]
forall linkLabel objectName className.
Ord linkLabel =>
ObjectDiagram objectName className linkLabel -> [linkLabel]
linkLabels (Od -> [String]) -> (([Int], Od) -> Od) -> ([Int], Od) -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Int], Od) -> Od
forall a b. (a, b) -> b
snd) (MatchCdOdInstance -> Map Char ([Int], Od)
instances MatchCdOdInstance
inst)
  in ([String]
names, [String]
nonInheritances)

instance Randomise MatchCdOdInstance where
  randomise :: forall (m :: * -> *).
(MonadRandom m, MonadThrow m) =>
MatchCdOdInstance -> m MatchCdOdInstance
randomise = MatchCdOdInstance -> m MatchCdOdInstance
forall (m :: * -> *).
(MonadThrow m, MonadRandom m) =>
MatchCdOdInstance -> m MatchCdOdInstance
shuffleInstance

instance RandomiseNames MatchCdOdInstance where
  randomiseNames :: forall (m :: * -> *).
(MonadRandom m, MonadThrow m) =>
MatchCdOdInstance -> m MatchCdOdInstance
randomiseNames MatchCdOdInstance
inst = do
    let ([String]
names, [String]
nonInheritances) = MatchCdOdInstance -> ([String], [String])
classAndNonInheritanceNames MatchCdOdInstance
inst
    [String]
names'  <- [String] -> m [String]
forall (m :: * -> *) a. MonadRandom m => [a] -> m [a]
shuffleM [String]
names
    [String]
nonInheritances' <- [String] -> m [String]
forall (m :: * -> *) a. MonadRandom m => [a] -> m [a]
shuffleM [String]
nonInheritances
    MatchCdOdInstance -> [String] -> [String] -> m MatchCdOdInstance
forall (m :: * -> *).
MonadThrow m =>
MatchCdOdInstance -> [String] -> [String] -> m MatchCdOdInstance
renameInstance MatchCdOdInstance
inst [String]
names' [String]
nonInheritances'

  hasRandomisableNames :: MatchCdOdInstance -> Maybe String
hasRandomisableNames MatchCdOdInstance {Bool
MatchCdOdTaskText
Maybe (Map Language String)
Map Char ([Int], Od)
Map Int Cd
CdDrawSettings
cdDrawSettings :: MatchCdOdInstance -> CdDrawSettings
diagrams :: MatchCdOdInstance -> Map Int Cd
instances :: MatchCdOdInstance -> Map Char ([Int], Od)
showSolution :: MatchCdOdInstance -> Bool
taskText :: MatchCdOdInstance -> MatchCdOdTaskText
addText :: MatchCdOdInstance -> Maybe (Map Language String)
cdDrawSettings :: CdDrawSettings
diagrams :: Map Int Cd
instances :: Map Char ([Int], Od)
showSolution :: Bool
taskText :: MatchCdOdTaskText
addText :: Maybe (Map Language String)
..} = [String] -> Maybe String
forall a. [a] -> Maybe a
listToMaybe
    ([String] -> Maybe String) -> [String] -> Maybe String
forall a b. (a -> b) -> a -> b
$ (([Int], Od) -> Maybe String) -> [([Int], Od)] -> [String]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Od -> Maybe String
forall linkLabels.
ObjectDiagram String String linkLabels -> Maybe String
isObjectDiagramRandomisable (Od -> Maybe String)
-> (([Int], Od) -> Od) -> ([Int], Od) -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Int], Od) -> Od
forall a b. (a, b) -> b
snd) ([([Int], Od)] -> [String]) -> [([Int], Od)] -> [String]
forall a b. (a -> b) -> a -> b
$ Map Char ([Int], Od) -> [([Int], Od)]
forall k a. Map k a -> [a]
M.elems Map Char ([Int], Od)
instances

instance RandomiseLayout MatchCdOdInstance where
  randomiseLayout :: forall (m :: * -> *).
(MonadRandom m, MonadThrow m) =>
MatchCdOdInstance -> m MatchCdOdInstance
randomiseLayout = MatchCdOdInstance -> m MatchCdOdInstance
forall (m :: * -> *).
MonadRandom m =>
MatchCdOdInstance -> m MatchCdOdInstance
shuffleNodesAndEdges

shuffleNodesAndEdges
  :: MonadRandom m
  => MatchCdOdInstance
  -> m MatchCdOdInstance
shuffleNodesAndEdges :: forall (m :: * -> *).
MonadRandom m =>
MatchCdOdInstance -> m MatchCdOdInstance
shuffleNodesAndEdges MatchCdOdInstance {Bool
MatchCdOdTaskText
Maybe (Map Language String)
Map Char ([Int], Od)
Map Int Cd
CdDrawSettings
cdDrawSettings :: MatchCdOdInstance -> CdDrawSettings
diagrams :: MatchCdOdInstance -> Map Int Cd
instances :: MatchCdOdInstance -> Map Char ([Int], Od)
showSolution :: MatchCdOdInstance -> Bool
taskText :: MatchCdOdInstance -> MatchCdOdTaskText
addText :: MatchCdOdInstance -> Maybe (Map Language String)
cdDrawSettings :: CdDrawSettings
diagrams :: Map Int Cd
instances :: Map Char ([Int], Od)
showSolution :: Bool
taskText :: MatchCdOdTaskText
addText :: Maybe (Map Language String)
..} = do
  Map Int Cd
cds <- (Cd -> m Cd) -> Map Int Cd -> m (Map Int Cd)
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) -> Map Int a -> m (Map Int b)
mapM Cd -> m Cd
forall (m :: * -> *). MonadRandom m => Cd -> m Cd
shuffleClassAndConnectionOrder Map Int Cd
diagrams
  Map Char ([Int], Od)
ods <- (([Int], Od) -> m ([Int], Od))
-> Map Char ([Int], Od) -> m (Map Char ([Int], Od))
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) -> Map Char a -> m (Map Char b)
mapM ((Od -> m Od) -> ([Int], Od) -> m ([Int], Od)
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) -> ([Int], a) -> m ([Int], b)
mapM Od -> m Od
forall (m :: * -> *) objectName className linkLabel.
MonadRandom m =>
ObjectDiagram objectName className linkLabel
-> m (ObjectDiagram objectName className linkLabel)
shuffleObjectAndLinkOrder) Map Char ([Int], Od)
instances
  return MatchCdOdInstance {
    cdDrawSettings :: CdDrawSettings
cdDrawSettings = CdDrawSettings
cdDrawSettings,
    diagrams :: Map Int Cd
diagrams = Map Int Cd
cds,
    instances :: Map Char ([Int], Od)
instances = Map Char ([Int], Od)
ods,
    showSolution :: Bool
showSolution = Bool
showSolution,
    taskText :: MatchCdOdTaskText
taskText = MatchCdOdTaskText
taskText,
    addText :: Maybe (Map Language String)
addText = Maybe (Map Language String)
addText
    }

shuffleInstance
  :: (MonadThrow m, MonadRandom m)
  => MatchCdOdInstance
  -> m MatchCdOdInstance
shuffleInstance :: forall (m :: * -> *).
(MonadThrow m, MonadRandom m) =>
MatchCdOdInstance -> m MatchCdOdInstance
shuffleInstance MatchCdOdInstance {Bool
MatchCdOdTaskText
Maybe (Map Language String)
Map Char ([Int], Od)
Map Int Cd
CdDrawSettings
cdDrawSettings :: MatchCdOdInstance -> CdDrawSettings
diagrams :: MatchCdOdInstance -> Map Int Cd
instances :: MatchCdOdInstance -> Map Char ([Int], Od)
showSolution :: MatchCdOdInstance -> Bool
taskText :: MatchCdOdInstance -> MatchCdOdTaskText
addText :: MatchCdOdInstance -> Maybe (Map Language String)
cdDrawSettings :: CdDrawSettings
diagrams :: Map Int Cd
instances :: Map Char ([Int], Od)
showSolution :: Bool
taskText :: MatchCdOdTaskText
addText :: Maybe (Map Language String)
..} = do
  [(Int, Cd)]
cds <- [(Int, Cd)] -> m [(Int, Cd)]
forall (m :: * -> *) a. MonadRandom m => [a] -> m [a]
shuffleM ([(Int, Cd)] -> m [(Int, Cd)]) -> [(Int, Cd)] -> m [(Int, Cd)]
forall a b. (a -> b) -> a -> b
$ Map Int Cd -> [(Int, Cd)]
forall k a. Map k a -> [(k, a)]
M.toList Map Int Cd
diagrams
  [(Char, ([Int], Od))]
ods <- [(Char, ([Int], Od))] -> m [(Char, ([Int], Od))]
forall (m :: * -> *) a. MonadRandom m => [a] -> m [a]
shuffleM ([(Char, ([Int], Od))] -> m [(Char, ([Int], Od))])
-> [(Char, ([Int], Od))] -> m [(Char, ([Int], Od))]
forall a b. (a -> b) -> a -> b
$ Map Char ([Int], Od) -> [(Char, ([Int], Od))]
forall k a. Map k a -> [(k, a)]
M.toList Map Char ([Int], Od)
instances
  let changeId :: a -> (a, b) -> ((a, a), (a, b))
changeId a
x (a
y, b
cd) = ((a
y, a
x), (a
x, b
cd))
      ([(Int, Int)]
idMap, [(Int, Cd)]
cds') = [((Int, Int), (Int, Cd))] -> ([(Int, Int)], [(Int, Cd)])
forall a b. [(a, b)] -> ([a], [b])
unzip ([((Int, Int), (Int, Cd))] -> ([(Int, Int)], [(Int, Cd)]))
-> [((Int, Int), (Int, Cd))] -> ([(Int, Int)], [(Int, Cd)])
forall a b. (a -> b) -> a -> b
$ (Int -> (Int, Cd) -> ((Int, Int), (Int, Cd)))
-> [Int] -> [(Int, Cd)] -> [((Int, Int), (Int, Cd))]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> (Int, Cd) -> ((Int, Int), (Int, Cd))
forall {a} {a} {b}. a -> (a, b) -> ((a, a), (a, b))
changeId [Int
1..] [(Int, Cd)]
cds
      replaceId :: a -> (a, b) -> (a, b)
replaceId a
x (a
_, b
od) = (a
x, b
od)
      rename :: Int -> m Int
rename = m Int -> (Int -> m Int) -> Maybe Int -> m Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (MatchCdOdException -> m Int
forall e a. Exception e => e -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM MatchCdOdException
InvalidMatchCdOdInstance) Int -> m Int
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
        (Maybe Int -> m Int) -> (Int -> Maybe Int) -> Int -> m Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> [(Int, Int)] -> Maybe Int
forall a b. Eq a => a -> [(a, b)] -> Maybe b
`lookup` [(Int, Int)]
idMap)
  [(Char, ([Int], Od))]
ods' <- ((Char, ([Int], Od)) -> m (Char, ([Int], Od)))
-> [(Char, ([Int], Od))] -> m [(Char, ([Int], Od))]
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 ((([Int], Od) -> m ([Int], Od))
-> (Char, ([Int], Od)) -> m (Char, ([Int], Od))
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) -> (Char, a) -> m (Char, b)
mapM ((([Int], Od) -> m ([Int], Od))
 -> (Char, ([Int], Od)) -> m (Char, ([Int], Od)))
-> (([Int], Od) -> m ([Int], Od))
-> (Char, ([Int], Od))
-> m (Char, ([Int], Od))
forall a b. (a -> b) -> a -> b
$ ([Int] -> m [Int]) -> (Od -> m Od) -> ([Int], Od) -> m ([Int], Od)
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bimapM ((Int -> m Int) -> [Int] -> m [Int]
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 Int -> m Int
rename) Od -> m Od
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return)
    ([(Char, ([Int], Od))] -> m [(Char, ([Int], Od))])
-> [(Char, ([Int], Od))] -> m [(Char, ([Int], Od))]
forall a b. (a -> b) -> a -> b
$ (Char -> (Char, ([Int], Od)) -> (Char, ([Int], Od)))
-> String -> [(Char, ([Int], Od))] -> [(Char, ([Int], Od))]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Char -> (Char, ([Int], Od)) -> (Char, ([Int], Od))
forall {a} {a} {b}. a -> (a, b) -> (a, b)
replaceId [Char
'a'..] [(Char, ([Int], Od))]
ods
  return $ MatchCdOdInstance {
    cdDrawSettings :: CdDrawSettings
cdDrawSettings = CdDrawSettings
cdDrawSettings,
    diagrams :: Map Int Cd
diagrams = [(Int, Cd)] -> Map Int Cd
forall k a. Eq k => [(k, a)] -> Map k a
M.fromAscList [(Int, Cd)]
cds',
    instances :: Map Char ([Int], Od)
instances = [(Char, ([Int], Od))] -> Map Char ([Int], Od)
forall k a. Eq k => [(k, a)] -> Map k a
M.fromAscList [(Char, ([Int], Od))]
ods',
    showSolution :: Bool
showSolution = Bool
showSolution,
    taskText :: MatchCdOdTaskText
taskText = MatchCdOdTaskText
taskText,
    addText :: Maybe (Map Language String)
addText = Maybe (Map Language String)
addText
    }

renameInstance
  :: MonadThrow m
  => MatchCdOdInstance
  -> [String]
  -> [String]
  -> m MatchCdOdInstance
renameInstance :: forall (m :: * -> *).
MonadThrow m =>
MatchCdOdInstance -> [String] -> [String] -> m MatchCdOdInstance
renameInstance inst :: MatchCdOdInstance
inst@MatchCdOdInstance {Bool
MatchCdOdTaskText
Maybe (Map Language String)
Map Char ([Int], Od)
Map Int Cd
CdDrawSettings
cdDrawSettings :: MatchCdOdInstance -> CdDrawSettings
diagrams :: MatchCdOdInstance -> Map Int Cd
instances :: MatchCdOdInstance -> Map Char ([Int], Od)
showSolution :: MatchCdOdInstance -> Bool
taskText :: MatchCdOdInstance -> MatchCdOdTaskText
addText :: MatchCdOdInstance -> Maybe (Map Language String)
cdDrawSettings :: CdDrawSettings
diagrams :: Map Int Cd
instances :: Map Char ([Int], Od)
showSolution :: Bool
taskText :: MatchCdOdTaskText
addText :: Maybe (Map Language String)
..} [String]
names' [String]
nonInheritances' = do
  let ([String]
names, [String]
nonInheritances) = MatchCdOdInstance -> ([String], [String])
classAndNonInheritanceNames MatchCdOdInstance
inst
      bmNames :: Bimap String String
bmNames  = [(String, String)] -> Bimap String String
forall a b. (Ord a, Ord b) => [(a, b)] -> Bimap a b
BM.fromList ([(String, String)] -> Bimap String String)
-> [(String, String)] -> Bimap String String
forall a b. (a -> b) -> a -> b
$ [String] -> [String] -> [(String, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip [String]
names [String]
names'
      bmNonInheritances :: Bimap String String
bmNonInheritances = [(String, String)] -> Bimap String String
forall a b. (Ord a, Ord b) => [(a, b)] -> Bimap a b
BM.fromList ([(String, String)] -> Bimap String String)
-> [(String, String)] -> Bimap String String
forall a b. (a -> b) -> a -> b
$ [String] -> [String] -> [(String, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip [String]
nonInheritances [String]
nonInheritances'
      renameCd :: Cd -> m Cd
renameCd = Bimap String String -> Bimap String String -> Cd -> m Cd
forall (f :: * -> * -> *) (m :: * -> *) c c' r r'.
(Bitraversable f, MonadThrow m, Ord c, Ord c', Ord r, Ord r') =>
Bimap c c' -> Bimap r r' -> f c r -> m (f c' r')
renameClassesAndRelationships Bimap String String
bmNames Bimap String String
bmNonInheritances
      renameOd :: Od -> m Od
renameOd = Bimap String String -> Bimap String String -> Od -> m Od
forall (m :: * -> *) linkLabels linkLabels'.
(MonadThrow m, Ord linkLabels, Ord linkLabels') =>
Bimap String String
-> Bimap linkLabels linkLabels'
-> ObjectDiagram String String linkLabels
-> m (ObjectDiagram String String linkLabels')
renameObjectsWithClassesAndLinksInOd Bimap String String
bmNames Bimap String String
bmNonInheritances
  Map Int Cd
cds <- Cd -> m Cd
renameCd (Cd -> m Cd) -> Map Int Cd -> m (Map Int Cd)
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) -> Map Int a -> m (Map Int b)
`mapM` Map Int Cd
diagrams
  Map Char ([Int], Od)
ods <- (Od -> m Od) -> ([Int], Od) -> m ([Int], Od)
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) -> ([Int], a) -> m ([Int], b)
mapM Od -> m Od
renameOd (([Int], Od) -> m ([Int], Od))
-> Map Char ([Int], Od) -> m (Map Char ([Int], Od))
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) -> Map Char a -> m (Map Char b)
`mapM` Map Char ([Int], Od)
instances
  return $ MatchCdOdInstance {
    cdDrawSettings :: CdDrawSettings
cdDrawSettings = CdDrawSettings
cdDrawSettings,
    diagrams :: Map Int Cd
diagrams = Map Int Cd
cds,
    instances :: Map Char ([Int], Od)
instances = Map Char ([Int], Od)
ods,
    showSolution :: Bool
showSolution = Bool
showSolution,
    taskText :: MatchCdOdTaskText
taskText = MatchCdOdTaskText
taskText,
    addText :: Maybe (Map Language String)
addText = Maybe (Map Language String)
addText
    }

getRandomTask
  :: (MonadAlloy m, MonadFail m, MonadRandom m, MonadThrow m)
  => MatchCdOdConfig
  -> m (Map Int Cd, Map Char ([Int], AlloyInstance))
getRandomTask :: forall (m :: * -> *).
(MonadAlloy m, MonadFail m, MonadRandom m, MonadThrow m) =>
MatchCdOdConfig -> m (Map Int Cd, Map Char ([Int], AlloyInstance))
getRandomTask MatchCdOdConfig
config = do
  let alloyCode :: String
alloyCode = ClassConfig
-> [CdMutation] -> RelationshipProperties -> Maybe Bool -> String
Changes.transform
        (MatchCdOdConfig -> ClassConfig
classConfig MatchCdOdConfig
config)
        (MatchCdOdConfig -> [CdMutation]
allowedCdMutations MatchCdOdConfig
config)
        RelationshipProperties
defaultProperties
        (MatchCdOdConfig -> Maybe Bool
withNonTrivialInheritance MatchCdOdConfig
config)
  [AlloyInstance]
alloyInstances <- Maybe Integer -> Maybe Int -> String -> m [AlloyInstance]
forall (m :: * -> *).
MonadAlloy m =>
Maybe Integer -> Maybe Int -> String -> m [AlloyInstance]
getInstances (MatchCdOdConfig -> Maybe Integer
maxInstances MatchCdOdConfig
config) (MatchCdOdConfig -> Maybe Int
timeout MatchCdOdConfig
config) String
alloyCode
  [AlloyInstance]
randomInstances <- [AlloyInstance] -> m [AlloyInstance]
forall (m :: * -> *) a. MonadRandom m => [a] -> m [a]
shuffleM [AlloyInstance]
alloyInstances
  Maybe (Map Int Cd, Map Char ([Int], AlloyInstance))
ods <- MatchCdOdConfig
-> [AlloyInstance]
-> m (Maybe (Map Int Cd, Map Char ([Int], AlloyInstance)))
forall (m :: * -> *).
(MonadAlloy m, MonadFail m, MonadRandom m, MonadThrow m) =>
MatchCdOdConfig
-> [AlloyInstance]
-> m (Maybe (Map Int Cd, Map Char ([Int], AlloyInstance)))
getODsFor MatchCdOdConfig
config { timeout :: Maybe Int
timeout = Maybe Int
forall a. Maybe a
Nothing } [AlloyInstance]
randomInstances
  m (Map Int Cd, Map Char ([Int], AlloyInstance))
-> ((Map Int Cd, Map Char ([Int], AlloyInstance))
    -> m (Map Int Cd, Map Char ([Int], AlloyInstance)))
-> Maybe (Map Int Cd, Map Char ([Int], AlloyInstance))
-> m (Map Int Cd, Map Char ([Int], AlloyInstance))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> m (Map Int Cd, Map Char ([Int], AlloyInstance))
forall a. HasCallStack => String -> a
error String
"could not find instance") (Map Int Cd, Map Char ([Int], AlloyInstance))
-> m (Map Int Cd, Map Char ([Int], AlloyInstance))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Map Int Cd, Map Char ([Int], AlloyInstance))
ods

getODsFor
  :: (MonadAlloy m, MonadFail m, MonadRandom m, MonadThrow m)
  => MatchCdOdConfig
  -> [AlloyInstance]
  -> m (Maybe (Map Int Cd, Map Char ([Int], AlloyInstance)))
getODsFor :: forall (m :: * -> *).
(MonadAlloy m, MonadFail m, MonadRandom m, MonadThrow m) =>
MatchCdOdConfig
-> [AlloyInstance]
-> m (Maybe (Map Int Cd, Map Char ([Int], AlloyInstance)))
getODsFor MatchCdOdConfig
_      []       = Maybe (Map Int Cd, Map Char ([Int], AlloyInstance))
-> m (Maybe (Map Int Cd, Map Char ([Int], AlloyInstance)))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Map Int Cd, Map Char ([Int], AlloyInstance))
forall a. Maybe a
Nothing
getODsFor MatchCdOdConfig
config (AlloyInstance
cd:[AlloyInstance]
cds) = do
  [ChangeAndCd String String]
cds' <- GenericClassDiagramInstance String String
-> [ChangeAndCd String String]
forall className relationshipName.
GenericClassDiagramInstance className relationshipName
-> [ChangeAndCd className relationshipName]
instanceChangesAndCds
    (GenericClassDiagramInstance String String
 -> [ChangeAndCd String String])
-> m (GenericClassDiagramInstance String String)
-> m [ChangeAndCd String String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (GenericClassDiagramInstance String String
-> m (GenericClassDiagramInstance String String)
forall (m :: * -> *) className relationshipName.
(MonadThrow m, Ord className, Ord relationshipName) =>
GenericClassDiagramInstance className relationshipName
-> m (GenericClassDiagramInstance String String)
nameClassDiagramInstance (GenericClassDiagramInstance String String
 -> m (GenericClassDiagramInstance String String))
-> (AlloyInstance -> m (GenericClassDiagramInstance String String))
-> AlloyInstance
-> m (GenericClassDiagramInstance String String)
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< AlloyInstance -> m (GenericClassDiagramInstance String String)
forall (m :: * -> *).
MonadThrow m =>
AlloyInstance -> m (GenericClassDiagramInstance String String)
fromInstanceWithNameOverlap) AlloyInstance
cd
  [Cd]
cds'' <- (ChangeAndCd String String -> m Cd)
-> [ChangeAndCd String String] -> m [Cd]
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 ChangeAndCd String String -> m Cd
forall className (m :: * -> *) relationshipName.
(Eq className, MonadThrow m, Show className, Show relationshipName,
 Typeable className, Typeable relationshipName) =>
ChangeAndCd className relationshipName
-> m (ClassDiagram className relationshipName)
validChangeClassDiagram [ChangeAndCd String String]
cds'
  [Cd
cd1', Cd
cd2', Cd
cd3] <- (Cd -> m Cd) -> [Cd] -> m [Cd]
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 Cd -> m Cd
forall (m :: * -> *). MonadRandom m => Cd -> m Cd
shuffleClassAndConnectionOrder [Cd]
cds''
    m [Cd] -> ([Cd] -> m [Cd]) -> m [Cd]
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Cd] -> m [Cd]
forall (m :: * -> *) (t :: * -> *).
(MonadRandom m, Traversable t, MonadThrow m) =>
t Cd -> m (t Cd)
shuffleCdNames
  [Cd
cd1, Cd
cd2] <- [Cd] -> m [Cd]
forall (m :: * -> *) a. MonadRandom m => [a] -> m [a]
shuffleM [Cd
cd1', Cd
cd2']
  Map [Int] [AlloyInstance]
alloyInstances <- MatchCdOdConfig
-> Cd -> Cd -> Cd -> Int -> m (Map [Int] [AlloyInstance])
forall (m :: * -> *).
MonadAlloy m =>
MatchCdOdConfig
-> Cd -> Cd -> Cd -> Int -> m (Map [Int] [AlloyInstance])
getODInstances MatchCdOdConfig
config Cd
cd1 Cd
cd2 Cd
cd3 (Int -> m (Map [Int] [AlloyInstance]))
-> Int -> m (Map [Int] [AlloyInstance])
forall a b. (a -> b) -> a -> b
$ [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
$ Cd -> [String]
forall className relationshipName.
ClassDiagram className relationshipName -> [className]
classNames Cd
cd1
  Maybe [([Int], AlloyInstance)]
maybeRandomInstances <- Map [Int] [AlloyInstance] -> m (Maybe [([Int], AlloyInstance)])
forall (m :: * -> *) a.
(MonadRandom m, MonadFail m) =>
Map [Int] [a] -> m (Maybe [([Int], a)])
takeRandomInstances Map [Int] [AlloyInstance]
alloyInstances
  case Maybe [([Int], AlloyInstance)]
maybeRandomInstances of
    Maybe [([Int], AlloyInstance)]
Nothing      -> MatchCdOdConfig
-> [AlloyInstance]
-> m (Maybe (Map Int Cd, Map Char ([Int], AlloyInstance)))
forall (m :: * -> *).
(MonadAlloy m, MonadFail m, MonadRandom m, MonadThrow m) =>
MatchCdOdConfig
-> [AlloyInstance]
-> m (Maybe (Map Int Cd, Map Char ([Int], AlloyInstance)))
getODsFor MatchCdOdConfig
config [AlloyInstance]
cds
    Just [([Int], AlloyInstance)]
randomInstances -> Maybe (Map Int Cd, Map Char ([Int], AlloyInstance))
-> m (Maybe (Map Int Cd, Map Char ([Int], AlloyInstance)))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Map Int Cd, Map Char ([Int], AlloyInstance))
 -> m (Maybe (Map Int Cd, Map Char ([Int], AlloyInstance))))
-> Maybe (Map Int Cd, Map Char ([Int], AlloyInstance))
-> m (Maybe (Map Int Cd, Map Char ([Int], AlloyInstance)))
forall a b. (a -> b) -> a -> b
$ (Map Int Cd, Map Char ([Int], AlloyInstance))
-> Maybe (Map Int Cd, Map Char ([Int], AlloyInstance))
forall a. a -> Maybe a
Just (
      [(Int, Cd)] -> Map Int Cd
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(Int
1, Cd
cd1), (Int
2, Cd
cd2)],
      [(Char, ([Int], AlloyInstance))] -> Map Char ([Int], AlloyInstance)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Char, ([Int], AlloyInstance))]
 -> Map Char ([Int], AlloyInstance))
-> [(Char, ([Int], AlloyInstance))]
-> Map Char ([Int], AlloyInstance)
forall a b. (a -> b) -> a -> b
$ String
-> [([Int], AlloyInstance)] -> [(Char, ([Int], AlloyInstance))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Char
'a' ..] [([Int], AlloyInstance)]
randomInstances
      )

getODInstances
  :: MonadAlloy m
  => MatchCdOdConfig
  -> Cd
  -> Cd
  -> Cd
  -> Int
  -> m (Map [Int] [AlloyInstance])
getODInstances :: forall (m :: * -> *).
MonadAlloy m =>
MatchCdOdConfig
-> Cd -> Cd -> Cd -> Int -> m (Map [Int] [AlloyInstance])
getODInstances MatchCdOdConfig
config Cd
cd1 Cd
cd2 Cd
cd3 Int
numClasses = do
  let parts1 :: Parts
parts1 = Cd -> String -> Parts
alloyFor Cd
cd1 String
"1"
      parts2 :: Parts
parts2 = Cd -> String -> Parts
alloyFor Cd
cd2 String
"2"
      parts1and2 :: Parts
parts1and2 = Parts -> Parts -> Parts
mergeParts Parts
parts1 Parts
parts2
      combined1and2 :: String
combined1and2 = Parts -> String
combineParts Parts
parts1and2
      parts3 :: Parts
parts3 = Cd -> String -> Parts
alloyFor Cd
cd3 String
"3"
      parts1to3 :: Parts
parts1to3 = Parts -> Parts -> Parts
mergeParts Parts
parts1and2 Parts
parts3
      relationships1and2 :: [Relationship String String]
relationships1and2 = Cd -> [Relationship String String]
forall className relationshipName.
ClassDiagram className relationshipName
-> [Relationship className relationshipName]
relationships Cd
cd1 [Relationship String String]
-> [Relationship String String] -> [Relationship String String]
forall a. [a] -> [a] -> [a]
++ Cd -> [Relationship String String]
forall className relationshipName.
ClassDiagram className relationshipName
-> [Relationship className relationshipName]
relationships Cd
cd2
      relationships1to3 :: [Relationship String String]
relationships1to3 = [Relationship String String]
relationships1and2 [Relationship String String]
-> [Relationship String String] -> [Relationship String String]
forall a. [a] -> [a] -> [a]
++ Cd -> [Relationship String String]
forall className relationshipName.
ClassDiagram className relationshipName
-> [Relationship className relationshipName]
relationships Cd
cd3
      allRelationshipNames :: [String]
allRelationshipNames = (Relationship String String -> Maybe String)
-> [Relationship String String] -> [String]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Relationship String String -> Maybe String
forall c r. Relationship c r -> Maybe r
relationshipName [Relationship String String]
relationships1to3
      alloyFor :: Cd -> String -> Parts
alloyFor = [String] -> Cd -> String -> Parts
alloyForAllRelationships [String]
allRelationshipNames
      cd1not2 :: String
cd1not2 = String -> [Relationship String String] -> String
forall {a} {b}. String -> [Relationship a b] -> String
runCommand String
"cd1 and (not cd2)" [Relationship String String]
relationships1and2
      cd2not1 :: String
cd2not1 = String -> [Relationship String String] -> String
forall {a} {b}. String -> [Relationship a b] -> String
runCommand String
"cd2 and (not cd1)" [Relationship String String]
relationships1and2
      cd1and2 :: String
cd1and2 = String -> [Relationship String String] -> String
forall {a} {b}. String -> [Relationship a b] -> String
runCommand String
"cd1 and cd2" [Relationship String String]
relationships1and2
      cdNot1not2 :: String
cdNot1not2 = String -> [Relationship String String] -> String
forall {a} {b}. String -> [Relationship a b] -> String
runCommand
        String
"(not cd1) and (not cd2) and cd3"
        [Relationship String String]
relationships1to3
  [AlloyInstance]
instances1not2 <- Maybe Integer -> Maybe Int -> String -> m [AlloyInstance]
forall (m :: * -> *).
MonadAlloy m =>
Maybe Integer -> Maybe Int -> String -> m [AlloyInstance]
getInstances Maybe Integer
maxIs Maybe Int
to (String
combined1and2 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
cd1not2)
  [AlloyInstance]
instances2not1 <- Maybe Integer -> Maybe Int -> String -> m [AlloyInstance]
forall (m :: * -> *).
MonadAlloy m =>
Maybe Integer -> Maybe Int -> String -> m [AlloyInstance]
getInstances Maybe Integer
maxIs Maybe Int
to (String
combined1and2 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
cd2not1)
  [AlloyInstance]
instances1and2 <- Maybe Integer -> Maybe Int -> String -> m [AlloyInstance]
forall (m :: * -> *).
MonadAlloy m =>
Maybe Integer -> Maybe Int -> String -> m [AlloyInstance]
getInstances Maybe Integer
maxIs Maybe Int
to (String
combined1and2 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
cd1and2)
  [AlloyInstance]
instancesNot1not2 <-
    Maybe Integer -> Maybe Int -> String -> m [AlloyInstance]
forall (m :: * -> *).
MonadAlloy m =>
Maybe Integer -> Maybe Int -> String -> m [AlloyInstance]
getInstances Maybe Integer
maxIs Maybe Int
to (Parts -> String
combineParts Parts
parts1to3 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
cdNot1not2)
  return $ [([Int], [AlloyInstance])] -> Map [Int] [AlloyInstance]
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [([Int
1]  , [AlloyInstance]
instances1not2),
                       ([Int
2]  , [AlloyInstance]
instances2not1),
                       ([Int
1,Int
2], [AlloyInstance]
instances1and2),
                       ([]   , [AlloyInstance]
instancesNot1not2)]
  where
    alloyForAllRelationships :: [String] -> Cd -> String -> Parts
alloyForAllRelationships [String]
allRelationshipNames Cd
cd String
nr = LinguisticReuse
-> Cd
-> Maybe [String]
-> [String]
-> ObjectConfig
-> ObjectProperties
-> String
-> String
-> Parts
transform
      LinguisticReuse
None
      Cd
cd
      ([String] -> Maybe [String]
forall a. a -> Maybe a
Just [String]
allRelationshipNames)
      []
      (MatchCdOdConfig -> ObjectConfig
objectConfig MatchCdOdConfig
config)
      (MatchCdOdConfig -> ObjectProperties
objectProperties MatchCdOdConfig
config)
      String
nr
      String
""
    to :: Maybe Int
to = MatchCdOdConfig -> Maybe Int
timeout MatchCdOdConfig
config
    maxIs :: Maybe Integer
maxIs = MatchCdOdConfig -> Maybe Integer
maxInstances MatchCdOdConfig
config
    runCommand :: String -> [Relationship a b] -> String
runCommand String
x = String
-> Maybe [String]
-> Int
-> ObjectConfig
-> [Relationship a b]
-> String
forall a b.
String
-> Maybe [String]
-> Int
-> ObjectConfig
-> [Relationship a b]
-> String
createRunCommand
      String
x
      Maybe [String]
forall a. Maybe a
Nothing
      Int
numClasses
      (MatchCdOdConfig -> ObjectConfig
objectConfig MatchCdOdConfig
config)

takeRandomInstances
  :: (MonadRandom m, MonadFail m) => Map [Int] [a] -> m (Maybe [([Int], a)])
takeRandomInstances :: forall (m :: * -> *) a.
(MonadRandom m, MonadFail m) =>
Map [Int] [a] -> m (Maybe [([Int], a)])
takeRandomInstances Map [Int] [a]
alloyInstances =
  case [[Map [Int] [Any] -> [([Int], Any)]]]
forall {a}. [[Map [Int] [a] -> [([Int], a)]]]
takes of
    []  -> Maybe [([Int], a)] -> m (Maybe [([Int], a)])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [([Int], a)]
forall a. Maybe a
Nothing
    [Map [Int] [Any] -> [([Int], Any)]]
_:[[Map [Int] [Any] -> [([Int], Any)]]]
_ -> [([Int], a)] -> Maybe [([Int], a)]
forall a. a -> Maybe a
Just ([([Int], a)] -> Maybe [([Int], a)])
-> m [([Int], a)] -> m (Maybe [([Int], a)])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
      Map [Int] [a]
randomInstances <- ([a] -> m [a]) -> Map [Int] [a] -> m (Map [Int] [a])
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) -> Map [Int] a -> m (Map [Int] b)
mapM [a] -> m [a]
forall (m :: * -> *) a. MonadRandom m => [a] -> m [a]
shuffleM Map [Int] [a]
alloyInstances
      [Map [Int] [a] -> [([Int], a)]]
ts:[[Map [Int] [a] -> [([Int], a)]]]
_    <- [[Map [Int] [a] -> [([Int], a)]]]
-> m [[Map [Int] [a] -> [([Int], a)]]]
forall (m :: * -> *) a. MonadRandom m => [a] -> m [a]
shuffleM [[Map [Int] [a] -> [([Int], a)]]]
forall {a}. [[Map [Int] [a] -> [([Int], a)]]]
takes
      [([Int], a)] -> m [([Int], a)]
forall (m :: * -> *) a. MonadRandom m => [a] -> m [a]
shuffleM ([([Int], a)] -> m [([Int], a)]) -> [([Int], a)] -> m [([Int], a)]
forall a b. (a -> b) -> a -> b
$ ((Map [Int] [a] -> [([Int], a)]) -> [([Int], a)])
-> [Map [Int] [a] -> [([Int], a)]] -> [([Int], a)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((Map [Int] [a] -> [([Int], a)]) -> Map [Int] [a] -> [([Int], a)]
forall a b. (a -> b) -> a -> b
$ Map [Int] [a]
randomInstances) [Map [Int] [a] -> [([Int], a)]]
ts
  where
    takes :: [[Map [Int] [a] -> [([Int], a)]]]
takes =
      [ [[Int] -> Int -> Map [Int] [a] -> [([Int], a)]
forall {k} {a}. Ord k => k -> Int -> Map k [a] -> [(k, a)]
takeL [Int
1] Int
x, [Int] -> Int -> Map [Int] [a] -> [([Int], a)]
forall {k} {a}. Ord k => k -> Int -> Map k [a] -> [(k, a)]
takeL [Int
2] Int
y, [Int] -> Int -> Map [Int] [a] -> [([Int], a)]
forall {k} {a}. Ord k => k -> Int -> Map k [a] -> [(k, a)]
takeL [Int
1,Int
2] Int
z, [Int] -> Int -> Map [Int] [a] -> [([Int], a)]
forall {k} {a}. Ord k => k -> Int -> Map k [a] -> [(k, a)]
takeL [] Int
u]
      | Int
x <- [Int
0 .. Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
2 ([a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([a] -> Int) -> [a] -> Int
forall a b. (a -> b) -> a -> b
$ Maybe [a] -> [a]
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe [a] -> [a]) -> Maybe [a] -> [a]
forall a b. (a -> b) -> a -> b
$ [Int] -> Map [Int] [a] -> Maybe [a]
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup [Int
1]   Map [Int] [a]
alloyInstances)]
      , Int
y <- [Int
0 .. Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
2 ([a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([a] -> Int) -> [a] -> Int
forall a b. (a -> b) -> a -> b
$ Maybe [a] -> [a]
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe [a] -> [a]) -> Maybe [a] -> [a]
forall a b. (a -> b) -> a -> b
$ [Int] -> Map [Int] [a] -> Maybe [a]
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup [Int
2]   Map [Int] [a]
alloyInstances)]
      , Int
z <- [Int
0 .. Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
2 ([a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([a] -> Int) -> [a] -> Int
forall a b. (a -> b) -> a -> b
$ Maybe [a] -> [a]
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe [a] -> [a]) -> Maybe [a] -> [a]
forall a b. (a -> b) -> a -> b
$ [Int] -> Map [Int] [a] -> Maybe [a]
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup [Int
1,Int
2] Map [Int] [a]
alloyInstances)]
      , Int
u <- [Int
0 .. Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
2 ([a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([a] -> Int) -> [a] -> Int
forall a b. (a -> b) -> a -> b
$ Maybe [a] -> [a]
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe [a] -> [a]) -> Maybe [a] -> [a]
forall a b. (a -> b) -> a -> b
$ [Int] -> Map [Int] [a] -> Maybe [a]
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup []    Map [Int] [a]
alloyInstances)]
      , Int
5 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
z Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
u
      ]
    takeL :: k -> Int -> Map k [a] -> [(k, a)]
takeL k
k Int
n = Int -> [(k, a)] -> [(k, a)]
forall a. Int -> [a] -> [a]
take Int
n ([(k, a)] -> [(k, a)])
-> (Map k [a] -> [(k, a)]) -> Map k [a] -> [(k, a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> (k, a)) -> [a] -> [(k, a)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (k
k,) ([a] -> [(k, a)]) -> (Map k [a] -> [a]) -> Map k [a] -> [(k, a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe [a] -> [a]
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe [a] -> [a]) -> (Map k [a] -> Maybe [a]) -> Map k [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. k -> Map k [a] -> Maybe [a]
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup k
k