{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TupleSections #-}
module Modelling.CdOd.DifferentNames (
  DifferentNamesConfig (..),
  DifferentNamesInstance (..),
  DifferentNamesTaskTextElement (..),
  ShufflingOption (..),
  checkDifferentNamesConfig,
  checkDifferentNamesInstance,
  defaultDifferentNamesConfig,
  defaultDifferentNamesInstance,
  defaultDifferentNamesTaskText,
  differentNames,
  differentNamesEvaluation,
  differentNamesInitial,
  differentNamesSolution,
  differentNamesSyntax,
  differentNamesTask,
  getDifferentNamesTask,
  mappingAdvice,
  mappingShow,
  renameInstance,
  toTaskSpecificText,
  ) where

import qualified Data.Bimap                       as BM (
  filter,
  fromList,
  keys,
  lookup,
  lookupR,
  toAscList,
  )
import qualified Data.Map                         as M (
  fromAscList,
  )

import Capabilities.Alloy               (MonadAlloy, getInstances)
import Capabilities.Cache               (MonadCache)
import Capabilities.Diagrams            (MonadDiagrams)
import Capabilities.Graphviz            (MonadGraphviz)
import Modelling.Auxiliary.Common (
  RandomiseLayout (randomiseLayout),
  RandomiseNames (hasRandomisableNames, randomiseNames),
  TaskGenerationException (NoInstanceAvailable),
  )
import Modelling.Auxiliary.Output (
  addPretext,
  directionsAdvice,
  hoveringInformation,
  simplifiedInformation,
  uniform,
  extra,
  )
import Modelling.Auxiliary.Shuffle.NamesAndLayout (
  shuffleEverything,
  )
import Modelling.CdOd.Auxiliary.Util
import Modelling.CdOd.CD2Alloy.Transform (
  ExtendsAnd (NothingMore),
  LinguisticReuse (ExtendsAnd),
  combineParts,
  createRunCommand,
  mergeParts,
  overlappingLinksPredicates,
  transform,
  )
import Modelling.CdOd.Generate          (generateCds, instanceToCd)
import Modelling.CdOd.Output            (cacheCd, cacheOd)
import Modelling.CdOd.Types (
  Cd,
  CdDrawSettings (..),
  ClassConfig (..),
  ClassDiagram (..),
  LimitedLinking (..),
  Link (..),
  Object (..),
  ObjectConfig (..),
  ObjectDiagram (..),
  ObjectProperties (..),
  Od,
  OmittedDefaultMultiplicities,
  Relationship (..),
  anonymiseObjects,
  associationNames,
  checkCdDrawSettings,
  checkClassConfigAndObjectProperties,
  checkClassConfigWithProperties,
  checkObjectDiagram,
  checkObjectProperties,
  checkOmittedDefaultMultiplicities,
  classNames,
  defaultCdDrawSettings,
  defaultOmittedDefaultMultiplicities,
  defaultProperties,
  fromClassDiagram,
  isObjectDiagramRandomisable,
  linkLabels,
  relationshipName,
  renameObjectsWithClassesAndLinksInOd,
  renameClassesAndRelationships,
  shuffleCdNames,
  shuffleClassAndConnectionOrder,
  shuffleObjectAndLinkOrder,
  )
import Modelling.Types (
  Name (Name),
  NameMapping (nameMapping),
  fromNameMapping,
  showName,
  toNameMapping,
  )

import Control.Applicative              (Alternative ((<|>)))
import Control.Monad.Catch              (MonadCatch, MonadThrow, throwM)
import Control.Monad.Extra              (whenJust)
import Control.OutputCapable.Blocks (
  ArticleToUse (DefiniteArticle),
  GenericOutputCapable (..),
  LangM,
  Language,
  OutputCapable,
  Rated,
  ($=<<),
  english,
  german,
  multipleChoice,
  translations,
  translate,
  yesNo,
  )
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 Control.Monad.Trans.Except       (runExceptT)
import Data.Bifunctor                   (Bifunctor (bimap, first))
import Data.Bimap                       (Bimap)
import Data.Bitraversable               (bitraverse)
import Data.Bool                        (bool)
import Data.Containers.ListUtils        (nubOrd, nubOrdOn)
import Data.Functor.Identity            (Identity (Identity, runIdentity))
import Data.GraphViz                    (DirType (Forward))
import Data.List (
  group,
  intercalate,
  intersect,
  partition,
  permutations,
  singleton,
  sort,
  )
import Data.Map (Map)
import Data.Maybe (
  catMaybes,
  isJust,
  isNothing,
  listToMaybe,
  mapMaybe,
  )
import Data.Ratio                       ((%))
import Data.String.Interpolate          (i, iii)
import Data.Tuple.Extra                 (swap)
import GHC.Generics                     (Generic)
import Language.Alloy.Call (
  AlloyInstance,
  getDoubleAs,
  lookupSig,
  scoped,
  )
import System.Random.Shuffle            (shuffleM)

data ShufflingOption a =
    ConsecutiveNumbers
  | WithAdditionalNames [a]
  deriving (ShufflingOption a -> ShufflingOption a -> Bool
(ShufflingOption a -> ShufflingOption a -> Bool)
-> (ShufflingOption a -> ShufflingOption a -> Bool)
-> Eq (ShufflingOption a)
forall a. Eq a => ShufflingOption a -> ShufflingOption a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => ShufflingOption a -> ShufflingOption a -> Bool
== :: ShufflingOption a -> ShufflingOption a -> Bool
$c/= :: forall a. Eq a => ShufflingOption a -> ShufflingOption a -> Bool
/= :: ShufflingOption a -> ShufflingOption a -> Bool
Eq, (forall x. ShufflingOption a -> Rep (ShufflingOption a) x)
-> (forall x. Rep (ShufflingOption a) x -> ShufflingOption a)
-> Generic (ShufflingOption a)
forall x. Rep (ShufflingOption a) x -> ShufflingOption a
forall x. ShufflingOption a -> Rep (ShufflingOption a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (ShufflingOption a) x -> ShufflingOption a
forall a x. ShufflingOption a -> Rep (ShufflingOption a) x
$cfrom :: forall a x. ShufflingOption a -> Rep (ShufflingOption a) x
from :: forall x. ShufflingOption a -> Rep (ShufflingOption a) x
$cto :: forall a x. Rep (ShufflingOption a) x -> ShufflingOption a
to :: forall x. Rep (ShufflingOption a) x -> ShufflingOption a
Generic, (forall m. Monoid m => ShufflingOption m -> m)
-> (forall m a. Monoid m => (a -> m) -> ShufflingOption a -> m)
-> (forall m a. Monoid m => (a -> m) -> ShufflingOption a -> m)
-> (forall a b. (a -> b -> b) -> b -> ShufflingOption a -> b)
-> (forall a b. (a -> b -> b) -> b -> ShufflingOption a -> b)
-> (forall b a. (b -> a -> b) -> b -> ShufflingOption a -> b)
-> (forall b a. (b -> a -> b) -> b -> ShufflingOption a -> b)
-> (forall a. (a -> a -> a) -> ShufflingOption a -> a)
-> (forall a. (a -> a -> a) -> ShufflingOption a -> a)
-> (forall a. ShufflingOption a -> [a])
-> (forall a. ShufflingOption a -> Bool)
-> (forall a. ShufflingOption a -> Int)
-> (forall a. Eq a => a -> ShufflingOption a -> Bool)
-> (forall a. Ord a => ShufflingOption a -> a)
-> (forall a. Ord a => ShufflingOption a -> a)
-> (forall a. Num a => ShufflingOption a -> a)
-> (forall a. Num a => ShufflingOption a -> a)
-> Foldable ShufflingOption
forall a. Eq a => a -> ShufflingOption a -> Bool
forall a. Num a => ShufflingOption a -> a
forall a. Ord a => ShufflingOption a -> a
forall m. Monoid m => ShufflingOption m -> m
forall a. ShufflingOption a -> Bool
forall a. ShufflingOption a -> Int
forall a. ShufflingOption a -> [a]
forall a. (a -> a -> a) -> ShufflingOption a -> a
forall m a. Monoid m => (a -> m) -> ShufflingOption a -> m
forall b a. (b -> a -> b) -> b -> ShufflingOption a -> b
forall a b. (a -> b -> b) -> b -> ShufflingOption a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => ShufflingOption m -> m
fold :: forall m. Monoid m => ShufflingOption m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> ShufflingOption a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> ShufflingOption a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> ShufflingOption a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> ShufflingOption a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> ShufflingOption a -> b
foldr :: forall a b. (a -> b -> b) -> b -> ShufflingOption a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> ShufflingOption a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> ShufflingOption a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> ShufflingOption a -> b
foldl :: forall b a. (b -> a -> b) -> b -> ShufflingOption a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> ShufflingOption a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> ShufflingOption a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> ShufflingOption a -> a
foldr1 :: forall a. (a -> a -> a) -> ShufflingOption a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> ShufflingOption a -> a
foldl1 :: forall a. (a -> a -> a) -> ShufflingOption a -> a
$ctoList :: forall a. ShufflingOption a -> [a]
toList :: forall a. ShufflingOption a -> [a]
$cnull :: forall a. ShufflingOption a -> Bool
null :: forall a. ShufflingOption a -> Bool
$clength :: forall a. ShufflingOption a -> Int
length :: forall a. ShufflingOption a -> Int
$celem :: forall a. Eq a => a -> ShufflingOption a -> Bool
elem :: forall a. Eq a => a -> ShufflingOption a -> Bool
$cmaximum :: forall a. Ord a => ShufflingOption a -> a
maximum :: forall a. Ord a => ShufflingOption a -> a
$cminimum :: forall a. Ord a => ShufflingOption a -> a
minimum :: forall a. Ord a => ShufflingOption a -> a
$csum :: forall a. Num a => ShufflingOption a -> a
sum :: forall a. Num a => ShufflingOption a -> a
$cproduct :: forall a. Num a => ShufflingOption a -> a
product :: forall a. Num a => ShufflingOption a -> a
Foldable, (forall a b. (a -> b) -> ShufflingOption a -> ShufflingOption b)
-> (forall a b. a -> ShufflingOption b -> ShufflingOption a)
-> Functor ShufflingOption
forall a b. a -> ShufflingOption b -> ShufflingOption a
forall a b. (a -> b) -> ShufflingOption a -> ShufflingOption b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> ShufflingOption a -> ShufflingOption b
fmap :: forall a b. (a -> b) -> ShufflingOption a -> ShufflingOption b
$c<$ :: forall a b. a -> ShufflingOption b -> ShufflingOption a
<$ :: forall a b. a -> ShufflingOption b -> ShufflingOption a
Functor, ReadPrec [ShufflingOption a]
ReadPrec (ShufflingOption a)
Int -> ReadS (ShufflingOption a)
ReadS [ShufflingOption a]
(Int -> ReadS (ShufflingOption a))
-> ReadS [ShufflingOption a]
-> ReadPrec (ShufflingOption a)
-> ReadPrec [ShufflingOption a]
-> Read (ShufflingOption a)
forall a. Read a => ReadPrec [ShufflingOption a]
forall a. Read a => ReadPrec (ShufflingOption a)
forall a. Read a => Int -> ReadS (ShufflingOption a)
forall a. Read a => ReadS [ShufflingOption a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: forall a. Read a => Int -> ReadS (ShufflingOption a)
readsPrec :: Int -> ReadS (ShufflingOption a)
$creadList :: forall a. Read a => ReadS [ShufflingOption a]
readList :: ReadS [ShufflingOption a]
$creadPrec :: forall a. Read a => ReadPrec (ShufflingOption a)
readPrec :: ReadPrec (ShufflingOption a)
$creadListPrec :: forall a. Read a => ReadPrec [ShufflingOption a]
readListPrec :: ReadPrec [ShufflingOption a]
Read, Int -> ShufflingOption a -> ShowS
[ShufflingOption a] -> ShowS
ShufflingOption a -> String
(Int -> ShufflingOption a -> ShowS)
-> (ShufflingOption a -> String)
-> ([ShufflingOption a] -> ShowS)
-> Show (ShufflingOption a)
forall a. Show a => Int -> ShufflingOption a -> ShowS
forall a. Show a => [ShufflingOption a] -> ShowS
forall a. Show a => ShufflingOption a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> ShufflingOption a -> ShowS
showsPrec :: Int -> ShufflingOption a -> ShowS
$cshow :: forall a. Show a => ShufflingOption a -> String
show :: ShufflingOption a -> String
$cshowList :: forall a. Show a => [ShufflingOption a] -> ShowS
showList :: [ShufflingOption a] -> ShowS
Show, Functor ShufflingOption
Foldable ShufflingOption
Functor ShufflingOption
-> Foldable ShufflingOption
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> ShufflingOption a -> f (ShufflingOption b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    ShufflingOption (f a) -> f (ShufflingOption a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> ShufflingOption a -> m (ShufflingOption b))
-> (forall (m :: * -> *) a.
    Monad m =>
    ShufflingOption (m a) -> m (ShufflingOption a))
-> Traversable ShufflingOption
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
ShufflingOption (m a) -> m (ShufflingOption a)
forall (f :: * -> *) a.
Applicative f =>
ShufflingOption (f a) -> f (ShufflingOption a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> ShufflingOption a -> m (ShufflingOption b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ShufflingOption a -> f (ShufflingOption b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ShufflingOption a -> f (ShufflingOption b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ShufflingOption a -> f (ShufflingOption b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
ShufflingOption (f a) -> f (ShufflingOption a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
ShufflingOption (f a) -> f (ShufflingOption a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> ShufflingOption a -> m (ShufflingOption b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> ShufflingOption a -> m (ShufflingOption b)
$csequence :: forall (m :: * -> *) a.
Monad m =>
ShufflingOption (m a) -> m (ShufflingOption a)
sequence :: forall (m :: * -> *) a.
Monad m =>
ShufflingOption (m a) -> m (ShufflingOption a)
Traversable)

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

checkDifferentNamesInstance :: DifferentNamesInstance -> Maybe String
checkDifferentNamesInstance :: DifferentNamesInstance -> Maybe String
checkDifferentNamesInstance DifferentNamesInstance {Bool
DifferentNamesTaskText
Maybe (Map Language String)
Od
Cd
CdDrawSettings
NameMapping
ShufflingOption String
cDiagram :: DifferentNamesInstance -> Cd
cdDrawSettings :: DifferentNamesInstance -> CdDrawSettings
oDiagram :: DifferentNamesInstance -> Od
showSolution :: DifferentNamesInstance -> Bool
mapping :: DifferentNamesInstance -> NameMapping
linkShuffling :: DifferentNamesInstance -> ShufflingOption String
taskText :: DifferentNamesInstance -> DifferentNamesTaskText
addText :: DifferentNamesInstance -> Maybe (Map Language String)
cDiagram :: Cd
cdDrawSettings :: CdDrawSettings
oDiagram :: Od
showSolution :: Bool
mapping :: NameMapping
linkShuffling :: ShufflingOption String
taskText :: DifferentNamesTaskText
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.|]
  | WithAdditionalNames [String]
xs <- ShufflingOption String
linkShuffling
  , [String] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
associations Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> [String] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
links Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [String] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
xs
  = String -> Maybe String
forall a. a -> Maybe a
Just [iii|
      WithAdditionalNames must provide at least a name for
      each missing link in the Object diagram,
      i.e., for which an association in the Class diagram exists
      but not a link in the Object diagram.
      |]
  | (String
x:[String]
_) <- [String] -> [String]
forall a. Ord a => [a] -> [a]
nubOrd [String]
links [String] -> [String] -> [String]
forall a. Eq a => [a] -> [a] -> [a]
`intersect` [String] -> [String]
forall a. Ord a => [a] -> [a]
nubOrd [String]
associations
  = String -> Maybe String
forall a. a -> Maybe a
Just [iii|
      Link names and association names must be disjoint
      but currently "#{x}" is among both.
      |]
  | Bool
otherwise
  = Od -> Maybe String
forall objectName className linkLabel.
Ord objectName =>
ObjectDiagram objectName className linkLabel -> Maybe String
checkObjectDiagram Od
oDiagram
  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
  where
    associations :: [String]
associations = Cd -> [String]
associationNames Cd
cDiagram
    links :: [String]
links = Od -> [String]
forall linkLabel objectName className.
Ord linkLabel =>
ObjectDiagram objectName className linkLabel -> [linkLabel]
linkLabels Od
oDiagram

data DifferentNamesConfig
  = DifferentNamesConfig {
    DifferentNamesConfig -> ClassConfig
classConfig      :: ClassConfig,
    DifferentNamesConfig -> Maybe Bool
withNonTrivialInheritance :: Maybe Bool,
    DifferentNamesConfig -> Maybe Integer
maxInstances     :: Maybe Integer,
    DifferentNamesConfig -> ObjectConfig
objectConfig     :: ObjectConfig,
    DifferentNamesConfig -> ObjectProperties
objectProperties :: ObjectProperties,
    DifferentNamesConfig -> OmittedDefaultMultiplicities
omittedDefaultMultiplicities :: OmittedDefaultMultiplicities,
    DifferentNamesConfig -> Bool
printSolution    :: Bool,
    DifferentNamesConfig -> Maybe Int
timeout          :: !(Maybe Int),
    -- | Obvious means here that each individual relationship to link mapping
    -- can be made without considering other relationships.
    DifferentNamesConfig -> Maybe Bool
withObviousMapping :: !(Maybe Bool),
    DifferentNamesConfig -> Maybe (Map Language String)
extraText :: Maybe (Map Language String)
  } deriving ((forall x. DifferentNamesConfig -> Rep DifferentNamesConfig x)
-> (forall x. Rep DifferentNamesConfig x -> DifferentNamesConfig)
-> Generic DifferentNamesConfig
forall x. Rep DifferentNamesConfig x -> DifferentNamesConfig
forall x. DifferentNamesConfig -> Rep DifferentNamesConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DifferentNamesConfig -> Rep DifferentNamesConfig x
from :: forall x. DifferentNamesConfig -> Rep DifferentNamesConfig x
$cto :: forall x. Rep DifferentNamesConfig x -> DifferentNamesConfig
to :: forall x. Rep DifferentNamesConfig x -> DifferentNamesConfig
Generic, ReadPrec [DifferentNamesConfig]
ReadPrec DifferentNamesConfig
Int -> ReadS DifferentNamesConfig
ReadS [DifferentNamesConfig]
(Int -> ReadS DifferentNamesConfig)
-> ReadS [DifferentNamesConfig]
-> ReadPrec DifferentNamesConfig
-> ReadPrec [DifferentNamesConfig]
-> Read DifferentNamesConfig
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS DifferentNamesConfig
readsPrec :: Int -> ReadS DifferentNamesConfig
$creadList :: ReadS [DifferentNamesConfig]
readList :: ReadS [DifferentNamesConfig]
$creadPrec :: ReadPrec DifferentNamesConfig
readPrec :: ReadPrec DifferentNamesConfig
$creadListPrec :: ReadPrec [DifferentNamesConfig]
readListPrec :: ReadPrec [DifferentNamesConfig]
Read, Int -> DifferentNamesConfig -> ShowS
[DifferentNamesConfig] -> ShowS
DifferentNamesConfig -> String
(Int -> DifferentNamesConfig -> ShowS)
-> (DifferentNamesConfig -> String)
-> ([DifferentNamesConfig] -> ShowS)
-> Show DifferentNamesConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DifferentNamesConfig -> ShowS
showsPrec :: Int -> DifferentNamesConfig -> ShowS
$cshow :: DifferentNamesConfig -> String
show :: DifferentNamesConfig -> String
$cshowList :: [DifferentNamesConfig] -> ShowS
showList :: [DifferentNamesConfig] -> ShowS
Show)

checkDifferentNamesConfig :: DifferentNamesConfig -> Maybe String
checkDifferentNamesConfig :: DifferentNamesConfig -> Maybe String
checkDifferentNamesConfig DifferentNamesConfig {Bool
Maybe Bool
Maybe Int
Maybe Integer
Maybe (Map Language String)
ObjectProperties
ObjectConfig
OmittedDefaultMultiplicities
ClassConfig
classConfig :: DifferentNamesConfig -> ClassConfig
withNonTrivialInheritance :: DifferentNamesConfig -> Maybe Bool
maxInstances :: DifferentNamesConfig -> Maybe Integer
objectConfig :: DifferentNamesConfig -> ObjectConfig
objectProperties :: DifferentNamesConfig -> ObjectProperties
omittedDefaultMultiplicities :: DifferentNamesConfig -> OmittedDefaultMultiplicities
printSolution :: DifferentNamesConfig -> Bool
timeout :: DifferentNamesConfig -> Maybe Int
withObviousMapping :: DifferentNamesConfig -> Maybe Bool
extraText :: DifferentNamesConfig -> Maybe (Map Language String)
classConfig :: ClassConfig
withNonTrivialInheritance :: Maybe Bool
maxInstances :: Maybe Integer
objectConfig :: ObjectConfig
objectProperties :: ObjectProperties
omittedDefaultMultiplicities :: OmittedDefaultMultiplicities
printSolution :: Bool
timeout :: Maybe Int
withObviousMapping :: Maybe Bool
extraText :: Maybe (Map Language String)
..}
  | Maybe Bool -> Bool
forall a. Maybe a -> Bool
isJust Maybe Bool
withObviousMapping
  = String -> Maybe String
forall a. a -> Maybe a
Just [iii|
    'withObviousMapping' is not yet supported and has to be set to Nothing
    |]
  | (Int
x, Just Int
y) <- ClassConfig -> (Int, Maybe Int)
relationshipLimits ClassConfig
classConfig, Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
y
  = String -> Maybe String
forall a. a -> Maybe a
Just [iii|
      The minimum number of relationships has to equal its maximum number
      for this task type.
      Otherwise task instances would vary too much in complexity.
      |]
  | (Int
x, Just Int
y) <- ClassConfig -> (Int, Maybe Int)
inheritanceLimits ClassConfig
classConfig, Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
y
  = String -> Maybe String
forall a. a -> Maybe a
Just [iii|
      The minimum number of inheritances has to equal its maximum number
      for this task type.
      Otherwise task instances could vary too much in difficulty.
      |]
  | Maybe Int -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe Int -> Bool)
-> ((Int, Maybe Int) -> Maybe Int) -> (Int, Maybe Int) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Maybe Int) -> Maybe Int
forall a b. (a, b) -> b
snd ((Int, Maybe Int) -> Bool) -> (Int, Maybe Int) -> Bool
forall a b. (a -> b) -> a -> b
$ ClassConfig -> (Int, Maybe Int)
relationshipLimits ClassConfig
classConfig
  , ((ClassConfig -> (Int, Maybe Int)) -> Bool)
-> [ClassConfig -> (Int, Maybe Int)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any
      ((Int, Maybe Int) -> Bool
forall {a}. Eq a => (a, Maybe a) -> Bool
different ((Int, Maybe Int) -> Bool)
-> ((ClassConfig -> (Int, Maybe Int)) -> (Int, Maybe Int))
-> (ClassConfig -> (Int, Maybe Int))
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ClassConfig -> (Int, Maybe Int))
-> ClassConfig -> (Int, Maybe Int)
forall a b. (a -> b) -> a -> b
$ ClassConfig
classConfig))
      [ClassConfig -> (Int, Maybe Int)
aggregationLimits, ClassConfig -> (Int, Maybe Int)
associationLimits, ClassConfig -> (Int, Maybe Int)
compositionLimits]
  = String -> Maybe String
forall a. a -> Maybe a
Just [iii|
      The minimum number and maximum number
      of aggregations, associations or compositions may not vary
      if the maximum number of relationships is not fixed.
      Otherwise task instances would vary too much in complexity.
      |]
  | 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
<|> 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
  where
    different :: (a, Maybe a) -> Bool
different (a
_, Maybe a
Nothing) = Bool
True
    different (a
x, Just a
y)  = a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
y

defaultDifferentNamesConfig :: DifferentNamesConfig
defaultDifferentNamesConfig :: DifferentNamesConfig
defaultDifferentNamesConfig = DifferentNamesConfig {
    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
1),
        associationLimits :: (Int, Maybe Int)
associationLimits  = (Int
1, 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
1),
        relationshipLimits :: (Int, Maybe Int)
relationshipLimits = (Int
4, Int -> Maybe Int
forall a. a -> Maybe a
Just Int
4)
      },
    objectConfig :: ObjectConfig
objectConfig = ObjectConfig {
      linkLimits :: (Int, Maybe Int)
linkLimits           = (Int
5, 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
3),
      objectLimits :: (Int, Int)
objectLimits         = (Int
4, Int
6)
      },
    objectProperties :: ObjectProperties
objectProperties = ObjectProperties {
      anonymousObjectProportion :: Rational
anonymousObjectProportion = Integer
1 Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
1,
      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 = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True
      },
    omittedDefaultMultiplicities :: OmittedDefaultMultiplicities
omittedDefaultMultiplicities = OmittedDefaultMultiplicities
defaultOmittedDefaultMultiplicities,
    printSolution :: Bool
printSolution    = Bool
False,
    withNonTrivialInheritance :: Maybe Bool
withNonTrivialInheritance = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True,
    withObviousMapping :: Maybe Bool
withObviousMapping = Maybe Bool
forall a. Maybe a
Nothing,
    maxInstances :: Maybe Integer
maxInstances     = Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
200,
    timeout :: Maybe Int
timeout          = Maybe Int
forall a. Maybe a
Nothing,
    extraText :: Maybe (Map Language String)
extraText        = Maybe (Map Language String)
forall a. Maybe a
Nothing
  }

newtype ShowName = ShowName { ShowName -> Name
showName' :: Name }

instance Show ShowName where
  show :: ShowName -> String
show = Name -> String
showName (Name -> String) -> (ShowName -> Name) -> ShowName -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowName -> Name
showName'

mappingShow :: [(Name, Name)] -> [(ShowName, ShowName)]
mappingShow :: [(Name, Name)] -> [(ShowName, ShowName)]
mappingShow = ((Name, Name) -> (ShowName, ShowName))
-> [(Name, Name)] -> [(ShowName, ShowName)]
forall a b. (a -> b) -> [a] -> [b]
map ((Name -> ShowName)
-> (Name -> ShowName) -> (Name, Name) -> (ShowName, ShowName)
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap Name -> ShowName
ShowName Name -> ShowName
ShowName)

type DifferentNamesTaskText = [SpecialOutput DifferentNamesTaskTextElement]

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

differentNamesTask
  :: (MonadCache m, MonadDiagrams m, MonadGraphviz m, MonadThrow m, OutputCapable m)
  => FilePath
  -> DifferentNamesInstance
  -> LangM m
differentNamesTask :: forall (m :: * -> *).
(MonadCache m, MonadDiagrams m, MonadGraphviz m, MonadThrow m,
 OutputCapable m) =>
String -> DifferentNamesInstance -> LangM m
differentNamesTask String
path DifferentNamesInstance
task = do
  String -> DifferentNamesInstance -> LangM m
forall (m :: * -> *).
(MonadCache m, MonadDiagrams m, MonadGraphviz m, MonadThrow m,
 OutputCapable m) =>
String -> DifferentNamesInstance -> LangM m
toTaskText String
path DifferentNamesInstance
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
  -> DifferentNamesInstance
  -> LangM m
toTaskText :: forall (m :: * -> *).
(MonadCache m, MonadDiagrams m, MonadGraphviz m, MonadThrow m,
 OutputCapable m) =>
String -> DifferentNamesInstance -> LangM m
toTaskText String
path DifferentNamesInstance
task = do
  (DifferentNamesTaskTextElement -> LangM m)
-> DifferentNamesTaskText -> LangM m
forall (m :: * -> *) element.
OutputCapable m =>
(element -> LangM m) -> [SpecialOutput element] -> LangM m
specialToOutputCapable (String
-> DifferentNamesInstance
-> DifferentNamesTaskTextElement
-> LangM m
forall (m :: * -> *).
(MonadCache m, MonadDiagrams m, MonadGraphviz m, MonadThrow m,
 OutputCapable m) =>
String
-> DifferentNamesInstance
-> DifferentNamesTaskTextElement
-> LangM m
toTaskSpecificText String
path DifferentNamesInstance
task) (DifferentNamesInstance -> DifferentNamesTaskText
taskText DifferentNamesInstance
task)
  Maybe (Map Language String) -> LangM m
forall (m :: * -> *).
OutputCapable m =>
Maybe (Map Language String) -> LangM m
extra (Maybe (Map Language String) -> LangM m)
-> Maybe (Map Language String) -> LangM m
forall a b. (a -> b) -> a -> b
$ DifferentNamesInstance -> Maybe (Map Language String)
addText DifferentNamesInstance
task
  pure ()

mappingAdvice :: OutputCapable m => LangM m
mappingAdvice :: forall (m :: * -> *). OutputCapable m => LangM m
mappingAdvice = do
  LangM m -> LangM m
forall l (m :: * -> *).
GenericOutputCapable l m =>
GenericLangM l m () -> GenericLangM l m ()
paragraph (LangM m -> LangM m) -> LangM m -> LangM m
forall a b. (a -> b) -> a -> b
$ State (Map Language String) () -> LangM m
forall l (m :: * -> *).
GenericOutputCapable l m =>
State (Map l String) () -> GenericLangM l m ()
translate (State (Map Language String) () -> LangM m)
-> State (Map Language String) () -> LangM m
forall a b. (a -> b) -> a -> b
$ do
    String -> State (Map Language String) ()
english [iii|
      Please note: Links are already grouped correctly and fully,
      i.e., all links with the same label (and only links with the same label!)
      in the OD correspond to exactly the same relationship in the CD.
      |]
    String -> State (Map Language String) ()
german [iii|
      Bitte beachten Sie: Links sind bereits vollständig und korrekt gruppiert,
      d.h., alle Links mit der selben Beschriftung
      (and auch nur Links mit der selben Beschriftung!)
      im OD entsprechen genau der selben Beziehung im CD.
      |]
  LangM m -> LangM m
forall l (m :: * -> *).
GenericOutputCapable l m =>
GenericLangM l m () -> GenericLangM l m ()
paragraph (LangM m -> LangM m) -> LangM m -> LangM m
forall a b. (a -> b) -> a -> b
$ State (Map Language String) () -> LangM m
forall l (m :: * -> *).
GenericOutputCapable l m =>
State (Map l String) () -> GenericLangM l m ()
translate (State (Map Language String) () -> LangM m)
-> State (Map Language String) () -> LangM m
forall a b. (a -> b) -> a -> b
$ do
    String -> State (Map Language String) ()
english [iii|
      Thus, no link label or relationship name should occur
      more than once in your mapping.
      |]
    String -> State (Map Language String) ()
german [iii|
      Deshalb sollte keine Linkbeschriftung oder Beziehungsname
      mehr als einmal in Ihrer Zuordnung auftreten.
      |]
  pure ()

toTaskSpecificText
  :: (
    MonadCache m,
    MonadDiagrams m,
    MonadGraphviz m,
    MonadThrow m,
    OutputCapable m
    )
  => FilePath
  -> DifferentNamesInstance
  -> DifferentNamesTaskTextElement
  -> LangM m
toTaskSpecificText :: forall (m :: * -> *).
(MonadCache m, MonadDiagrams m, MonadGraphviz m, MonadThrow m,
 OutputCapable m) =>
String
-> DifferentNamesInstance
-> DifferentNamesTaskTextElement
-> LangM m
toTaskSpecificText String
path DifferentNamesInstance {Bool
DifferentNamesTaskText
Maybe (Map Language String)
Od
Cd
CdDrawSettings
NameMapping
ShufflingOption String
cDiagram :: DifferentNamesInstance -> Cd
cdDrawSettings :: DifferentNamesInstance -> CdDrawSettings
oDiagram :: DifferentNamesInstance -> Od
showSolution :: DifferentNamesInstance -> Bool
mapping :: DifferentNamesInstance -> NameMapping
linkShuffling :: DifferentNamesInstance -> ShufflingOption String
taskText :: DifferentNamesInstance -> DifferentNamesTaskText
addText :: DifferentNamesInstance -> Maybe (Map Language String)
cDiagram :: Cd
cdDrawSettings :: CdDrawSettings
oDiagram :: Od
showSolution :: Bool
mapping :: NameMapping
linkShuffling :: ShufflingOption String
taskText :: DifferentNamesTaskText
addText :: Maybe (Map Language String)
..} = \case
  DifferentNamesTaskTextElement
GivenCd ->
    LangM m -> LangM m
forall l (m :: * -> *).
GenericOutputCapable l m =>
GenericLangM l m () -> GenericLangM l m ()
paragraph (LangM m -> LangM m) -> LangM m -> LangM m
forall a b. (a -> b) -> a -> b
$ String -> LangM m
forall l (m :: * -> *).
GenericOutputCapable l m =>
String -> GenericLangM l m ()
image (String -> LangM m) -> m String -> LangM m
forall (m :: * -> *) a l b.
Monad m =>
(a -> GenericLangM l m b) -> m a -> GenericLangM l m b
$=<< 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 AnyCd
cd String
path
  DifferentNamesTaskTextElement
GivenOd -> LangM m -> LangM m
forall l (m :: * -> *).
GenericOutputCapable l m =>
GenericLangM l m () -> GenericLangM l m ()
paragraph (LangM m -> LangM m) -> LangM m -> LangM m
forall a b. (a -> b) -> a -> b
$ String -> LangM m
forall l (m :: * -> *).
GenericOutputCapable l m =>
String -> GenericLangM l m ()
image (String -> LangM m) -> m String -> LangM m
forall (m :: * -> *) a l b.
Monad m =>
(a -> GenericLangM l m b) -> m a -> GenericLangM l m b
$=<<
    Od -> DirType -> Bool -> String -> m String
forall (m :: * -> *).
(MonadCache m, MonadDiagrams m, MonadGraphviz m, MonadThrow m) =>
Od -> DirType -> Bool -> String -> m String
cacheOd Od
oDiagram DirType
Forward Bool
True String
path
  DifferentNamesTaskTextElement
MappingAdvice -> LangM m
forall (m :: * -> *). OutputCapable m => LangM m
mappingAdvice
  where
    cd :: AnyCd
cd = Cd -> AnyCd
forall className relationshipName.
ClassDiagram className relationshipName
-> AnyClassDiagram className relationshipName
fromClassDiagram Cd
cDiagram

defaultDifferentNamesTaskText :: DifferentNamesTaskText
defaultDifferentNamesTaskText :: DifferentNamesTaskText
defaultDifferentNamesTaskText = [
  DifferentNamesTaskText
-> GenericOutput Language DifferentNamesTaskTextElement
forall language element.
[GenericOutput language element] -> GenericOutput language element
Paragraph (DifferentNamesTaskText
 -> GenericOutput Language DifferentNamesTaskTextElement)
-> DifferentNamesTaskText
-> GenericOutput Language DifferentNamesTaskTextElement
forall a b. (a -> b) -> a -> b
$ GenericOutput Language DifferentNamesTaskTextElement
-> DifferentNamesTaskText
forall a. a -> [a]
singleton (GenericOutput Language DifferentNamesTaskTextElement
 -> DifferentNamesTaskText)
-> GenericOutput Language DifferentNamesTaskTextElement
-> DifferentNamesTaskText
forall a b. (a -> b) -> a -> b
$ Map Language String
-> GenericOutput Language DifferentNamesTaskTextElement
forall language element.
Map language String -> GenericOutput language element
Translated (Map Language String
 -> GenericOutput Language DifferentNamesTaskTextElement)
-> Map Language String
-> GenericOutput Language DifferentNamesTaskTextElement
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 (valid) class diagram:"
    String -> State (Map Language String) ()
german String
"Betrachten Sie das folgende (gültige) Klassendiagramm:",
  DifferentNamesTaskTextElement
-> GenericOutput Language DifferentNamesTaskTextElement
forall language element. element -> GenericOutput language element
Special DifferentNamesTaskTextElement
GivenCd,
  DifferentNamesTaskText
-> GenericOutput Language DifferentNamesTaskTextElement
forall language element.
[GenericOutput language element] -> GenericOutput language element
Paragraph (DifferentNamesTaskText
 -> GenericOutput Language DifferentNamesTaskTextElement)
-> DifferentNamesTaskText
-> GenericOutput Language DifferentNamesTaskTextElement
forall a b. (a -> b) -> a -> b
$ GenericOutput Language DifferentNamesTaskTextElement
-> DifferentNamesTaskText
forall a. a -> [a]
singleton (GenericOutput Language DifferentNamesTaskTextElement
 -> DifferentNamesTaskText)
-> GenericOutput Language DifferentNamesTaskTextElement
-> DifferentNamesTaskText
forall a b. (a -> b) -> a -> b
$ Map Language String
-> GenericOutput Language DifferentNamesTaskTextElement
forall language element.
Map language String -> GenericOutput language element
Translated (Map Language String
 -> GenericOutput Language DifferentNamesTaskTextElement)
-> Map Language String
-> GenericOutput Language DifferentNamesTaskTextElement
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
"and the following object diagram (which conforms to it):"
    String -> State (Map Language String) ()
german String
"und das folgende (dazu passende) Objektdiagramm:",
  DifferentNamesTaskTextElement
-> GenericOutput Language DifferentNamesTaskTextElement
forall language element. element -> GenericOutput language element
Special DifferentNamesTaskTextElement
GivenOd,
  DifferentNamesTaskText
-> GenericOutput Language DifferentNamesTaskTextElement
forall language element.
[GenericOutput language element] -> GenericOutput language element
Paragraph [
    Map Language String
-> GenericOutput Language DifferentNamesTaskTextElement
forall language element.
Map language String -> GenericOutput language element
Translated (Map Language String
 -> GenericOutput Language DifferentNamesTaskTextElement)
-> Map Language String
-> GenericOutput Language DifferentNamesTaskTextElement
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 relationship in the class diagram (CD) corresponds
        to which of the links in the object diagram (OD)?
        \n
        State your answer by giving a mapping of
        relationships in the CD to links in the OD.
        \n
        To state that x in the CD corresponds to 1 in the OD and
        y in the CD corresponds to 2 in the OD, write the mapping as:
        |]
      String -> State (Map Language String) ()
german [iii|
        Welche Beziehung im Klassendiagramm (CD)
        entspricht welchen Links im Objektdiagramm (OD)?
        \n
        Geben Sie Ihre Antwort als eine Zuordnung von
        Beziehungen im CD zu Links im OD an.
        \n
        Um anzugeben, dass x im CD zu 1 im OD und y im CD
        zu 2 im OD korrespondieren, schreiben Sie die Zuordnung als:
        |],
    Map Language String
-> GenericOutput Language DifferentNamesTaskTextElement
forall language element.
Map language String -> GenericOutput language element
Code (Map Language String
 -> GenericOutput Language DifferentNamesTaskTextElement)
-> ([(ShowName, ShowName)] -> Map Language String)
-> [(ShowName, ShowName)]
-> GenericOutput Language DifferentNamesTaskTextElement
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)
-> ([(ShowName, ShowName)] -> String)
-> [(ShowName, ShowName)]
-> Map Language String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(ShowName, ShowName)] -> String
forall a. Show a => a -> String
show ([(ShowName, ShowName)]
 -> GenericOutput Language DifferentNamesTaskTextElement)
-> [(ShowName, ShowName)]
-> GenericOutput Language DifferentNamesTaskTextElement
forall a b. (a -> b) -> a -> b
$ [(Name, Name)] -> [(ShowName, ShowName)]
mappingShow [(Name, Name)]
differentNamesInitial
    ],
  DifferentNamesTaskTextElement
-> GenericOutput Language DifferentNamesTaskTextElement
forall language element. element -> GenericOutput language element
Special DifferentNamesTaskTextElement
MappingAdvice
  ]

differentNamesInitial :: [(Name, Name)]
differentNamesInitial :: [(Name, Name)]
differentNamesInitial = ((String, String) -> (Name, Name))
-> [(String, String)] -> [(Name, Name)]
forall a b. (a -> b) -> [a] -> [b]
map ((String -> Name)
-> (String -> Name) -> (String, String) -> (Name, Name)
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap String -> Name
Name String -> Name
Name) [(String
"x", String
"1"), (String
"y", String
"2")]

differentNamesSyntax
  :: OutputCapable m
  => DifferentNamesInstance
  -> [(Name, Name)]
  -> LangM m
differentNamesSyntax :: forall (m :: * -> *).
OutputCapable m =>
DifferentNamesInstance -> [(Name, Name)] -> LangM m
differentNamesSyntax DifferentNamesInstance {Bool
DifferentNamesTaskText
Maybe (Map Language String)
Od
Cd
CdDrawSettings
NameMapping
ShufflingOption String
cDiagram :: DifferentNamesInstance -> Cd
cdDrawSettings :: DifferentNamesInstance -> CdDrawSettings
oDiagram :: DifferentNamesInstance -> Od
showSolution :: DifferentNamesInstance -> Bool
mapping :: DifferentNamesInstance -> NameMapping
linkShuffling :: DifferentNamesInstance -> ShufflingOption String
taskText :: DifferentNamesInstance -> DifferentNamesTaskText
addText :: DifferentNamesInstance -> Maybe (Map Language String)
cDiagram :: Cd
cdDrawSettings :: CdDrawSettings
oDiagram :: Od
showSolution :: Bool
mapping :: NameMapping
linkShuffling :: ShufflingOption String
taskText :: DifferentNamesTaskText
addText :: Maybe (Map Language String)
..} [(Name, Name)]
cs = 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 (m :: * -> *). OutputCapable m => Bool -> LangM m -> LangM m
yesNo ([(Name, Name)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Name, Name)]
invalidMappings) (LangM' m () -> LangM' m ()) -> LangM' m () -> LangM' m ()
forall a b. (a -> b) -> a -> b
$ State (Map Language String) () -> LangM' m ()
forall l (m :: * -> *).
GenericOutputCapable l m =>
State (Map l String) () -> GenericLangM l m ()
translate (State (Map Language String) () -> LangM' m ())
-> State (Map Language String) () -> LangM' m ()
forall a b. (a -> b) -> a -> b
$ do
    String -> State (Map Language String) ()
english [iii|
      All provided pairs are matching an existing relationship
      and an existing link?
      |]
    String -> State (Map Language String) ()
german [iii|
      Alle angegebenen Paare ordnen einen vorhandenen Link
      einer vorhandenen Beziehung zu?
      |]
  Maybe (Name, Name) -> ((Name, Name) -> LangM' m ()) -> LangM' m ()
forall (m :: * -> *) a.
Applicative m =>
Maybe a -> (a -> m ()) -> m ()
whenJust ([(Name, Name)] -> Maybe (Name, Name)
forall a. [a] -> Maybe a
listToMaybe [(Name, Name)]
invalidMappings) (((Name, Name) -> LangM' m ()) -> LangM' m ())
-> ((Name, Name) -> LangM' m ()) -> LangM' m ()
forall a b. (a -> b) -> a -> b
$ \(Name, Name)
x ->
    LangM' m () -> LangM' m ()
forall l (m :: * -> *).
GenericOutputCapable l m =>
GenericLangM l m () -> GenericLangM l m ()
refuse (LangM' m () -> LangM' m ()) -> LangM' m () -> LangM' m ()
forall a b. (a -> b) -> a -> b
$ LangM' m () -> LangM' m ()
forall l (m :: * -> *).
GenericOutputCapable l m =>
GenericLangM l m () -> GenericLangM l m ()
paragraph (LangM' m () -> LangM' m ()) -> LangM' m () -> LangM' m ()
forall a b. (a -> b) -> a -> b
$ State (Map Language String) () -> LangM' m ()
forall l (m :: * -> *).
GenericOutputCapable l m =>
State (Map l String) () -> GenericLangM l m ()
translate (State (Map Language String) () -> LangM' m ())
-> State (Map Language String) () -> LangM' m ()
forall a b. (a -> b) -> a -> b
$ do
      let y :: (ShowName, ShowName)
y = (Name -> ShowName)
-> (Name -> ShowName) -> (Name, Name) -> (ShowName, ShowName)
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap Name -> ShowName
ShowName Name -> ShowName
ShowName (Name, Name)
x
      String -> State (Map Language String) ()
english [i|The mapping '#{y}' uses a non-existing identifier.|]
      String -> State (Map Language String) ()
german [iii|
        Die Zuordnung '#{y}' benutzt einen nicht vorhandenen Bezeichner.
        |]
  Bool -> LangM' m () -> LangM' m ()
forall (m :: * -> *). OutputCapable m => Bool -> LangM m -> LangM m
yesNo ([[Name]] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Name]]
allMappingValues) (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
"All provided pairs are non-overlapping?"
    String -> State (Map Language String) ()
german String
"Alle angegebenen Paare sind nicht überlappend?"
  case [[Name]]
allMappingValues of
    (Name
x:[Name]
_):[[Name]]
_ -> LangM' m () -> LangM' m ()
forall l (m :: * -> *).
GenericOutputCapable l m =>
GenericLangM l m () -> GenericLangM l m ()
refuse (LangM' m () -> LangM' m ()) -> LangM' m () -> LangM' m ()
forall a b. (a -> b) -> a -> b
$ LangM' m () -> LangM' m ()
forall l (m :: * -> *).
GenericOutputCapable l m =>
GenericLangM l m () -> GenericLangM l m ()
paragraph (LangM' m () -> LangM' m ()) -> LangM' m () -> LangM' m ()
forall a b. (a -> b) -> a -> b
$ State (Map Language String) () -> LangM' m ()
forall l (m :: * -> *).
GenericOutputCapable l m =>
State (Map l String) () -> GenericLangM l m ()
translate (State (Map Language String) () -> LangM' m ())
-> State (Map Language String) () -> LangM' m ()
forall a b. (a -> b) -> a -> b
$ do
      let y :: ShowName
y = Name -> ShowName
ShowName Name
x
      String -> State (Map Language String) ()
english [i|The identifier '#{y}' appears twice within the provided mappings.|]
      String -> State (Map Language String) ()
german [i|
        Der Bezeichner '#{y}' existiert doppelt in den angegebenen Zuordnungen.
        |]
    [[Name]]
_ -> () -> LangM' m ()
forall a. a -> GenericLangM Language m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  pure ()
  where
    links :: [String]
links = Od -> [String]
forall linkLabel objectName className.
Ord linkLabel =>
ObjectDiagram objectName className linkLabel -> [linkLabel]
linkLabels Od
oDiagram
    sortPair :: (b, b) -> (b, b)
sortPair (b
x, b
y) = if b
x b -> b -> Bool
forall a. Ord a => a -> a -> Bool
<= b
y then (b
x, b
y) else (b
y, b
x)
    choices :: [(Name, Name)]
choices = ((Name, Name) -> (Name, Name)) -> [(Name, Name)] -> [(Name, Name)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
nubOrdOn (Name, Name) -> (Name, Name)
forall {b}. Ord b => (b, b) -> (b, b)
sortPair [(Name, Name)]
cs
    associations :: [String]
associations = Cd -> [String]
associationNames Cd
cDiagram
    isAssociationMappingForward :: (Name, Name) -> Bool
isAssociationMappingForward (Name String
x, Name String
y) =
      String
x String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
associations Bool -> Bool -> Bool
&& String
y String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
links
    isAssociationMapping :: (Name, Name) -> Bool
isAssociationMapping (Name, Name)
x = (Name, Name) -> Bool
isAssociationMappingForward (Name, Name)
x
      Bool -> Bool -> Bool
|| (Name, Name) -> Bool
isAssociationMappingForward ((Name, Name) -> (Name, Name)
forall a b. (a, b) -> (b, a)
swap (Name, Name)
x)
    invalidMappings :: [(Name, Name)]
invalidMappings = ((Name, Name) -> Bool) -> [(Name, Name)] -> [(Name, Name)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> ((Name, Name) -> Bool) -> (Name, Name) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name, Name) -> Bool
isAssociationMapping) [(Name, Name)]
choices
    allMappingValues :: [[Name]]
allMappingValues = ([Name] -> Bool) -> [[Name]] -> [[Name]]
forall a. (a -> Bool) -> [a] -> [a]
filter
      (Bool -> Bool
not (Bool -> Bool) -> ([Name] -> Bool) -> [Name] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Name] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Name] -> Bool) -> ([Name] -> [Name]) -> [Name] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Name] -> [Name]
forall a. HasCallStack => [a] -> [a]
tail)
      ([[Name]] -> [[Name]]) -> [[Name]] -> [[Name]]
forall a b. (a -> b) -> a -> b
$ [Name] -> [[Name]]
forall a. Eq a => [a] -> [[a]]
group ([Name] -> [[Name]]) -> [Name] -> [[Name]]
forall a b. (a -> b) -> a -> b
$ [Name] -> [Name]
forall a. Ord a => [a] -> [a]
sort (((Name, Name) -> Name) -> [(Name, Name)] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (Name, Name) -> Name
forall a b. (a, b) -> a
fst [(Name, Name)]
choices [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ ((Name, Name) -> Name) -> [(Name, Name)] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (Name, Name) -> Name
forall a b. (a, b) -> b
snd [(Name, Name)]
choices)

readMapping :: Ord a => Bimap a a -> (a, a) -> Maybe (a, a)
readMapping :: forall a. Ord a => Bimap a a -> (a, a) -> Maybe (a, a)
readMapping Bimap a a
m (a
x, a
y)
  | Maybe a -> Bool
forall a. Maybe a -> Bool
isJust (Maybe a -> Bool) -> Maybe a -> Bool
forall a b. (a -> b) -> a -> b
$ a -> Bimap a a -> Maybe a
forall a b (m :: * -> *).
(Ord a, Ord b, MonadThrow m) =>
a -> Bimap a b -> m b
BM.lookup a
x Bimap a a
m, Maybe a -> Bool
forall a. Maybe a -> Bool
isJust (Maybe a -> Bool) -> Maybe a -> Bool
forall a b. (a -> b) -> a -> b
$ a -> Bimap a a -> Maybe a
forall a b (m :: * -> *).
(Ord a, Ord b, MonadThrow m) =>
b -> Bimap a b -> m a
BM.lookupR a
y Bimap a a
m
  = (a, a) -> Maybe (a, a)
forall a. a -> Maybe a
Just (a
x, a
y)
  | Maybe a -> Bool
forall a. Maybe a -> Bool
isJust (Maybe a -> Bool) -> Maybe a -> Bool
forall a b. (a -> b) -> a -> b
$ a -> Bimap a a -> Maybe a
forall a b (m :: * -> *).
(Ord a, Ord b, MonadThrow m) =>
a -> Bimap a b -> m b
BM.lookup a
y Bimap a a
m, Maybe a -> Bool
forall a. Maybe a -> Bool
isJust (Maybe a -> Bool) -> Maybe a -> Bool
forall a b. (a -> b) -> a -> b
$ a -> Bimap a a -> Maybe a
forall a b (m :: * -> *).
(Ord a, Ord b, MonadThrow m) =>
b -> Bimap a b -> m a
BM.lookupR a
x Bimap a a
m
  = (a, a) -> Maybe (a, a)
forall a. a -> Maybe a
Just (a
y, a
x)
  | Bool
otherwise
  = Maybe (a, a)
forall a. Maybe a
Nothing

differentNamesEvaluation
  :: OutputCapable m
  => DifferentNamesInstance
  -> [(Name, Name)]
  -> Rated m
differentNamesEvaluation :: forall (m :: * -> *).
OutputCapable m =>
DifferentNamesInstance -> [(Name, Name)] -> Rated m
differentNamesEvaluation DifferentNamesInstance
task [(Name, Name)]
cs = do
  let 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) ()
german String
"Zuordnungen"
        String -> State (Map Language String) ()
english String
"mappings"
      m :: Bimap Name Name
m = NameMapping -> Bimap Name Name
nameMapping (NameMapping -> Bimap Name Name) -> NameMapping -> Bimap Name Name
forall a b. (a -> b) -> a -> b
$ DifferentNamesInstance -> NameMapping
mapping DifferentNamesInstance
task
      ms :: Map (Name, Name) Bool
ms = [((Name, Name), Bool)] -> Map (Name, Name) Bool
forall k a. Eq k => [(k, a)] -> Map k a
M.fromAscList ([((Name, Name), Bool)] -> Map (Name, Name) Bool)
-> [((Name, Name), Bool)] -> Map (Name, Name) Bool
forall a b. (a -> b) -> a -> b
$ ((Name, Name) -> ((Name, Name), Bool))
-> [(Name, Name)] -> [((Name, Name), Bool)]
forall a b. (a -> b) -> [a] -> [b]
map (,Bool
True) ([(Name, Name)] -> [((Name, Name), Bool)])
-> [(Name, Name)] -> [((Name, Name), Bool)]
forall a b. (a -> b) -> a -> b
$ Bimap Name Name -> [(Name, Name)]
forall a b. Bimap a b -> [(a, b)]
BM.toAscList Bimap Name Name
m
      solution :: Maybe String
solution =
        if DifferentNamesInstance -> Bool
showSolution DifferentNamesInstance
task
        then String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String)
-> ([(Name, Name)] -> String) -> [(Name, Name)] -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(ShowName, ShowName)] -> String
forall a. Show a => a -> String
show ([(ShowName, ShowName)] -> String)
-> ([(Name, Name)] -> [(ShowName, ShowName)])
-> [(Name, Name)]
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Name, Name)] -> [(ShowName, ShowName)]
mappingShow ([(Name, Name)] -> Maybe String) -> [(Name, Name)] -> Maybe String
forall a b. (a -> b) -> a -> b
$ DifferentNamesInstance -> [(Name, Name)]
differentNamesSolution DifferentNamesInstance
task
        else Maybe String
forall a. Maybe a
Nothing
  ArticleToUse
-> Map Language String
-> Maybe String
-> Map (Name, Name) Bool
-> [(Name, Name)]
-> 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 (Name, Name) Bool
ms (((Name, Name) -> Maybe (Name, Name))
-> [(Name, Name)] -> [(Name, Name)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Bimap Name Name -> (Name, Name) -> Maybe (Name, Name)
forall a. Ord a => Bimap a a -> (a, a) -> Maybe (a, a)
readMapping Bimap Name Name
m) [(Name, Name)]
cs)

differentNamesSolution :: DifferentNamesInstance -> [(Name, Name)]
differentNamesSolution :: DifferentNamesInstance -> [(Name, Name)]
differentNamesSolution = Bimap Name Name -> [(Name, Name)]
forall a b. Bimap a b -> [(a, b)]
BM.toAscList (Bimap Name Name -> [(Name, Name)])
-> (DifferentNamesInstance -> Bimap Name Name)
-> DifferentNamesInstance
-> [(Name, Name)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NameMapping -> Bimap Name Name
nameMapping (NameMapping -> Bimap Name Name)
-> (DifferentNamesInstance -> NameMapping)
-> DifferentNamesInstance
-> Bimap Name Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DifferentNamesInstance -> NameMapping
mapping

differentNames
  :: (MonadAlloy m, MonadCatch m)
  => DifferentNamesConfig
  -> Int
  -> Int
  -> m DifferentNamesInstance
differentNames :: forall (m :: * -> *).
(MonadAlloy m, MonadCatch m) =>
DifferentNamesConfig -> Int -> Int -> m DifferentNamesInstance
differentNames DifferentNamesConfig
config Int
segment Int
seed = do
  let g :: StdGen
g = Int -> StdGen
mkStdGen (Int
segment Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
seed)
  (RandT StdGen m DifferentNamesInstance
 -> StdGen -> m DifferentNamesInstance)
-> StdGen
-> RandT StdGen m DifferentNamesInstance
-> m DifferentNamesInstance
forall a b c. (a -> b -> c) -> b -> a -> c
flip RandT StdGen m DifferentNamesInstance
-> StdGen -> m DifferentNamesInstance
forall (m :: * -> *) g a. Monad m => RandT g m a -> g -> m a
evalRandT StdGen
g (RandT StdGen m DifferentNamesInstance -> m DifferentNamesInstance)
-> RandT StdGen m DifferentNamesInstance
-> m DifferentNamesInstance
forall a b. (a -> b) -> a -> b
$ do
    [AlloyInstance]
is <- Maybe Bool
-> ClassConfig
-> RelationshipProperties
-> Maybe Integer
-> Maybe Int
-> RandT StdGen m [AlloyInstance]
forall (m :: * -> *).
(MonadAlloy m, MonadRandom m) =>
Maybe Bool
-> ClassConfig
-> RelationshipProperties
-> Maybe Integer
-> Maybe Int
-> m [AlloyInstance]
generateCds
      (DifferentNamesConfig -> Maybe Bool
withNonTrivialInheritance DifferentNamesConfig
config)
      (DifferentNamesConfig -> ClassConfig
classConfig DifferentNamesConfig
config)
      RelationshipProperties
defaultProperties
      (DifferentNamesConfig -> Maybe Integer
maxInstances DifferentNamesConfig
config)
      (DifferentNamesConfig -> Maybe Int
timeout DifferentNamesConfig
config)
    [AlloyInstance] -> RandT StdGen m DifferentNamesInstance
forall {m :: * -> *}.
(MonadRandom m, MonadAlloy m, MonadCatch m) =>
[AlloyInstance] -> m DifferentNamesInstance
tryGettingValidInstanceFor [AlloyInstance]
is
  where
    tryGettingValidInstanceFor :: [AlloyInstance] -> m DifferentNamesInstance
tryGettingValidInstanceFor []             = TaskGenerationException -> m DifferentNamesInstance
forall e a. Exception e => e -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM TaskGenerationException
NoInstanceAvailable
    tryGettingValidInstanceFor (AlloyInstance
inst:[AlloyInstance]
instances) = do
      Cd
cd <- AlloyInstance -> m Cd
forall (m :: * -> *). MonadThrow m => AlloyInstance -> m Cd
instanceToCd AlloyInstance
inst 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 :: * -> *). MonadRandom m => Cd -> m Cd
shuffleClassAndConnectionOrder
        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
>>= (Identity Cd -> Cd) -> m (Identity Cd) -> m Cd
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Identity Cd -> Cd
forall a. Identity a -> a
runIdentity (m (Identity Cd) -> m Cd) -> (Cd -> m (Identity Cd)) -> Cd -> m Cd
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity Cd -> m (Identity Cd)
forall (m :: * -> *) (t :: * -> *).
(MonadRandom m, Traversable t, MonadThrow m) =>
t Cd -> m (t Cd)
shuffleCdNames (Identity Cd -> m (Identity Cd))
-> (Cd -> Identity Cd) -> Cd -> m (Identity Cd)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cd -> Identity Cd
forall a. a -> Identity a
Identity
      DifferentNamesInstance
taskInstance <- m DifferentNamesInstance
-> DifferentNamesConfig -> Cd -> m DifferentNamesInstance
forall (m :: * -> *).
(MonadAlloy m, MonadCatch m, MonadRandom m) =>
m DifferentNamesInstance
-> DifferentNamesConfig -> Cd -> m DifferentNamesInstance
getDifferentNamesTask
        ([AlloyInstance] -> m DifferentNamesInstance
tryGettingValidInstanceFor [AlloyInstance]
instances)
        DifferentNamesConfig
config
        Cd
cd
      DifferentNamesInstance -> m DifferentNamesInstance
forall (m :: * -> *) a.
(MonadRandom m, MonadThrow m, RandomiseLayout a,
 RandomiseNames a) =>
a -> m a
shuffleEverything DifferentNamesInstance
taskInstance

{-|
A 'defaultDifferentNamesInstance' as generated
using 'defaultDifferentNamesConfig'.
-}
defaultDifferentNamesInstance :: DifferentNamesInstance
defaultDifferentNamesInstance :: DifferentNamesInstance
defaultDifferentNamesInstance = DifferentNamesInstance {
  cDiagram :: Cd
cDiagram = ClassDiagram {
    classNames :: [String]
classNames = [String
"C", String
"B", String
"D", String
"A"],
    relationships :: [Relationship String String]
relationships = [
      Composition {
        compositionName :: String
compositionName = String
"x",
        compositionPart :: LimitedLinking String
compositionPart = LimitedLinking {
          linking :: String
linking = String
"D",
          limits :: (Int, Maybe Int)
limits = (Int
2, Maybe Int
forall a. Maybe a
Nothing)
          },
        compositionWhole :: LimitedLinking String
compositionWhole = LimitedLinking {
          linking :: String
linking = String
"B",
          limits :: (Int, Maybe Int)
limits = (Int
0, Int -> Maybe Int
forall a. a -> Maybe a
Just Int
1)
          }
        },
      Inheritance {
        subClass :: String
subClass = String
"A",
        superClass :: String
superClass = String
"C"
        },
      Association {
        associationName :: String
associationName = String
"y",
        associationFrom :: LimitedLinking String
associationFrom = LimitedLinking {
          linking :: String
linking = String
"C",
          limits :: (Int, Maybe Int)
limits = (Int
0, Maybe Int
forall a. Maybe a
Nothing)
          },
        associationTo :: LimitedLinking String
associationTo = LimitedLinking {
          linking :: String
linking = String
"D",
          limits :: (Int, Maybe Int)
limits = (Int
0, Int -> Maybe Int
forall a. a -> Maybe a
Just Int
1)
          }
        },
      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
0, Int -> Maybe Int
forall a. a -> Maybe a
Just Int
2)
          }
        }
      ]
    },
  cdDrawSettings :: CdDrawSettings
cdDrawSettings = CdDrawSettings
defaultCdDrawSettings,
  oDiagram :: Od
oDiagram = ObjectDiagram {
    objects :: [Object String String]
objects = [
      Object {isAnonymous :: Bool
isAnonymous = Bool
True, objectName :: String
objectName = String
"c",  objectClass :: String
objectClass = String
"C"},
      Object {isAnonymous :: Bool
isAnonymous = Bool
True, objectName :: String
objectName = String
"c1", objectClass :: String
objectClass = String
"C"},
      Object {isAnonymous :: Bool
isAnonymous = Bool
True, objectName :: String
objectName = String
"d",  objectClass :: String
objectClass = String
"D"},
      Object {isAnonymous :: Bool
isAnonymous = Bool
True, objectName :: String
objectName = String
"b",  objectClass :: String
objectClass = String
"B"},
      Object {isAnonymous :: Bool
isAnonymous = Bool
True, objectName :: String
objectName = String
"d1", objectClass :: String
objectClass = String
"D"},
      Object {isAnonymous :: Bool
isAnonymous = Bool
True, objectName :: String
objectName = String
"a",  objectClass :: String
objectClass = String
"A"}
      ],
    links :: [Link String String]
links = [
      Link {linkLabel :: String
linkLabel = String
"2", linkFrom :: String
linkFrom = String
"d1", linkTo :: String
linkTo = String
"b"},
      Link {linkLabel :: String
linkLabel = String
"1", linkFrom :: String
linkFrom = String
"b",  linkTo :: String
linkTo = String
"a"},
      Link {linkLabel :: String
linkLabel = String
"2", linkFrom :: String
linkFrom = String
"d",  linkTo :: String
linkTo = String
"b"},
      Link {linkLabel :: String
linkLabel = String
"3", linkFrom :: String
linkFrom = String
"c",  linkTo :: String
linkTo = String
"d1"},
      Link {linkLabel :: String
linkLabel = String
"3", linkFrom :: String
linkFrom = String
"c1", linkTo :: String
linkTo = String
"d1"}
      ]
    },
  showSolution :: Bool
showSolution = Bool
False,
  mapping :: NameMapping
mapping = Bimap String String -> NameMapping
toNameMapping (Bimap String String -> NameMapping)
-> Bimap String String -> NameMapping
forall a b. (a -> b) -> a -> b
$ [(String, String)] -> Bimap String String
forall a b. (Ord a, Ord b) => [(a, b)] -> Bimap a b
BM.fromList [(String
"x", String
"2"), (String
"y", String
"3"), (String
"z", String
"1")],
  linkShuffling :: ShufflingOption String
linkShuffling = ShufflingOption String
forall a. ShufflingOption a
ConsecutiveNumbers,
  taskText :: DifferentNamesTaskText
taskText = DifferentNamesTaskText
defaultDifferentNamesTaskText,
  addText :: Maybe (Map Language String)
addText = Maybe (Map Language String)
forall a. Maybe a
Nothing
  }

getDifferentNamesTask
  :: (MonadAlloy m, MonadCatch m, MonadRandom m)
  => m DifferentNamesInstance
  -> DifferentNamesConfig
  -> Cd
  -> m DifferentNamesInstance
getDifferentNamesTask :: forall (m :: * -> *).
(MonadAlloy m, MonadCatch m, MonadRandom m) =>
m DifferentNamesInstance
-> DifferentNamesConfig -> Cd -> m DifferentNamesInstance
getDifferentNamesTask m DifferentNamesInstance
tryNext DifferentNamesConfig {Bool
Maybe Bool
Maybe Int
Maybe Integer
Maybe (Map Language String)
ObjectProperties
ObjectConfig
OmittedDefaultMultiplicities
ClassConfig
classConfig :: DifferentNamesConfig -> ClassConfig
withNonTrivialInheritance :: DifferentNamesConfig -> Maybe Bool
maxInstances :: DifferentNamesConfig -> Maybe Integer
objectConfig :: DifferentNamesConfig -> ObjectConfig
objectProperties :: DifferentNamesConfig -> ObjectProperties
omittedDefaultMultiplicities :: DifferentNamesConfig -> OmittedDefaultMultiplicities
printSolution :: DifferentNamesConfig -> Bool
timeout :: DifferentNamesConfig -> Maybe Int
withObviousMapping :: DifferentNamesConfig -> Maybe Bool
extraText :: DifferentNamesConfig -> Maybe (Map Language String)
classConfig :: ClassConfig
withNonTrivialInheritance :: Maybe Bool
maxInstances :: Maybe Integer
objectConfig :: ObjectConfig
objectProperties :: ObjectProperties
omittedDefaultMultiplicities :: OmittedDefaultMultiplicities
printSolution :: Bool
timeout :: Maybe Int
withObviousMapping :: Maybe Bool
extraText :: Maybe (Map Language String)
..} Cd
cd = do
    let cd0 :: (Integer, Cd)
cd0    = (Integer
0 :: Integer, Cd
cd)
        parts0 :: Parts
parts0 = (Integer -> Cd -> Parts) -> (Integer, Cd) -> Parts
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Integer -> Cd -> Parts
forall {a}. Show a => a -> Cd -> Parts
alloyFor (Integer, Cd)
cd0
        labels :: [String]
labels = (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 (Cd -> [String]) -> Cd -> [String]
forall a b. (a -> b) -> a -> b
$ (Integer, Cd) -> Cd
forall a b. (a, b) -> b
snd (Integer, Cd)
cd0
        cds :: [Cd]
cds    = ([String] -> Cd) -> [[String]] -> [Cd]
forall a b. (a -> b) -> [a] -> [b]
map
          ((Bimap String String -> Cd -> Cd)
-> Cd -> Bimap String String -> Cd
forall a b c. (a -> b -> c) -> b -> a -> c
flip Bimap String String -> Cd -> Cd
forall {d} {b} {t :: * -> * -> *} {c}.
(Ord d, Ord b, Bitraversable t) =>
Bimap b d -> t c b -> t c d
renameEdges Cd
cd (Bimap String String -> Cd)
-> ([String] -> Bimap String String) -> [String] -> Cd
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(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, String)])
-> [String]
-> Bimap String String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String] -> [(String, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip [String]
labels)
          ([[String]] -> [Cd]) -> [[String]] -> [Cd]
forall a b. (a -> b) -> a -> b
$ Int -> [[String]] -> [[String]]
forall a. Int -> [a] -> [a]
drop Int
1 ([String] -> [[String]]
forall a. [a] -> [[a]]
permutations [String]
labels)
        cds' :: [(Integer, Cd)]
cds'   = [Integer] -> [Cd] -> [(Integer, Cd)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Integer
1 :: Integer ..] [Cd]
cds
        partsList :: [Parts]
partsList = ((Integer, Cd) -> Parts) -> [(Integer, Cd)] -> [Parts]
forall a b. (a -> b) -> [a] -> [b]
map ((Integer -> Cd -> Parts) -> (Integer, Cd) -> Parts
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Integer -> Cd -> Parts
forall {a}. Show a => a -> Cd -> Parts
alloyFor) [(Integer, Cd)]
cds'
        runCmd :: String
runCmd = String
"cd0 and "
          String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
conjunctNegationsOf (((Integer, Cd) -> String) -> [(Integer, Cd)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ((String
"cd" String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> ((Integer, Cd) -> String) -> (Integer, Cd) -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> String
forall a. Show a => a -> String
show (Integer -> String)
-> ((Integer, Cd) -> Integer) -> (Integer, Cd) -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer, Cd) -> Integer
forall a b. (a, b) -> a
fst) [(Integer, Cd)]
cds')
          String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
overlappingConstraints
        names :: [String]
names = Cd -> [String]
forall className relationshipName.
ClassDiagram className relationshipName -> [className]
classNames Cd
cd
        onlyCd0 :: String
onlyCd0 = String
-> Maybe [String]
-> Int
-> ObjectConfig
-> [Relationship String String]
-> String
forall a b.
String
-> Maybe [String]
-> Int
-> ObjectConfig
-> [Relationship a b]
-> String
createRunCommand
          String
runCmd
          Maybe [String]
forall a. Maybe a
Nothing
          ([String] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
names)
          ObjectConfig
objectConfig
          ((Cd -> [Relationship String String])
-> [Cd] -> [Relationship String String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Cd -> [Relationship String String]
forall className relationshipName.
ClassDiagram className relationshipName
-> [Relationship className relationshipName]
relationships [Cd]
cds)
        partsList' :: Parts
partsList' = (Parts -> Parts -> Parts) -> Parts -> [Parts] -> Parts
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Parts -> Parts -> Parts
mergeParts Parts
parts0 [Parts]
partsList
    [AlloyInstance]
instances  <- Maybe Integer -> Maybe Int -> String -> m [AlloyInstance]
forall (m :: * -> *).
MonadAlloy m =>
Maybe Integer -> Maybe Int -> String -> m [AlloyInstance]
getInstances
      Maybe Integer
maxInstances
      Maybe Int
timeout
      (Parts -> String
combineParts Parts
partsList' String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
unlines [String]
overlappingPredicates String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
onlyCd0)
    [AlloyInstance]
instances' <- [AlloyInstance] -> m [AlloyInstance]
forall (m :: * -> *) a. MonadRandom m => [a] -> m [a]
shuffleM ([AlloyInstance]
instances :: [AlloyInstance])
    [AlloyInstance]
-> (AlloyInstance -> m DifferentNamesInstance)
-> m DifferentNamesInstance
forall {t}.
[t] -> (t -> m DifferentNamesInstance) -> m DifferentNamesInstance
continueWithHead [AlloyInstance]
instances' ((AlloyInstance -> m DifferentNamesInstance)
 -> m DifferentNamesInstance)
-> (AlloyInstance -> m DifferentNamesInstance)
-> m DifferentNamesInstance
forall a b. (a -> b) -> a -> b
$ \AlloyInstance
od1 -> do
      [String]
labels' <- [String] -> m [String]
forall (m :: * -> *) a. MonadRandom m => [a] -> m [a]
shuffleM [String]
labels
      [String]
used <- [String] -> AlloyInstance -> m [String]
forall (m :: * -> *).
MonadThrow m =>
[String] -> AlloyInstance -> m [String]
usedLabels [String]
labels AlloyInstance
od1
      let usedFirst :: [String]
usedFirst = ([String] -> [String] -> [String])
-> ([String], [String]) -> [String]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
(++) (([String], [String]) -> [String])
-> ([String], [String]) -> [String]
forall a b. (a -> b) -> a -> b
$ (String -> Bool) -> [String] -> ([String], [String])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
used) [String]
labels'
          bm :: Bimap String String
bm  = [(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]
usedFirst ((Int -> String) -> [Int] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Int -> String
forall a. Show a => a -> String
show [Int
1 :: Int ..])
          bm' :: Bimap String String
bm' = (String -> String -> Bool)
-> Bimap String String -> Bimap String String
forall a b.
(Ord a, Ord b) =>
(a -> b -> Bool) -> Bimap a b -> Bimap a b
BM.filter (Bool -> String -> Bool
forall a b. a -> b -> a
const (Bool -> String -> Bool)
-> (String -> Bool) -> String -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
used)) Bimap String String
bm
          isCompleteMapping :: Bool
isCompleteMapping = Bimap String String -> [String]
forall a b. Bimap a b -> [a]
BM.keys Bimap String String
bm [String] -> [String] -> Bool
forall a. Eq a => a -> a -> Bool
== [String] -> [String]
forall a. Ord a => [a] -> [a]
sort [String]
used
      if (Bool -> Bool)
-> (Bool -> Bool -> Bool) -> Maybe Bool -> Bool -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
        (Bool -> Bool -> Bool
forall a b. a -> b -> a
const Bool
True)
        ((Bool -> Bool) -> (Bool -> Bool) -> Bool -> Bool -> Bool
forall a. a -> a -> Bool -> a
bool Bool -> Bool
not Bool -> Bool
forall a. a -> a
id)
        (ObjectProperties -> Maybe Bool
usesEveryRelationshipName ObjectProperties
objectProperties)
        Bool
isCompleteMapping
        then do
        let keepClassNames :: Bimap String String
keepClassNames = [(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
            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
keepClassNames Bimap String String
bm
        Od
od1' <- (String -> Od) -> (Od -> Od) -> Either String Od -> Od
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Od
forall a. HasCallStack => String -> a
error Od -> Od
forall a. a -> a
id
          (Either String Od -> Od) -> m (Either String Od) -> m Od
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ExceptT String m Od -> m (Either String Od)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (Maybe [String] -> [String] -> AlloyInstance -> ExceptT String m Od
forall (m :: * -> *).
MonadCatch m =>
Maybe [String] -> [String] -> AlloyInstance -> m Od
alloyInstanceToOd Maybe [String]
forall a. Maybe a
Nothing [String]
labels AlloyInstance
od1)
        Od
od1'' <- Od -> m Od
renameOd Od
od1'
          m Od -> (Od -> m Od) -> m Od
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= 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)
        return $ DifferentNamesInstance {
              cDiagram :: Cd
cDiagram  = Cd
cd,
              cdDrawSettings :: CdDrawSettings
cdDrawSettings = CdDrawSettings {
                omittedDefaults :: OmittedDefaultMultiplicities
omittedDefaults = OmittedDefaultMultiplicities
omittedDefaultMultiplicities,
                printNames :: Bool
printNames = Bool
True,
                printNavigations :: Bool
printNavigations = Bool
True
                },
              oDiagram :: Od
oDiagram  = Od
od1'',
              showSolution :: Bool
showSolution = Bool
printSolution,
              mapping :: NameMapping
mapping   = Bimap String String -> NameMapping
toNameMapping Bimap String String
bm',
              linkShuffling :: ShufflingOption String
linkShuffling = ShufflingOption String
forall a. ShufflingOption a
ConsecutiveNumbers,
              taskText :: DifferentNamesTaskText
taskText = DifferentNamesTaskText
defaultDifferentNamesTaskText,
              addText :: Maybe (Map Language String)
addText = Maybe (Map Language String)
extraText
              }
        else m DifferentNamesInstance
tryNext
  where
    negationOf :: src -> dst
negationOf src
p = [i|not (#{p})|]
    conjunctNegationsOf :: [String] -> String
conjunctNegationsOf = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
" and " ([String] -> String)
-> ([String] -> [String]) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ShowS
forall {dst} {src}.
Interpolatable (IsCustomSink dst) src dst =>
src -> dst
negationOf
    (String
overlappingConstraints, [String]
overlappingPredicates) =
      case Maybe Bool
withObviousMapping of
        Maybe Bool
Nothing -> (String
"", [])
        Just Bool
True -> ShowS -> (String, [String]) -> (String, [String])
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (String
" and " String -> ShowS
forall a. [a] -> [a] -> [a]
++) (String, [String])
getOverlapping
        Just Bool
False -> ShowS -> (String, [String]) -> (String, [String])
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ((String
" and " String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
forall {dst} {src}.
Interpolatable (IsCustomSink dst) src dst =>
src -> dst
negationOf) (String, [String])
getOverlapping
    getOverlapping :: (String, [String])
getOverlapping = ([String] -> String) -> ([String], [String]) -> (String, [String])
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first [String] -> String
conjunctNegationsOf
      (([String], [String]) -> (String, [String]))
-> ([String], [String]) -> (String, [String])
forall a b. (a -> b) -> a -> b
$ [(String, String)] -> ([String], [String])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(String, String)] -> ([String], [String]))
-> [(String, String)] -> ([String], [String])
forall a b. (a -> b) -> a -> b
$ [Relationship String String] -> [(String, String)]
overlappingLinksPredicates ([Relationship String String] -> [(String, String)])
-> [Relationship String String] -> [(String, String)]
forall a b. (a -> b) -> a -> b
$ Cd -> [Relationship String String]
forall className relationshipName.
ClassDiagram className relationshipName
-> [Relationship className relationshipName]
relationships Cd
cd
    renameEdges :: Bimap b d -> t c b -> t c d
renameEdges Bimap b d
bm = (SomeException -> t c d)
-> (t c d -> t c d) -> Either SomeException (t c d) -> t c d
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> t c d
forall a. HasCallStack => String -> a
error (String -> t c d)
-> (SomeException -> String) -> SomeException -> t c d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeException -> String
forall a. Show a => a -> String
show) t c d -> t c d
forall a. a -> a
id (Either SomeException (t c d) -> t c d)
-> (t c b -> Either SomeException (t c d)) -> t c b -> t c d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (c -> Either SomeException c)
-> (b -> Either SomeException d)
-> t c b
-> Either SomeException (t c d)
forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse c -> Either SomeException c
forall a. a -> Either SomeException a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (b -> Bimap b d -> Either SomeException d
forall a b (m :: * -> *).
(Ord a, Ord b, MonadThrow m) =>
a -> Bimap a b -> m b
`BM.lookup` Bimap b d
bm)
    alloyFor :: a -> Cd -> Parts
alloyFor a
n Cd
cd' = LinguisticReuse
-> Cd
-> Maybe [String]
-> [String]
-> ObjectConfig
-> ObjectProperties
-> String
-> String
-> Parts
transform
      (ExtendsAnd -> LinguisticReuse
ExtendsAnd ExtendsAnd
NothingMore)
      Cd
cd'
      Maybe [String]
forall a. Maybe a
Nothing
      []
      ObjectConfig
objectConfig
      ObjectProperties
objectProperties
      (a -> String
forall a. Show a => a -> String
show a
n)
      String
""
    continueWithHead :: [t] -> (t -> m DifferentNamesInstance) -> m DifferentNamesInstance
continueWithHead []    t -> m DifferentNamesInstance
_ = m DifferentNamesInstance
tryNext
    continueWithHead (t
x:[t]
_) t -> m DifferentNamesInstance
f = t -> m DifferentNamesInstance
f t
x
    usedLabels :: MonadThrow m => [String] -> AlloyInstance -> m [String]
    usedLabels :: forall (m :: * -> *).
MonadThrow m =>
[String] -> AlloyInstance -> m [String]
usedLabels [String]
labels AlloyInstance
inst = do
      let ignore :: b -> b -> m ()
ignore = (b -> m ()) -> b -> b -> m ()
forall a b. a -> b -> a
const ((b -> m ()) -> b -> b -> m ()) -> (b -> m ()) -> b -> b -> m ()
forall a b. (a -> b) -> a -> b
$ m () -> b -> m ()
forall a b. a -> b -> a
const (m () -> b -> m ()) -> m () -> b -> m ()
forall a b. (a -> b) -> a -> b
$ () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          usedLabel :: a -> t a -> Maybe a
usedLabel a
label t a
xs = if t a -> Bool
forall a. t a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null t a
xs then Maybe a
forall a. Maybe a
Nothing else a -> Maybe a
forall a. a -> Maybe a
Just a
label
      AlloySig
os    <- Signature -> AlloyInstance -> m AlloySig
forall (m :: * -> *).
MonadThrow m =>
Signature -> AlloyInstance -> m AlloySig
lookupSig (String -> String -> Signature
scoped String
"this" String
"Object") AlloyInstance
inst
      [Maybe String] -> [String]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe String] -> [String])
-> ([Set ((), ())] -> [Maybe String]) -> [Set ((), ())] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Set ((), ()) -> Maybe String)
-> [String] -> [Set ((), ())] -> [Maybe String]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith String -> Set ((), ()) -> Maybe String
forall {t :: * -> *} {a} {a}. Foldable t => a -> t a -> Maybe a
usedLabel [String]
labels
        ([Set ((), ())] -> [String]) -> m [Set ((), ())] -> m [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> m (Set ((), ()))) -> [String] -> m [Set ((), ())]
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 (\String
label -> String
-> (String -> Int -> m ())
-> (String -> Int -> m ())
-> AlloySig
-> m (Set ((), ()))
forall (m :: * -> *) a b.
(MonadThrow m, Ord a, Ord b) =>
String
-> (String -> Int -> m a)
-> (String -> Int -> m b)
-> AlloySig
-> m (Set (a, b))
getDoubleAs String
label String -> Int -> m ()
forall {b} {b}. b -> b -> m ()
ignore String -> Int -> m ()
forall {b} {b}. b -> b -> m ()
ignore AlloySig
os) [String]
labels

{-|
All names within a 'DifferentNamesInstance'
including names reserved for shuffling.
-}
classNonInheritanceAndLinkNames
  :: DifferentNamesInstance
  -> ([String], [String], [String])
classNonInheritanceAndLinkNames :: DifferentNamesInstance -> ([String], [String], [String])
classNonInheritanceAndLinkNames DifferentNamesInstance {Bool
DifferentNamesTaskText
Maybe (Map Language String)
Od
Cd
CdDrawSettings
NameMapping
ShufflingOption String
cDiagram :: DifferentNamesInstance -> Cd
cdDrawSettings :: DifferentNamesInstance -> CdDrawSettings
oDiagram :: DifferentNamesInstance -> Od
showSolution :: DifferentNamesInstance -> Bool
mapping :: DifferentNamesInstance -> NameMapping
linkShuffling :: DifferentNamesInstance -> ShufflingOption String
taskText :: DifferentNamesInstance -> DifferentNamesTaskText
addText :: DifferentNamesInstance -> Maybe (Map Language String)
cDiagram :: Cd
cdDrawSettings :: CdDrawSettings
oDiagram :: Od
showSolution :: Bool
mapping :: NameMapping
linkShuffling :: ShufflingOption String
taskText :: DifferentNamesTaskText
addText :: Maybe (Map Language String)
..} =
  let names :: [String]
names = Cd -> [String]
forall className relationshipName.
ClassDiagram className relationshipName -> [className]
classNames Cd
cDiagram
      nonInheritances :: [String]
nonInheritances = Cd -> [String]
associationNames Cd
cDiagram
      additional :: [String]
additional = case ShufflingOption String
linkShuffling of
        ShufflingOption String
ConsecutiveNumbers -> []
        WithAdditionalNames [String]
xs -> [String]
xs
      links :: [String]
links = Od -> [String]
forall linkLabel objectName className.
Ord linkLabel =>
ObjectDiagram objectName className linkLabel -> [linkLabel]
linkLabels Od
oDiagram [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
additional
  in ([String]
names, [String]
nonInheritances, [String]
links)

instance RandomiseNames DifferentNamesInstance where
  hasRandomisableNames :: DifferentNamesInstance -> Maybe String
hasRandomisableNames DifferentNamesInstance {Bool
DifferentNamesTaskText
Maybe (Map Language String)
Od
Cd
CdDrawSettings
NameMapping
ShufflingOption String
cDiagram :: DifferentNamesInstance -> Cd
cdDrawSettings :: DifferentNamesInstance -> CdDrawSettings
oDiagram :: DifferentNamesInstance -> Od
showSolution :: DifferentNamesInstance -> Bool
mapping :: DifferentNamesInstance -> NameMapping
linkShuffling :: DifferentNamesInstance -> ShufflingOption String
taskText :: DifferentNamesInstance -> DifferentNamesTaskText
addText :: DifferentNamesInstance -> Maybe (Map Language String)
cDiagram :: Cd
cdDrawSettings :: CdDrawSettings
oDiagram :: Od
showSolution :: Bool
mapping :: NameMapping
linkShuffling :: ShufflingOption String
taskText :: DifferentNamesTaskText
addText :: Maybe (Map Language String)
..} =
    Od -> Maybe String
forall linkLabels.
ObjectDiagram String String linkLabels -> Maybe String
isObjectDiagramRandomisable Od
oDiagram

  randomiseNames :: forall (m :: * -> *).
(MonadRandom m, MonadThrow m) =>
DifferentNamesInstance -> m DifferentNamesInstance
randomiseNames DifferentNamesInstance
inst = do
    let ([String]
names, [String]
nonInheritances, [String]
lNames) = DifferentNamesInstance -> ([String], [String], [String])
classNonInheritanceAndLinkNames DifferentNamesInstance
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
    [String]
links' <- [String] -> m [String]
forall (m :: * -> *) a. MonadRandom m => [a] -> m [a]
shuffleM [String]
lNames
    DifferentNamesInstance
-> [String] -> [String] -> [String] -> m DifferentNamesInstance
forall (m :: * -> *).
MonadThrow m =>
DifferentNamesInstance
-> [String] -> [String] -> [String] -> m DifferentNamesInstance
renameInstance DifferentNamesInstance
inst [String]
names' [String]
nonInheritances' [String]
links'

instance RandomiseLayout DifferentNamesInstance where
  randomiseLayout :: forall (m :: * -> *).
(MonadRandom m, MonadThrow m) =>
DifferentNamesInstance -> m DifferentNamesInstance
randomiseLayout DifferentNamesInstance {Bool
DifferentNamesTaskText
Maybe (Map Language String)
Od
Cd
CdDrawSettings
NameMapping
ShufflingOption String
cDiagram :: DifferentNamesInstance -> Cd
cdDrawSettings :: DifferentNamesInstance -> CdDrawSettings
oDiagram :: DifferentNamesInstance -> Od
showSolution :: DifferentNamesInstance -> Bool
mapping :: DifferentNamesInstance -> NameMapping
linkShuffling :: DifferentNamesInstance -> ShufflingOption String
taskText :: DifferentNamesInstance -> DifferentNamesTaskText
addText :: DifferentNamesInstance -> Maybe (Map Language String)
cDiagram :: Cd
cdDrawSettings :: CdDrawSettings
oDiagram :: Od
showSolution :: Bool
mapping :: NameMapping
linkShuffling :: ShufflingOption String
taskText :: DifferentNamesTaskText
addText :: Maybe (Map Language String)
..} = do
    Cd
cd <- Cd -> m Cd
forall (m :: * -> *). MonadRandom m => Cd -> m Cd
shuffleClassAndConnectionOrder Cd
cDiagram
    Od
od <- Od -> m Od
forall (m :: * -> *) objectName className linkLabel.
MonadRandom m =>
ObjectDiagram objectName className linkLabel
-> m (ObjectDiagram objectName className linkLabel)
shuffleObjectAndLinkOrder Od
oDiagram
    return $ DifferentNamesInstance {
      cDiagram :: Cd
cDiagram = Cd
cd,
      cdDrawSettings :: CdDrawSettings
cdDrawSettings = CdDrawSettings
cdDrawSettings,
      oDiagram :: Od
oDiagram = Od
od,
      showSolution :: Bool
showSolution = Bool
showSolution,
      mapping :: NameMapping
mapping = NameMapping
mapping,
      linkShuffling :: ShufflingOption String
linkShuffling = ShufflingOption String
linkShuffling,
      taskText :: DifferentNamesTaskText
taskText = DifferentNamesTaskText
taskText,
      addText :: Maybe (Map Language String)
addText = Maybe (Map Language String)
addText
      }

renameInstance
  :: MonadThrow m
  => DifferentNamesInstance
  -> [String]
  -> [String]
  -> [String]
  -> m DifferentNamesInstance
renameInstance :: forall (m :: * -> *).
MonadThrow m =>
DifferentNamesInstance
-> [String] -> [String] -> [String] -> m DifferentNamesInstance
renameInstance inst :: DifferentNamesInstance
inst@DifferentNamesInstance {Bool
DifferentNamesTaskText
Maybe (Map Language String)
Od
Cd
CdDrawSettings
NameMapping
ShufflingOption String
cDiagram :: DifferentNamesInstance -> Cd
cdDrawSettings :: DifferentNamesInstance -> CdDrawSettings
oDiagram :: DifferentNamesInstance -> Od
showSolution :: DifferentNamesInstance -> Bool
mapping :: DifferentNamesInstance -> NameMapping
linkShuffling :: DifferentNamesInstance -> ShufflingOption String
taskText :: DifferentNamesInstance -> DifferentNamesTaskText
addText :: DifferentNamesInstance -> Maybe (Map Language String)
cDiagram :: Cd
cdDrawSettings :: CdDrawSettings
oDiagram :: Od
showSolution :: Bool
mapping :: NameMapping
linkShuffling :: ShufflingOption String
taskText :: DifferentNamesTaskText
addText :: Maybe (Map Language String)
..} [String]
names' [String]
nonInheritances' [String]
linkNs' = do
  let cd :: Cd
cd = Cd
cDiagram
      od :: Od
od = Od
oDiagram
      ([String]
names, [String]
nonInheritances, [String]
linkNs) = DifferentNamesInstance -> ([String], [String], [String])
classNonInheritanceAndLinkNames DifferentNamesInstance
inst
      bm :: [(String, String)]
bm = Bimap String String -> [(String, String)]
forall a b. Bimap a b -> [(a, b)]
BM.toAscList (Bimap String String -> [(String, String)])
-> Bimap String String -> [(String, String)]
forall a b. (a -> b) -> a -> b
$ NameMapping -> Bimap String String
fromNameMapping NameMapping
mapping
      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'
      bmLinks :: Bimap String String
bmLinks  = [(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]
linkNs [String]
linkNs'
      bm' :: Bimap String String
bm'      = [(String, String)] -> Bimap String String
forall a b. (Ord a, Ord b) => [(a, b)] -> Bimap a b
BM.fromList
        [ (String
a', String
l')
        | (String
a, String
l) <- [(String, String)]
bm
        , String
a' <- String -> Bimap String String -> [String]
forall a b (m :: * -> *).
(Ord a, Ord b, MonadThrow m) =>
a -> Bimap a b -> m b
BM.lookup String
a Bimap String String
bmNonInheritances
        , String
l' <- String -> Bimap String String -> [String]
forall a b (m :: * -> *).
(Ord a, Ord b, MonadThrow m) =>
a -> Bimap a b -> m b
BM.lookup String
l Bimap String String
bmLinks
        ]
  Cd
cd' <- 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 Cd
cd
  Od
od' <- 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
bmLinks Od
od
  ShufflingOption String
shuffling <- (String -> m String)
-> ShufflingOption String -> m (ShufflingOption String)
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) -> ShufflingOption a -> m (ShufflingOption b)
mapM (String -> Bimap String String -> m String
forall a b (m :: * -> *).
(Ord a, Ord b, MonadThrow m) =>
a -> Bimap a b -> m b
`BM.lookup` Bimap String String
bmLinks) ShufflingOption String
linkShuffling
  return $ DifferentNamesInstance {
    cDiagram :: Cd
cDiagram  = Cd
cd',
    cdDrawSettings :: CdDrawSettings
cdDrawSettings = CdDrawSettings
cdDrawSettings,
    oDiagram :: Od
oDiagram  = Od
od',
    showSolution :: Bool
showSolution = Bool
showSolution,
    mapping :: NameMapping
mapping   = Bimap String String -> NameMapping
toNameMapping Bimap String String
bm',
    linkShuffling :: ShufflingOption String
linkShuffling = ShufflingOption String
shuffling,
    taskText :: DifferentNamesTaskText
taskText = DifferentNamesTaskText
taskText,
    addText :: Maybe (Map Language String)
addText = Maybe (Map Language String)
addText
    }