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

module Modelling.ActivityDiagram.MatchPetri (
  MatchPetriInstance(..),
  MatchPetriConfig(..),
  MatchPetriSolution(..),
  defaultMatchPetriConfig,
  checkMatchPetriConfig,
  mapTypesToLabels,
  matchPetriAlloy,
  matchPetriSolution,
  extractAuxiliaryPetriNodes,
  matchPetriTask,
  matchPetriInitial,
  matchPetriSyntax,
  matchPetriEvaluation,
  matchPetri,
  defaultMatchPetriInstance
) where

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

import qualified Modelling.ActivityDiagram.Config as Config (
  AdConfig (activityFinalNodes, flowFinalNodes),
  )
import Modelling.ActivityDiagram.Auxiliary.PetriValidation (validatePetriConfig)
import qualified Modelling.ActivityDiagram.PetriNet as PK (label)
import qualified Modelling.PetriNet.Types as Petri (Net (nodes))

import Capabilities.Alloy               (MonadAlloy, getInstances)
import Capabilities.Cache               (MonadCache)
import Capabilities.Diagrams            (MonadDiagrams)
import Capabilities.Graphviz            (MonadGraphviz)
import Capabilities.PlantUml            (MonadPlantUml)
import Capabilities.WriteFile           (MonadWriteFile)
import Modelling.ActivityDiagram.Alloy  (adConfigToAlloy, modulePetriNet)
import Modelling.ActivityDiagram.Auxiliary.Util (finalNodesAdvice)
import Modelling.ActivityDiagram.Datatype (
  UMLActivityDiagram(..),
  AdNode (..),
  AdConnection (..),
  isActionNode,
  isActivityFinalNode,
  isObjectNode,
  isDecisionNode,
  isFlowFinalNode,
  isMergeNode,
  isJoinNode,
  isInitialNode,
  isForkNode
  )
import Modelling.ActivityDiagram.Isomorphism (petriHasMultipleAutomorphisms)
import Modelling.ActivityDiagram.PetriNet (
  PetriKey (..),
  convertToPetriNet,
  isAuxiliaryPetriNode,
  )
import Modelling.ActivityDiagram.Shuffle (shufflePetri, shuffleAdNames)
import Modelling.ActivityDiagram.Config (
  AdConfig,
  checkAdConfig,
  defaultAdConfig,
  )
import Modelling.ActivityDiagram.Instance (parseInstance)
import Modelling.ActivityDiagram.PlantUMLConverter (
  PlantUmlConfig (..),
  defaultPlantUmlConfig,
  drawAdToFile,
  )
import Modelling.Auxiliary.Common (getFirstInstance, oneOf)
import Modelling.Auxiliary.Output (
  addPretext,
  extra
  )
import Modelling.PetriNet.Diagram (cacheNet)
import Modelling.PetriNet.Types (
  checkPetriNodeCount,
  DrawSettings (..),
  Net (mapNet),
  PetriLike (..),
  SimpleNode (..),
  SimplePetriLike,
  )

import Control.Applicative (Alternative ((<|>)))
import Control.Monad.Catch              (MonadThrow)
import Control.OutputCapable.Blocks (
  ArticleToUse (DefiniteArticle),
  GenericOutputCapable (..),
  LangM,
  Language,
  Rated,
  OutputCapable,
  ($=<<),
  english,
  german,
  translate,
  translations,
  multipleChoice,
  )
import Control.Monad.Random (
  MonadRandom,
  RandT,
  RandomGen,
  evalRandT,
  mkStdGen
  )
import Data.Bifunctor                   (second)
import Data.Containers.ListUtils (nubOrd)
import Data.GraphViz.Commands (GraphvizCommand(..))
import Data.List (intersect, sort)
import Data.Map (Map)
import Data.String.Interpolate (i, iii)
import Data.Tuple.Extra                 (dupe)
import GHC.Generics (Generic)
import System.Random.Shuffle (shuffleM)


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

data MatchPetriConfig = MatchPetriConfig {
  MatchPetriConfig -> AdConfig
adConfig :: AdConfig,
  -- | generate only activity diagrams with a corresponding Petri net
  -- having a total count of nodes within the given bounds
  MatchPetriConfig -> (Int, Maybe Int)
countOfPetriNodesBounds :: !(Int, Maybe Int),
  MatchPetriConfig -> Maybe Integer
maxInstances :: Maybe Integer,
  MatchPetriConfig -> Bool
hideBranchConditions :: Bool,
  MatchPetriConfig -> [GraphvizCommand]
petriLayout :: [GraphvizCommand],
  -- | Whether highlighting on hover should be enabled
  MatchPetriConfig -> Bool
petriSvgHighlighting :: Bool,
  -- | Option to prevent auxiliary PetriNodes from occurring
  MatchPetriConfig -> Maybe Bool
auxiliaryPetriNodeAbsent :: Maybe Bool,
  -- | Force presence or absence of new sink transitions for representing finals
  MatchPetriConfig -> Maybe Bool
presenceOfSinkTransitionsForFinals :: Maybe Bool,
  -- | Avoid Activity Finals in concurrent flows to reduce confusion
  MatchPetriConfig -> Maybe Bool
withActivityFinalInForkBlocks :: !(Maybe Bool),
  MatchPetriConfig -> Bool
printSolution :: Bool,
  MatchPetriConfig -> Maybe (Map Language String)
extraText :: Maybe (Map Language String)
} deriving ((forall x. MatchPetriConfig -> Rep MatchPetriConfig x)
-> (forall x. Rep MatchPetriConfig x -> MatchPetriConfig)
-> Generic MatchPetriConfig
forall x. Rep MatchPetriConfig x -> MatchPetriConfig
forall x. MatchPetriConfig -> Rep MatchPetriConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. MatchPetriConfig -> Rep MatchPetriConfig x
from :: forall x. MatchPetriConfig -> Rep MatchPetriConfig x
$cto :: forall x. Rep MatchPetriConfig x -> MatchPetriConfig
to :: forall x. Rep MatchPetriConfig x -> MatchPetriConfig
Generic, ReadPrec [MatchPetriConfig]
ReadPrec MatchPetriConfig
Int -> ReadS MatchPetriConfig
ReadS [MatchPetriConfig]
(Int -> ReadS MatchPetriConfig)
-> ReadS [MatchPetriConfig]
-> ReadPrec MatchPetriConfig
-> ReadPrec [MatchPetriConfig]
-> Read MatchPetriConfig
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS MatchPetriConfig
readsPrec :: Int -> ReadS MatchPetriConfig
$creadList :: ReadS [MatchPetriConfig]
readList :: ReadS [MatchPetriConfig]
$creadPrec :: ReadPrec MatchPetriConfig
readPrec :: ReadPrec MatchPetriConfig
$creadListPrec :: ReadPrec [MatchPetriConfig]
readListPrec :: ReadPrec [MatchPetriConfig]
Read, Int -> MatchPetriConfig -> ShowS
[MatchPetriConfig] -> ShowS
MatchPetriConfig -> String
(Int -> MatchPetriConfig -> ShowS)
-> (MatchPetriConfig -> String)
-> ([MatchPetriConfig] -> ShowS)
-> Show MatchPetriConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MatchPetriConfig -> ShowS
showsPrec :: Int -> MatchPetriConfig -> ShowS
$cshow :: MatchPetriConfig -> String
show :: MatchPetriConfig -> String
$cshowList :: [MatchPetriConfig] -> ShowS
showList :: [MatchPetriConfig] -> ShowS
Show)

pickRandomLayout :: (MonadRandom m) => MatchPetriConfig -> m GraphvizCommand
pickRandomLayout :: forall (m :: * -> *).
MonadRandom m =>
MatchPetriConfig -> m GraphvizCommand
pickRandomLayout MatchPetriConfig
conf = [GraphvizCommand] -> m GraphvizCommand
forall (m :: * -> *) a. MonadRandom m => [a] -> m a
oneOf (MatchPetriConfig -> [GraphvizCommand]
petriLayout MatchPetriConfig
conf)

defaultMatchPetriConfig :: MatchPetriConfig
defaultMatchPetriConfig :: MatchPetriConfig
defaultMatchPetriConfig =
  MatchPetriConfig {
    $sel:adConfig:MatchPetriConfig :: AdConfig
adConfig = AdConfig
defaultAdConfig {
      activityFinalNodes :: Int
Config.activityFinalNodes = Int
0,
      flowFinalNodes :: Int
Config.flowFinalNodes = Int
2
      },
    $sel:countOfPetriNodesBounds:MatchPetriConfig :: (Int, Maybe Int)
countOfPetriNodesBounds = (Int
0, Maybe Int
forall a. Maybe a
Nothing),
    $sel:maxInstances:MatchPetriConfig :: Maybe Integer
maxInstances = Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
25,
    $sel:hideBranchConditions:MatchPetriConfig :: Bool
hideBranchConditions = Bool
False,
    $sel:petriLayout:MatchPetriConfig :: [GraphvizCommand]
petriLayout = [GraphvizCommand
Dot],
    $sel:petriSvgHighlighting:MatchPetriConfig :: Bool
petriSvgHighlighting = Bool
True,
    $sel:auxiliaryPetriNodeAbsent:MatchPetriConfig :: Maybe Bool
auxiliaryPetriNodeAbsent = Maybe Bool
forall a. Maybe a
Nothing,
    $sel:presenceOfSinkTransitionsForFinals:MatchPetriConfig :: Maybe Bool
presenceOfSinkTransitionsForFinals = Maybe Bool
forall a. Maybe a
Nothing,
    $sel:withActivityFinalInForkBlocks:MatchPetriConfig :: Maybe Bool
withActivityFinalInForkBlocks = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False,
    $sel:printSolution:MatchPetriConfig :: Bool
printSolution = Bool
False,
    $sel:extraText:MatchPetriConfig :: Maybe (Map Language String)
extraText = Maybe (Map Language String)
forall a. Maybe a
Nothing
  }

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


checkMatchPetriConfig' :: MatchPetriConfig -> Maybe String
checkMatchPetriConfig' :: MatchPetriConfig -> Maybe String
checkMatchPetriConfig' MatchPetriConfig {
    AdConfig
$sel:adConfig:MatchPetriConfig :: MatchPetriConfig -> AdConfig
adConfig :: AdConfig
adConfig,
    (Int, Maybe Int)
$sel:countOfPetriNodesBounds:MatchPetriConfig :: MatchPetriConfig -> (Int, Maybe Int)
countOfPetriNodesBounds :: (Int, Maybe Int)
countOfPetriNodesBounds,
    Maybe Integer
$sel:maxInstances:MatchPetriConfig :: MatchPetriConfig -> Maybe Integer
maxInstances :: Maybe Integer
maxInstances,
    [GraphvizCommand]
$sel:petriLayout:MatchPetriConfig :: MatchPetriConfig -> [GraphvizCommand]
petriLayout :: [GraphvizCommand]
petriLayout,
    Maybe Bool
$sel:auxiliaryPetriNodeAbsent:MatchPetriConfig :: MatchPetriConfig -> Maybe Bool
auxiliaryPetriNodeAbsent :: Maybe Bool
auxiliaryPetriNodeAbsent,
    Maybe Bool
$sel:presenceOfSinkTransitionsForFinals:MatchPetriConfig :: MatchPetriConfig -> Maybe Bool
presenceOfSinkTransitionsForFinals :: Maybe Bool
presenceOfSinkTransitionsForFinals,
    Maybe Bool
$sel:withActivityFinalInForkBlocks:MatchPetriConfig :: MatchPetriConfig -> Maybe Bool
withActivityFinalInForkBlocks :: Maybe Bool
withActivityFinalInForkBlocks
  } = AdConfig
-> (Int, Maybe Int)
-> Maybe Integer
-> [GraphvizCommand]
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe String
validatePetriConfig
        AdConfig
adConfig
        (Int, Maybe Int)
countOfPetriNodesBounds
        Maybe Integer
maxInstances
        [GraphvizCommand]
petriLayout
        Maybe Bool
auxiliaryPetriNodeAbsent
        Maybe Bool
presenceOfSinkTransitionsForFinals
        Maybe Bool
withActivityFinalInForkBlocks

matchPetriAlloy :: MatchPetriConfig -> String
matchPetriAlloy :: MatchPetriConfig -> String
matchPetriAlloy MatchPetriConfig {
  AdConfig
$sel:adConfig:MatchPetriConfig :: MatchPetriConfig -> AdConfig
adConfig :: AdConfig
adConfig,
  Maybe Bool
$sel:auxiliaryPetriNodeAbsent:MatchPetriConfig :: MatchPetriConfig -> Maybe Bool
auxiliaryPetriNodeAbsent :: Maybe Bool
auxiliaryPetriNodeAbsent,
  Maybe Bool
$sel:presenceOfSinkTransitionsForFinals:MatchPetriConfig :: MatchPetriConfig -> Maybe Bool
presenceOfSinkTransitionsForFinals :: Maybe Bool
presenceOfSinkTransitionsForFinals,
  Maybe Bool
$sel:withActivityFinalInForkBlocks:MatchPetriConfig :: MatchPetriConfig -> Maybe Bool
withActivityFinalInForkBlocks :: Maybe Bool
withActivityFinalInForkBlocks
}
  = String -> String -> AdConfig -> String
adConfigToAlloy String
modules String
predicates AdConfig
adConfig
  where
    activityFinalsExist :: Maybe Bool
activityFinalsExist = Bool -> Maybe Bool
forall a. a -> Maybe a
Just (AdConfig -> Int
Config.activityFinalNodes AdConfig
adConfig Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0)
    modules :: String
modules = String
modulePetriNet
    predicates :: String
predicates =
          [i|
            #{f auxiliaryPetriNodeAbsent "auxiliaryPetriNodeAbsent"}
            #{f activityFinalsExist "activityFinalsExist"}
            #{f (not <$> presenceOfSinkTransitionsForFinals) "avoidAddingSinksForFinals"}
            #{f (not <$> withActivityFinalInForkBlocks) "noActivityFinalInForkBlocks"}
          |]
    f :: Maybe Bool -> ShowS
f Maybe Bool
opt String
s =
          case Maybe Bool
opt of
            Just Bool
True -> String
s
            Just Bool
False -> [i| not #{s}|]
            Maybe Bool
Nothing -> String
""

mapTypesToLabels
  :: Net p n
  => p n PetriKey
  -> MatchPetriSolution
mapTypesToLabels :: forall (p :: (* -> *) -> * -> *) (n :: * -> *).
Net p n =>
p n PetriKey -> MatchPetriSolution
mapTypesToLabels p n PetriKey
petri =
  MatchPetriSolution {
    $sel:actionNodes:MatchPetriSolution :: [(String, Int)]
actionNodes = (AdNode -> Bool) -> [(String, Int)]
extractNameLabelTuple AdNode -> Bool
isActionNode,
    $sel:activityFinalNodes:MatchPetriSolution :: [Int]
activityFinalNodes = (AdNode -> Bool) -> [Int]
extractLabels AdNode -> Bool
isActivityFinalNode,
    $sel:objectNodes:MatchPetriSolution :: [(String, Int)]
objectNodes = (AdNode -> Bool) -> [(String, Int)]
extractNameLabelTuple AdNode -> Bool
isObjectNode,
    $sel:decisionNodes:MatchPetriSolution :: [Int]
decisionNodes = (AdNode -> Bool) -> [Int]
extractLabels AdNode -> Bool
isDecisionNode,
    $sel:flowFinalNodes:MatchPetriSolution :: [Int]
flowFinalNodes = (AdNode -> Bool) -> [Int]
extractLabels AdNode -> Bool
isFlowFinalNode,
    $sel:mergeNodes:MatchPetriSolution :: [Int]
mergeNodes = (AdNode -> Bool) -> [Int]
extractLabels AdNode -> Bool
isMergeNode,
    $sel:forks:MatchPetriSolution :: [Int]
forks = (AdNode -> Bool) -> [Int]
extractLabels AdNode -> Bool
isForkNode,
    $sel:joins:MatchPetriSolution :: [Int]
joins = (AdNode -> Bool) -> [Int]
extractLabels AdNode -> Bool
isJoinNode,
    $sel:initialNodes:MatchPetriSolution :: [Int]
initialNodes = (AdNode -> Bool) -> [Int]
extractLabels AdNode -> Bool
isInitialNode,
    $sel:auxiliaryPetriNodes:MatchPetriSolution :: [Int]
auxiliaryPetriNodes = [Int] -> [Int]
forall a. Ord a => [a] -> [a]
sort ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ (PetriKey -> Int) -> [PetriKey] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map PetriKey -> Int
PK.label ([PetriKey] -> [Int]) -> [PetriKey] -> [Int]
forall a b. (a -> b) -> a -> b
$ p n PetriKey -> [PetriKey]
forall (p :: (* -> *) -> * -> *) (n :: * -> *).
Net p n =>
p n PetriKey -> [PetriKey]
extractAuxiliaryPetriNodes p n PetriKey
petri
  }
  where
    extractNameLabelTuple :: (AdNode -> Bool) -> [(String, Int)]
extractNameLabelTuple AdNode -> Bool
fn =
      [(String, Int)] -> [(String, Int)]
forall a. Ord a => [a] -> [a]
sort ([(String, Int)] -> [(String, Int)])
-> [(String, Int)] -> [(String, Int)]
forall a b. (a -> b) -> a -> b
$
      (PetriKey -> (String, Int)) -> [PetriKey] -> [(String, Int)]
forall a b. (a -> b) -> [a] -> [b]
map (\PetriKey
k -> (AdNode -> String
name (AdNode -> String) -> AdNode -> String
forall a b. (a -> b) -> a -> b
$ PetriKey -> AdNode
sourceNode PetriKey
k, PetriKey -> Int
PK.label PetriKey
k)) ([PetriKey] -> [(String, Int)]) -> [PetriKey] -> [(String, Int)]
forall a b. (a -> b) -> a -> b
$
      (AdNode -> Bool) -> [PetriKey]
keysByNodeType AdNode -> Bool
fn
    extractLabels :: (AdNode -> Bool) -> [Int]
extractLabels AdNode -> Bool
fn =
      [Int] -> [Int]
forall a. Ord a => [a] -> [a]
sort ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$
      (PetriKey -> Int) -> [PetriKey] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map PetriKey -> Int
PK.label ([PetriKey] -> [Int]) -> [PetriKey] -> [Int]
forall a b. (a -> b) -> a -> b
$
      (AdNode -> Bool) -> [PetriKey]
keysByNodeType AdNode -> Bool
fn
    keysByNodeType :: (AdNode -> Bool) -> [PetriKey]
keysByNodeType AdNode -> Bool
fn =
      (PetriKey -> Bool) -> [PetriKey] -> [PetriKey]
forall a. (a -> Bool) -> [a] -> [a]
filter (AdNode -> Bool
fn (AdNode -> Bool) -> (PetriKey -> AdNode) -> PetriKey -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PetriKey -> AdNode
sourceNode)  ([PetriKey] -> [PetriKey]) -> [PetriKey] -> [PetriKey]
forall a b. (a -> b) -> a -> b
$
      (PetriKey -> Bool) -> [PetriKey] -> [PetriKey]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (PetriKey -> Bool) -> PetriKey -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PetriKey -> Bool
isAuxiliaryPetriNode) ([PetriKey] -> [PetriKey]) -> [PetriKey] -> [PetriKey]
forall a b. (a -> b) -> a -> b
$
      Map PetriKey (n PetriKey) -> [PetriKey]
forall k a. Map k a -> [k]
M.keys (Map PetriKey (n PetriKey) -> [PetriKey])
-> Map PetriKey (n PetriKey) -> [PetriKey]
forall a b. (a -> b) -> a -> b
$ p n PetriKey -> Map PetriKey (n PetriKey)
forall a. Ord a => p n a -> Map a (n a)
forall (p :: (* -> *) -> * -> *) (n :: * -> *) a.
(Net p n, Ord a) =>
p n a -> Map a (n a)
Petri.nodes p n PetriKey
petri

data MatchPetriSolution = MatchPetriSolution {
  MatchPetriSolution -> [(String, Int)]
actionNodes :: [(String, Int)],
  MatchPetriSolution -> [(String, Int)]
objectNodes :: [(String, Int)],
  MatchPetriSolution -> [Int]
decisionNodes :: [Int],
  MatchPetriSolution -> [Int]
mergeNodes :: [Int],
  MatchPetriSolution -> [Int]
forks :: [Int],
  MatchPetriSolution -> [Int]
joins :: [Int],
  MatchPetriSolution -> [Int]
initialNodes :: [Int],
  MatchPetriSolution -> [Int]
activityFinalNodes :: [Int],
  MatchPetriSolution -> [Int]
flowFinalNodes :: [Int],
  MatchPetriSolution -> [Int]
auxiliaryPetriNodes :: [Int]
} deriving ((forall x. MatchPetriSolution -> Rep MatchPetriSolution x)
-> (forall x. Rep MatchPetriSolution x -> MatchPetriSolution)
-> Generic MatchPetriSolution
forall x. Rep MatchPetriSolution x -> MatchPetriSolution
forall x. MatchPetriSolution -> Rep MatchPetriSolution x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. MatchPetriSolution -> Rep MatchPetriSolution x
from :: forall x. MatchPetriSolution -> Rep MatchPetriSolution x
$cto :: forall x. Rep MatchPetriSolution x -> MatchPetriSolution
to :: forall x. Rep MatchPetriSolution x -> MatchPetriSolution
Generic, Int -> MatchPetriSolution -> ShowS
[MatchPetriSolution] -> ShowS
MatchPetriSolution -> String
(Int -> MatchPetriSolution -> ShowS)
-> (MatchPetriSolution -> String)
-> ([MatchPetriSolution] -> ShowS)
-> Show MatchPetriSolution
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MatchPetriSolution -> ShowS
showsPrec :: Int -> MatchPetriSolution -> ShowS
$cshow :: MatchPetriSolution -> String
show :: MatchPetriSolution -> String
$cshowList :: [MatchPetriSolution] -> ShowS
showList :: [MatchPetriSolution] -> ShowS
Show, MatchPetriSolution -> MatchPetriSolution -> Bool
(MatchPetriSolution -> MatchPetriSolution -> Bool)
-> (MatchPetriSolution -> MatchPetriSolution -> Bool)
-> Eq MatchPetriSolution
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MatchPetriSolution -> MatchPetriSolution -> Bool
== :: MatchPetriSolution -> MatchPetriSolution -> Bool
$c/= :: MatchPetriSolution -> MatchPetriSolution -> Bool
/= :: MatchPetriSolution -> MatchPetriSolution -> Bool
Eq, ReadPrec [MatchPetriSolution]
ReadPrec MatchPetriSolution
Int -> ReadS MatchPetriSolution
ReadS [MatchPetriSolution]
(Int -> ReadS MatchPetriSolution)
-> ReadS [MatchPetriSolution]
-> ReadPrec MatchPetriSolution
-> ReadPrec [MatchPetriSolution]
-> Read MatchPetriSolution
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS MatchPetriSolution
readsPrec :: Int -> ReadS MatchPetriSolution
$creadList :: ReadS [MatchPetriSolution]
readList :: ReadS [MatchPetriSolution]
$creadPrec :: ReadPrec MatchPetriSolution
readPrec :: ReadPrec MatchPetriSolution
$creadListPrec :: ReadPrec [MatchPetriSolution]
readListPrec :: ReadPrec [MatchPetriSolution]
Read)

matchPetriSolution :: MatchPetriInstance -> MatchPetriSolution
matchPetriSolution :: MatchPetriInstance -> MatchPetriSolution
matchPetriSolution MatchPetriInstance
task = SimplePetriLike PetriKey -> MatchPetriSolution
forall (p :: (* -> *) -> * -> *) (n :: * -> *).
Net p n =>
p n PetriKey -> MatchPetriSolution
mapTypesToLabels (SimplePetriLike PetriKey -> MatchPetriSolution)
-> SimplePetriLike PetriKey -> MatchPetriSolution
forall a b. (a -> b) -> a -> b
$ MatchPetriInstance -> SimplePetriLike PetriKey
petriNet MatchPetriInstance
task

petriSolutionPairwiseDisjunct :: MatchPetriSolution -> Bool
petriSolutionPairwiseDisjunct :: MatchPetriSolution -> Bool
petriSolutionPairwiseDisjunct MatchPetriSolution{[Int]
[(String, Int)]
$sel:actionNodes:MatchPetriSolution :: MatchPetriSolution -> [(String, Int)]
$sel:activityFinalNodes:MatchPetriSolution :: MatchPetriSolution -> [Int]
$sel:objectNodes:MatchPetriSolution :: MatchPetriSolution -> [(String, Int)]
$sel:decisionNodes:MatchPetriSolution :: MatchPetriSolution -> [Int]
$sel:flowFinalNodes:MatchPetriSolution :: MatchPetriSolution -> [Int]
$sel:mergeNodes:MatchPetriSolution :: MatchPetriSolution -> [Int]
$sel:forks:MatchPetriSolution :: MatchPetriSolution -> [Int]
$sel:joins:MatchPetriSolution :: MatchPetriSolution -> [Int]
$sel:initialNodes:MatchPetriSolution :: MatchPetriSolution -> [Int]
$sel:auxiliaryPetriNodes:MatchPetriSolution :: MatchPetriSolution -> [Int]
actionNodes :: [(String, Int)]
objectNodes :: [(String, Int)]
decisionNodes :: [Int]
mergeNodes :: [Int]
forks :: [Int]
joins :: [Int]
initialNodes :: [Int]
activityFinalNodes :: [Int]
flowFinalNodes :: [Int]
auxiliaryPetriNodes :: [Int]
..} =
  [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and [ [Int] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Int]
xs [Int] -> [Int] -> [Int]
forall a. Eq a => [a] -> [a] -> [a]
`intersect` [Int]
ys) | [Int]
xs <- [[Int]]
allLists, [Int]
ys <- [[Int]]
allLists, [Int]
xs [Int] -> [Int] -> Bool
forall a. Eq a => a -> a -> Bool
/= [Int]
ys ] Bool -> Bool -> Bool
&& [[Int]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Int]]
allLists Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [[Int]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([[Int]] -> [[Int]]
forall a. Ord a => [a] -> [a]
nubOrd [[Int]]
allLists)
    where allLists :: [[Int]]
allLists =
            [ ((String, Int) -> Int) -> [(String, Int)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (String, Int) -> Int
forall a b. (a, b) -> b
snd [(String, Int)]
actionNodes
            , ((String, Int) -> Int) -> [(String, Int)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (String, Int) -> Int
forall a b. (a, b) -> b
snd [(String, Int)]
objectNodes
            , [Int]
decisionNodes
            , [Int]
mergeNodes
            , [Int]
forks
            , [Int]
joins
            , [Int]
initialNodes
            , [Int]
activityFinalNodes
            , [Int]
flowFinalNodes
            , [Int]
auxiliaryPetriNodes]

petriSolutionContainsPetriNodes :: MatchPetriSolution -> [PetriKey] -> Bool
petriSolutionContainsPetriNodes :: MatchPetriSolution -> [PetriKey] -> Bool
petriSolutionContainsPetriNodes MatchPetriSolution{[Int]
[(String, Int)]
$sel:actionNodes:MatchPetriSolution :: MatchPetriSolution -> [(String, Int)]
$sel:activityFinalNodes:MatchPetriSolution :: MatchPetriSolution -> [Int]
$sel:objectNodes:MatchPetriSolution :: MatchPetriSolution -> [(String, Int)]
$sel:decisionNodes:MatchPetriSolution :: MatchPetriSolution -> [Int]
$sel:flowFinalNodes:MatchPetriSolution :: MatchPetriSolution -> [Int]
$sel:mergeNodes:MatchPetriSolution :: MatchPetriSolution -> [Int]
$sel:forks:MatchPetriSolution :: MatchPetriSolution -> [Int]
$sel:joins:MatchPetriSolution :: MatchPetriSolution -> [Int]
$sel:initialNodes:MatchPetriSolution :: MatchPetriSolution -> [Int]
$sel:auxiliaryPetriNodes:MatchPetriSolution :: MatchPetriSolution -> [Int]
actionNodes :: [(String, Int)]
objectNodes :: [(String, Int)]
decisionNodes :: [Int]
mergeNodes :: [Int]
forks :: [Int]
joins :: [Int]
initialNodes :: [Int]
activityFinalNodes :: [Int]
flowFinalNodes :: [Int]
auxiliaryPetriNodes :: [Int]
..} = (PetriKey -> Bool) -> [PetriKey] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((Int -> [Int] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Int]
solutionKeys) (Int -> Bool) -> (PetriKey -> Int) -> PetriKey -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PetriKey -> Int
petriKeyToIndex)
  where
    solutionKeys :: [Int]
solutionKeys = [[Int]] -> [Int]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
      [ ((String, Int) -> Int) -> [(String, Int)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (String, Int) -> Int
forall a b. (a, b) -> b
snd [(String, Int)]
actionNodes
      , ((String, Int) -> Int) -> [(String, Int)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (String, Int) -> Int
forall a b. (a, b) -> b
snd [(String, Int)]
objectNodes
      , [Int]
decisionNodes
      , [Int]
mergeNodes
      , [Int]
forks
      , [Int]
joins
      , [Int]
initialNodes
      , [Int]
activityFinalNodes
      , [Int]
flowFinalNodes
      , [Int]
auxiliaryPetriNodes]
    petriKeyToIndex :: PetriKey -> Int
petriKeyToIndex (AuxiliaryPetriNode Int
index) = Int
index
    petriKeyToIndex (FinalPetriNode Int
index AdNode
_) = Int
index
    petriKeyToIndex (NormalPetriNode Int
index AdNode
_) = Int
index

extractAuxiliaryPetriNodes :: Net p n => p n PetriKey -> [PetriKey]
extractAuxiliaryPetriNodes :: forall (p :: (* -> *) -> * -> *) (n :: * -> *).
Net p n =>
p n PetriKey -> [PetriKey]
extractAuxiliaryPetriNodes p n PetriKey
petri = (PetriKey -> Bool) -> [PetriKey] -> [PetriKey]
forall a. (a -> Bool) -> [a] -> [a]
filter
  PetriKey -> Bool
isAuxiliaryPetriNode
  ([PetriKey] -> [PetriKey]) -> [PetriKey] -> [PetriKey]
forall a b. (a -> b) -> a -> b
$ Map PetriKey (n PetriKey) -> [PetriKey]
forall k a. Map k a -> [k]
M.keys (Map PetriKey (n PetriKey) -> [PetriKey])
-> Map PetriKey (n PetriKey) -> [PetriKey]
forall a b. (a -> b) -> a -> b
$ p n PetriKey -> Map PetriKey (n PetriKey)
forall a. Ord a => p n a -> Map a (n a)
forall (p :: (* -> *) -> * -> *) (n :: * -> *) a.
(Net p n, Ord a) =>
p n a -> Map a (n a)
Petri.nodes p n PetriKey
petri

matchPetriTask
  :: (
    MonadCache m,
    MonadDiagrams m,
    MonadGraphviz m,
    MonadPlantUml m,
    MonadThrow m,
    MonadWriteFile m,
    OutputCapable m
    )
  => FilePath
  -> MatchPetriInstance
  -> LangM m
matchPetriTask :: forall (m :: * -> *).
(MonadCache m, MonadDiagrams m, MonadGraphviz m, MonadPlantUml m,
 MonadThrow m, MonadWriteFile m, OutputCapable m) =>
String -> MatchPetriInstance -> LangM m
matchPetriTask String
path MatchPetriInstance
task = do
  LangM m -> LangM m
forall l (m :: * -> *).
GenericOutputCapable l m =>
GenericLangM l m () -> GenericLangM l m ()
paragraph (LangM m -> LangM m) -> LangM m -> LangM m
forall a b. (a -> b) -> a -> b
$ State (Map Language String) () -> LangM m
forall l (m :: * -> *).
GenericOutputCapable l m =>
State (Map l String) () -> GenericLangM l m ()
translate (State (Map Language String) () -> LangM m)
-> State (Map Language String) () -> LangM m
forall a b. (a -> b) -> a -> b
$ do
    String -> State (Map Language String) ()
english String
"Consider the following activity diagram:"
    String -> State (Map Language String) ()
german String
"Betrachten Sie folgendes Aktivitätsdiagramm:"
  String -> LangM m
forall l (m :: * -> *).
GenericOutputCapable l m =>
String -> GenericLangM l m ()
image (String -> LangM m) -> m String -> LangM m
forall (m :: * -> *) a l b.
Monad m =>
(a -> GenericLangM l m b) -> m a -> GenericLangM l m b
$=<< String -> PlantUmlConfig -> UMLActivityDiagram -> m String
forall (m :: * -> *).
(MonadPlantUml m, MonadWriteFile m) =>
String -> PlantUmlConfig -> UMLActivityDiagram -> m String
drawAdToFile String
path (MatchPetriInstance -> PlantUmlConfig
plantUMLConf MatchPetriInstance
task) (UMLActivityDiagram -> m String) -> UMLActivityDiagram -> m String
forall a b. (a -> b) -> a -> b
$ MatchPetriInstance -> UMLActivityDiagram
activityDiagram MatchPetriInstance
task
  LangM m -> LangM m
forall l (m :: * -> *).
GenericOutputCapable l m =>
GenericLangM l m () -> GenericLangM l m ()
paragraph (LangM m -> LangM m) -> LangM m -> LangM m
forall a b. (a -> b) -> a -> b
$ State (Map Language String) () -> LangM m
forall l (m :: * -> *).
GenericOutputCapable l m =>
State (Map l String) () -> GenericLangM l m ()
translate (State (Map Language String) () -> LangM m)
-> State (Map Language String) () -> LangM m
forall a b. (a -> b) -> a -> b
$ do
    String -> State (Map Language String) ()
english String
"Consider the following Petri net as translation of this activity diagram:"
    String -> State (Map Language String) ()
german String
"Betrachten Sie folgendes Petrinetz als Übersetzung dieses Aktivitätsdiagramms:"
  let drawSetting :: DrawSettings
drawSetting = MatchPetriInstance -> DrawSettings
petriDrawConf MatchPetriInstance
task
  String -> LangM m
forall l (m :: * -> *).
GenericOutputCapable l m =>
String -> GenericLangM l m ()
image (String -> LangM m) -> m String -> LangM m
forall (m :: * -> *) a l b.
Monad m =>
(a -> GenericLangM l m b) -> m a -> GenericLangM l m b
$=<< String -> PetriLike SimpleNode String -> DrawSettings -> m String
forall (n :: * -> *) (p :: (* -> *) -> * -> *) (m :: * -> *).
(Data (n String), Data (p n String), MonadCache m, MonadDiagrams m,
 MonadGraphviz m, MonadThrow m, Net p n, Typeable n, Typeable p) =>
String -> p n String -> DrawSettings -> m String
cacheNet String
path ((PetriKey -> String)
-> SimplePetriLike PetriKey -> PetriLike SimpleNode String
forall b a.
Ord b =>
(a -> b) -> PetriLike SimpleNode a -> PetriLike SimpleNode b
forall (p :: (* -> *) -> * -> *) (n :: * -> *) b a.
(Net p n, Ord b) =>
(a -> b) -> p n a -> p n b
mapNet (Int -> String
forall a. Show a => a -> String
show (Int -> String) -> (PetriKey -> Int) -> PetriKey -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PetriKey -> Int
PK.label) (SimplePetriLike PetriKey -> PetriLike SimpleNode String)
-> SimplePetriLike PetriKey -> PetriLike SimpleNode String
forall a b. (a -> b) -> a -> b
$ MatchPetriInstance -> SimplePetriLike PetriKey
petriNet MatchPetriInstance
task) DrawSettings
drawSetting
  LangM m -> LangM m
forall l (m :: * -> *).
GenericOutputCapable l m =>
GenericLangM l m () -> GenericLangM l m ()
paragraph (LangM m -> LangM m) -> LangM m -> LangM m
forall a b. (a -> b) -> a -> b
$ State (Map Language String) () -> LangM m
forall l (m :: * -> *).
GenericOutputCapable l m =>
State (Map l String) () -> GenericLangM l m ()
translate (State (Map Language String) () -> LangM m)
-> State (Map Language String) () -> LangM m
forall a b. (a -> b) -> a -> b
$ do
    String -> State (Map Language String) ()
english [iii|
      State each matching of action node and Petri net node,
      each matching of object node and Petri net node,
      the Petri net nodes per other element kind, as well as all auxiliary places
      and auxiliary transitions in the Petri net.
      |]
    String -> State (Map Language String) ()
german [iii|
      Geben Sie alle Aktionsknoten/Petrinetzknoten-Paare,
      alle Objektknoten/Petrinetzknoten-Paare, die Petrinetzknoten je anderer Elementart
      und alle Hilfsstellen und -transitionen im Petrinetz an.
      |]
  LangM m -> LangM m
forall l (m :: * -> *).
GenericOutputCapable l m =>
GenericLangM l m () -> GenericLangM l m ()
paragraph (LangM m -> LangM m) -> LangM m -> LangM m
forall a b. (a -> b) -> a -> b
$ do
    State (Map Language String) () -> LangM m
forall l (m :: * -> *).
GenericOutputCapable l m =>
State (Map l String) () -> GenericLangM l m ()
translate (State (Map Language String) () -> LangM m)
-> State (Map Language String) () -> LangM m
forall a b. (a -> b) -> a -> b
$ do
      String -> State (Map Language String) ()
english [i|To do this, enter your answer as in the following example:|]
      String -> State (Map Language String) ()
german [i|Geben Sie dazu Ihre Antwort wie im folgenden Beispiel an:|]
    String -> LangM m
forall l (m :: * -> *).
GenericOutputCapable l m =>
String -> GenericLangM l m ()
code (String -> LangM m) -> String -> LangM m
forall a b. (a -> b) -> a -> b
$ MatchPetriSolution -> String
forall a. Show a => a -> String
show MatchPetriSolution
matchPetriInitial
    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|
        In this example, the action nodes "A" and "B"
        are matched with the Petri net nodes 1 and 2,
        the Petri net nodes 5 and 7 correspond to decision nodes,
        the Petri net nodes 13, 14 and 15
        are auxiliary places or auxiliary transitions,
        the Petri net node 16 corresponds to an activity final node,
        and no Petri net node corresponds to a flow final node.
        |]
      String -> State (Map Language String) ()
german [iii|
        In diesem Beispiel sind etwa die Aktionsknoten "A" und "B"
        den Petrinetzknoten 1 und 2 zugeordnet,
        die Petrinetzknoten 5 und 7 entsprechen Verzweigungsknoten,
        die Petrinetzknoten 13, 14 und 15 sind Hilfsstellen oder -transitionen,
        der Petrinetzknoten 16 entspricht einem Aktivitätsende
        und kein Petrinetzknoten entspricht einem Flussende.
        |]
    pure ()
  Bool -> LangM m
forall (m :: * -> *). OutputCapable m => Bool -> LangM m
finalNodesAdvice Bool
False

  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
$ MatchPetriInstance -> Maybe (Map Language String)
addText MatchPetriInstance
task

  pure ()

matchPetriInitial :: MatchPetriSolution
matchPetriInitial :: MatchPetriSolution
matchPetriInitial = MatchPetriSolution {
  $sel:actionNodes:MatchPetriSolution :: [(String, Int)]
actionNodes = [(String
"A", Int
1), (String
"B", Int
2)],
  $sel:activityFinalNodes:MatchPetriSolution :: [Int]
activityFinalNodes = [Int
16],
  $sel:objectNodes:MatchPetriSolution :: [(String, Int)]
objectNodes = [(String
"C", Int
3), (String
"D", Int
4)],
  $sel:decisionNodes:MatchPetriSolution :: [Int]
decisionNodes = [Int
5, Int
7],
  $sel:flowFinalNodes:MatchPetriSolution :: [Int]
flowFinalNodes = [],
  $sel:mergeNodes:MatchPetriSolution :: [Int]
mergeNodes = [Int
6, Int
8],
  $sel:forks:MatchPetriSolution :: [Int]
forks = [Int
10],
  $sel:joins:MatchPetriSolution :: [Int]
joins = [Int
11],
  $sel:initialNodes:MatchPetriSolution :: [Int]
initialNodes = [Int
12],
  $sel:auxiliaryPetriNodes:MatchPetriSolution :: [Int]
auxiliaryPetriNodes = [Int
13, Int
14, Int
15]
}

matchPetriSyntax
  :: OutputCapable m
  => MatchPetriInstance
  -> MatchPetriSolution
  -> LangM m
matchPetriSyntax :: forall (m :: * -> *).
OutputCapable m =>
MatchPetriInstance -> MatchPetriSolution -> LangM m
matchPetriSyntax MatchPetriInstance
task MatchPetriSolution
sub = LangM' m () -> LangM' m ()
forall (m :: * -> *) a. OutputCapable m => LangM' m a -> LangM' m a
addPretext (LangM' m () -> LangM' m ()) -> LangM' m () -> LangM' m ()
forall a b. (a -> b) -> a -> b
$ do
  let adNames :: [String]
adNames = (AdNode -> String) -> [AdNode] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map AdNode -> String
name ([AdNode] -> [String]) -> [AdNode] -> [String]
forall a b. (a -> b) -> a -> b
$ (AdNode -> Bool) -> [AdNode] -> [AdNode]
forall a. (a -> Bool) -> [a] -> [a]
filter (\AdNode
n -> AdNode -> Bool
isActionNode AdNode
n Bool -> Bool -> Bool
|| AdNode -> Bool
isObjectNode AdNode
n) ([AdNode] -> [AdNode]) -> [AdNode] -> [AdNode]
forall a b. (a -> b) -> a -> b
$ UMLActivityDiagram -> [AdNode]
nodes (UMLActivityDiagram -> [AdNode]) -> UMLActivityDiagram -> [AdNode]
forall a b. (a -> b) -> a -> b
$ MatchPetriInstance -> UMLActivityDiagram
activityDiagram MatchPetriInstance
task
      subNames :: [String]
subNames = ((String, Int) -> String) -> [(String, Int)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, Int) -> String
forall a b. (a, b) -> a
fst (MatchPetriSolution -> [(String, Int)]
actionNodes MatchPetriSolution
sub) [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ ((String, Int) -> String) -> [(String, Int)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, Int) -> String
forall a b. (a, b) -> a
fst (MatchPetriSolution -> [(String, Int)]
objectNodes MatchPetriSolution
sub)
      petriNodeKeys :: [PetriKey]
petriNodeKeys = Map PetriKey (SimpleNode PetriKey) -> [PetriKey]
forall k a. Map k a -> [k]
M.keys (Map PetriKey (SimpleNode PetriKey) -> [PetriKey])
-> Map PetriKey (SimpleNode PetriKey) -> [PetriKey]
forall a b. (a -> b) -> a -> b
$ SimplePetriLike PetriKey -> Map PetriKey (SimpleNode PetriKey)
forall (n :: * -> *) a. PetriLike n a -> Map a (n a)
allNodes (SimplePetriLike PetriKey -> Map PetriKey (SimpleNode PetriKey))
-> SimplePetriLike PetriKey -> Map PetriKey (SimpleNode PetriKey)
forall a b. (a -> b) -> a -> b
$ MatchPetriInstance -> SimplePetriLike PetriKey
petriNet MatchPetriInstance
task
      petriLabels :: [Int]
petriLabels = (PetriKey -> Int) -> [PetriKey] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map PetriKey -> Int
PK.label [PetriKey]
petriNodeKeys
      subLabels :: [Int]
subLabels =
        ((String, Int) -> Int) -> [(String, Int)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (String, Int) -> Int
forall a b. (a, b) -> b
snd (MatchPetriSolution -> [(String, Int)]
actionNodes MatchPetriSolution
sub)
        [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ ((String, Int) -> Int) -> [(String, Int)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (String, Int) -> Int
forall a b. (a, b) -> b
snd (MatchPetriSolution -> [(String, Int)]
objectNodes MatchPetriSolution
sub)
        [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ MatchPetriSolution -> [Int]
decisionNodes MatchPetriSolution
sub
        [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ MatchPetriSolution -> [Int]
mergeNodes MatchPetriSolution
sub
        [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ MatchPetriSolution -> [Int]
forks MatchPetriSolution
sub
        [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ MatchPetriSolution -> [Int]
joins MatchPetriSolution
sub
        [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ MatchPetriSolution -> [Int]
initialNodes MatchPetriSolution
sub
        [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ MatchPetriSolution -> [Int]
auxiliaryPetriNodes MatchPetriSolution
sub
  Bool -> LangM' m () -> LangM' m ()
forall l (m :: * -> *).
GenericOutputCapable l m =>
Bool -> GenericLangM l m () -> GenericLangM l m ()
assertion ((String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
adNames) [String]
subNames) (LangM' m () -> LangM' m ()) -> LangM' m () -> LangM' m ()
forall a b. (a -> b) -> a -> b
$ State (Map Language String) () -> LangM' m ()
forall l (m :: * -> *).
GenericOutputCapable l m =>
State (Map l String) () -> GenericLangM l m ()
translate (State (Map Language String) () -> LangM' m ())
-> State (Map Language String) () -> LangM' m ()
forall a b. (a -> b) -> a -> b
$ do
    String -> State (Map Language String) ()
english String
"Referenced node names were provided within task?"
    String -> State (Map Language String) ()
german String
"Referenzierte Knotennamen sind Bestandteil der Aufgabenstellung?"
  Bool -> LangM' m () -> LangM' m ()
forall l (m :: * -> *).
GenericOutputCapable l m =>
Bool -> GenericLangM l m () -> GenericLangM l m ()
assertion ((Int -> Bool) -> [Int] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Int -> [Int] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Int]
petriLabels) [Int]
subLabels) (LangM' m () -> LangM' m ()) -> LangM' m () -> LangM' m ()
forall a b. (a -> b) -> a -> b
$ State (Map Language String) () -> LangM' m ()
forall l (m :: * -> *).
GenericOutputCapable l m =>
State (Map l String) () -> GenericLangM l m ()
translate (State (Map Language String) () -> LangM' m ())
-> State (Map Language String) () -> LangM' m ()
forall a b. (a -> b) -> a -> b
$ do
    String -> State (Map Language String) ()
english String
"Referenced Petri net nodes were provided within task?"
    String -> State (Map Language String) ()
german String
"Referenzierte Petrinetzknoten sind Bestandteil der Aufgabenstellung?"
  Bool -> LangM' m () -> LangM' m ()
forall l (m :: * -> *).
GenericOutputCapable l m =>
Bool -> GenericLangM l m () -> GenericLangM l m ()
assertion (MatchPetriSolution -> [PetriKey] -> Bool
petriSolutionContainsPetriNodes MatchPetriSolution
sub [PetriKey]
petriNodeKeys) (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 petri net nodes are associated to an element in the activity diagram?"
    String -> State (Map Language String) ()
german String
"Alle Petrinetzknoten sind einem Element in dem Aktivitätsdiagramm zugeordnet?"
  Bool -> LangM' m () -> LangM' m ()
forall l (m :: * -> *).
GenericOutputCapable l m =>
Bool -> GenericLangM l m () -> GenericLangM l m ()
assertion (MatchPetriSolution -> Bool
petriSolutionPairwiseDisjunct MatchPetriSolution
sub) (LangM' m () -> LangM' m ()) -> LangM' m () -> LangM' m ()
forall a b. (a -> b) -> a -> b
$ State (Map Language String) () -> LangM' m ()
forall l (m :: * -> *).
GenericOutputCapable l m =>
State (Map l String) () -> GenericLangM l m ()
translate (State (Map Language String) () -> LangM' m ())
-> State (Map Language String) () -> LangM' m ()
forall a b. (a -> b) -> a -> b
$ do
    String -> State (Map Language String) ()
english String
"All petri net nodes are associated uniquely?"
    String -> State (Map Language String) ()
german String
"Alle Petrinetzknoten sind eindeutig zugeordnet?"
  Bool -> LangM' m () -> LangM' m ()
forall l (m :: * -> *).
GenericOutputCapable l m =>
Bool -> GenericLangM l m () -> GenericLangM l m ()
assertion ((String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
subNames) [String]
adNames) (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 action and object nodes are referenced?"
    String -> State (Map Language String) ()
german String
"Alle Aktions- und Objektknoten wurden referenziert?"
  Bool -> LangM' m () -> LangM' m ()
forall l (m :: * -> *).
GenericOutputCapable l m =>
Bool -> GenericLangM l m () -> GenericLangM l m ()
assertion ([String] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
subNames Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [String] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([String] -> [String]
forall a. Ord a => [a] -> [a]
nubOrd [String]
subNames)) (LangM' m () -> LangM' m ()) -> LangM' m () -> LangM' m ()
forall a b. (a -> b) -> a -> b
$ State (Map Language String) () -> LangM' m ()
forall l (m :: * -> *).
GenericOutputCapable l m =>
State (Map l String) () -> GenericLangM l m ()
translate (State (Map Language String) () -> LangM' m ())
-> State (Map Language String) () -> LangM' m ()
forall a b. (a -> b) -> a -> b
$ do
    String -> State (Map Language String) ()
english String
"All action and object nodes were referenced exactly once?"
    String -> State (Map Language String) ()
german String
"Alle Aktions- und Objektknoten wurden genau einmal referenziert?"
  pure ()

matchPetriEvaluation
  :: OutputCapable m
  => MatchPetriInstance
  -> MatchPetriSolution
  -> Rated m
matchPetriEvaluation :: forall (m :: * -> *).
OutputCapable m =>
MatchPetriInstance -> MatchPetriSolution -> Rated m
matchPetriEvaluation MatchPetriInstance
task MatchPetriSolution
sub = LangM' m Rational -> LangM' m Rational
forall (m :: * -> *) a. OutputCapable m => LangM' m a -> LangM' m a
addPretext (LangM' m Rational -> LangM' m Rational)
-> LangM' m Rational -> LangM' m Rational
forall a b. (a -> b) -> a -> b
$ do
  let as :: Map Language String
as = State (Map Language String) () -> Map Language String
forall l a. State (Map l a) () -> Map l a
translations (State (Map Language String) () -> Map Language String)
-> State (Map Language String) () -> Map Language String
forall a b. (a -> b) -> a -> b
$ do
        String -> State (Map Language String) ()
english String
"answer parts"
        String -> State (Map Language String) ()
german String
"Teilantworten"
      sol :: MatchPetriSolution
sol = MatchPetriInstance -> MatchPetriSolution
matchPetriSolution MatchPetriInstance
task
      maybeSolutionString :: Maybe String
maybeSolutionString =
        if MatchPetriInstance -> Bool
showSolution MatchPetriInstance
task
        then String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ MatchPetriSolution -> String
forall a. Show a => a -> String
show MatchPetriSolution
sol
        else Maybe String
forall a. Maybe a
Nothing
      solution :: Map (Int, Either [(String, Int)] [Int]) Bool
solution = MatchPetriSolution -> Map (Int, Either [(String, Int)] [Int]) Bool
matchPetriSolutionMap MatchPetriSolution
sol
      sub' :: [(Int, Either [(String, Int)] [Int])]
sub' = Map (Int, Either [(String, Int)] [Int]) Bool
-> [(Int, Either [(String, Int)] [Int])]
forall k a. Map k a -> [k]
M.keys (Map (Int, Either [(String, Int)] [Int]) Bool
 -> [(Int, Either [(String, Int)] [Int])])
-> Map (Int, Either [(String, Int)] [Int]) Bool
-> [(Int, Either [(String, Int)] [Int])]
forall a b. (a -> b) -> a -> b
$ MatchPetriSolution -> Map (Int, Either [(String, Int)] [Int]) Bool
matchPetriSolutionMap MatchPetriSolution
sub
  ArticleToUse
-> Map Language String
-> Maybe String
-> Map (Int, Either [(String, Int)] [Int]) Bool
-> [(Int, Either [(String, Int)] [Int])]
-> LangM' m Rational
forall (m :: * -> *) a.
(OutputCapable m, Ord a) =>
ArticleToUse
-> Map Language String
-> Maybe String
-> Map a Bool
-> [a]
-> Rated m
multipleChoice ArticleToUse
DefiniteArticle Map Language String
as Maybe String
maybeSolutionString Map (Int, Either [(String, Int)] [Int]) Bool
solution [(Int, Either [(String, Int)] [Int])]
sub'

matchPetriSolutionMap
  :: MatchPetriSolution
  -> Map (Int, Either [(String, Int)] [Int]) Bool
matchPetriSolutionMap :: MatchPetriSolution -> Map (Int, Either [(String, Int)] [Int]) Bool
matchPetriSolutionMap MatchPetriSolution {[Int]
[(String, Int)]
$sel:actionNodes:MatchPetriSolution :: MatchPetriSolution -> [(String, Int)]
$sel:activityFinalNodes:MatchPetriSolution :: MatchPetriSolution -> [Int]
$sel:objectNodes:MatchPetriSolution :: MatchPetriSolution -> [(String, Int)]
$sel:decisionNodes:MatchPetriSolution :: MatchPetriSolution -> [Int]
$sel:flowFinalNodes:MatchPetriSolution :: MatchPetriSolution -> [Int]
$sel:mergeNodes:MatchPetriSolution :: MatchPetriSolution -> [Int]
$sel:forks:MatchPetriSolution :: MatchPetriSolution -> [Int]
$sel:joins:MatchPetriSolution :: MatchPetriSolution -> [Int]
$sel:initialNodes:MatchPetriSolution :: MatchPetriSolution -> [Int]
$sel:auxiliaryPetriNodes:MatchPetriSolution :: MatchPetriSolution -> [Int]
actionNodes :: [(String, Int)]
objectNodes :: [(String, Int)]
decisionNodes :: [Int]
mergeNodes :: [Int]
forks :: [Int]
joins :: [Int]
initialNodes :: [Int]
activityFinalNodes :: [Int]
flowFinalNodes :: [Int]
auxiliaryPetriNodes :: [Int]
..} =
  let xs :: [Either [(String, Int)] [Int]]
xs = [
        [(String, Int)] -> Either [(String, Int)] [Int]
forall a b. a -> Either a b
Left ([(String, Int)] -> Either [(String, Int)] [Int])
-> [(String, Int)] -> Either [(String, Int)] [Int]
forall a b. (a -> b) -> a -> b
$ [(String, Int)] -> [(String, Int)]
forall a. Ord a => [a] -> [a]
sort [(String, Int)]
actionNodes,
        [(String, Int)] -> Either [(String, Int)] [Int]
forall a b. a -> Either a b
Left ([(String, Int)] -> Either [(String, Int)] [Int])
-> [(String, Int)] -> Either [(String, Int)] [Int]
forall a b. (a -> b) -> a -> b
$ [(String, Int)] -> [(String, Int)]
forall a. Ord a => [a] -> [a]
sort [(String, Int)]
objectNodes,
        [Int] -> Either [(String, Int)] [Int]
forall a b. b -> Either a b
Right ([Int] -> Either [(String, Int)] [Int])
-> [Int] -> Either [(String, Int)] [Int]
forall a b. (a -> b) -> a -> b
$ [Int] -> [Int]
forall a. Ord a => [a] -> [a]
sort [Int]
decisionNodes,
        [Int] -> Either [(String, Int)] [Int]
forall a b. b -> Either a b
Right ([Int] -> Either [(String, Int)] [Int])
-> [Int] -> Either [(String, Int)] [Int]
forall a b. (a -> b) -> a -> b
$ [Int] -> [Int]
forall a. Ord a => [a] -> [a]
sort [Int]
mergeNodes,
        [Int] -> Either [(String, Int)] [Int]
forall a b. b -> Either a b
Right ([Int] -> Either [(String, Int)] [Int])
-> [Int] -> Either [(String, Int)] [Int]
forall a b. (a -> b) -> a -> b
$ [Int] -> [Int]
forall a. Ord a => [a] -> [a]
sort [Int]
forks,
        [Int] -> Either [(String, Int)] [Int]
forall a b. b -> Either a b
Right ([Int] -> Either [(String, Int)] [Int])
-> [Int] -> Either [(String, Int)] [Int]
forall a b. (a -> b) -> a -> b
$ [Int] -> [Int]
forall a. Ord a => [a] -> [a]
sort [Int]
joins,
        [Int] -> Either [(String, Int)] [Int]
forall a b. b -> Either a b
Right ([Int] -> Either [(String, Int)] [Int])
-> [Int] -> Either [(String, Int)] [Int]
forall a b. (a -> b) -> a -> b
$ [Int] -> [Int]
forall a. Ord a => [a] -> [a]
sort [Int]
initialNodes,
        [Int] -> Either [(String, Int)] [Int]
forall a b. b -> Either a b
Right ([Int] -> Either [(String, Int)] [Int])
-> [Int] -> Either [(String, Int)] [Int]
forall a b. (a -> b) -> a -> b
$ [Int] -> [Int]
forall a. Ord a => [a] -> [a]
sort [Int]
activityFinalNodes,
        [Int] -> Either [(String, Int)] [Int]
forall a b. b -> Either a b
Right ([Int] -> Either [(String, Int)] [Int])
-> [Int] -> Either [(String, Int)] [Int]
forall a b. (a -> b) -> a -> b
$ [Int] -> [Int]
forall a. Ord a => [a] -> [a]
sort [Int]
flowFinalNodes,
        [Int] -> Either [(String, Int)] [Int]
forall a b. b -> Either a b
Right ([Int] -> Either [(String, Int)] [Int])
-> [Int] -> Either [(String, Int)] [Int]
forall a b. (a -> b) -> a -> b
$ [Int] -> [Int]
forall a. Ord a => [a] -> [a]
sort [Int]
auxiliaryPetriNodes
        ]
  in [((Int, Either [(String, Int)] [Int]), Bool)]
-> Map (Int, Either [(String, Int)] [Int]) Bool
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([((Int, Either [(String, Int)] [Int]), Bool)]
 -> Map (Int, Either [(String, Int)] [Int]) Bool)
-> [((Int, Either [(String, Int)] [Int]), Bool)]
-> Map (Int, Either [(String, Int)] [Int]) Bool
forall a b. (a -> b) -> a -> b
$ (Int
 -> Either [(String, Int)] [Int]
 -> ((Int, Either [(String, Int)] [Int]), Bool))
-> [Int]
-> [Either [(String, Int)] [Int]]
-> [((Int, Either [(String, Int)] [Int]), Bool)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (((Int, Either [(String, Int)] [Int])
 -> ((Int, Either [(String, Int)] [Int]), Bool))
-> Int
-> Either [(String, Int)] [Int]
-> ((Int, Either [(String, Int)] [Int]), Bool)
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (,Bool
True)) [Int
1..] [Either [(String, Int)] [Int]]
xs

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

getMatchPetriTask
  :: (MonadAlloy m, MonadThrow m, RandomGen g)
  => MatchPetriConfig
  -> RandT g m MatchPetriInstance
getMatchPetriTask :: forall (m :: * -> *) g.
(MonadAlloy m, MonadThrow m, RandomGen g) =>
MatchPetriConfig -> RandT g m MatchPetriInstance
getMatchPetriTask MatchPetriConfig
config = do
  [AlloyInstance]
alloyInstances <- Maybe Integer -> Maybe Int -> String -> RandT g m [AlloyInstance]
forall (m :: * -> *).
MonadAlloy m =>
Maybe Integer -> Maybe Int -> String -> m [AlloyInstance]
getInstances
    (MatchPetriConfig -> Maybe Integer
maxInstances MatchPetriConfig
config)
    Maybe Int
forall a. Maybe a
Nothing
    (String -> RandT g m [AlloyInstance])
-> String -> RandT g m [AlloyInstance]
forall a b. (a -> b) -> a -> b
$ MatchPetriConfig -> String
matchPetriAlloy MatchPetriConfig
config
  [UMLActivityDiagram]
randomInstances <- [AlloyInstance] -> RandT g m [AlloyInstance]
forall (m :: * -> *) a. MonadRandom m => [a] -> m [a]
shuffleM [AlloyInstance]
alloyInstances RandT g m [AlloyInstance]
-> ([AlloyInstance] -> RandT g m [UMLActivityDiagram])
-> RandT g m [UMLActivityDiagram]
forall a b. RandT g m a -> (a -> RandT g m b) -> RandT g m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (AlloyInstance -> RandT g m UMLActivityDiagram)
-> [AlloyInstance] -> RandT g m [UMLActivityDiagram]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM AlloyInstance -> RandT g m UMLActivityDiagram
forall (m :: * -> *).
MonadThrow m =>
AlloyInstance -> m UMLActivityDiagram
parseInstance
  [UMLActivityDiagram]
activityDiagrams <- (UMLActivityDiagram -> RandT g m UMLActivityDiagram)
-> [UMLActivityDiagram] -> RandT g m [UMLActivityDiagram]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (((Map String String, UMLActivityDiagram) -> UMLActivityDiagram)
-> RandT g m (Map String String, UMLActivityDiagram)
-> RandT g m UMLActivityDiagram
forall a b. (a -> b) -> RandT g m a -> RandT g m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Map String String, UMLActivityDiagram) -> UMLActivityDiagram
forall a b. (a, b) -> b
snd (RandT g m (Map String String, UMLActivityDiagram)
 -> RandT g m UMLActivityDiagram)
-> (UMLActivityDiagram
    -> RandT g m (Map String String, UMLActivityDiagram))
-> UMLActivityDiagram
-> RandT g m UMLActivityDiagram
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UMLActivityDiagram
-> RandT g m (Map String String, UMLActivityDiagram)
forall (m :: * -> *).
MonadRandom m =>
UMLActivityDiagram -> m (Map String String, UMLActivityDiagram)
shuffleAdNames) [UMLActivityDiagram]
randomInstances
  (UMLActivityDiagram
ad, SimplePetriLike PetriKey
petri) <- [(UMLActivityDiagram, SimplePetriLike PetriKey)]
-> RandT g m (UMLActivityDiagram, SimplePetriLike PetriKey)
forall (m :: * -> *) a. MonadThrow m => [a] -> m a
getFirstInstance
        ([(UMLActivityDiagram, SimplePetriLike PetriKey)]
 -> RandT g m (UMLActivityDiagram, SimplePetriLike PetriKey))
-> [(UMLActivityDiagram, SimplePetriLike PetriKey)]
-> RandT g m (UMLActivityDiagram, SimplePetriLike PetriKey)
forall a b. (a -> b) -> a -> b
$ ((UMLActivityDiagram, SimplePetriLike PetriKey) -> Bool)
-> [(UMLActivityDiagram, SimplePetriLike PetriKey)]
-> [(UMLActivityDiagram, SimplePetriLike PetriKey)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> ((UMLActivityDiagram, SimplePetriLike PetriKey) -> Bool)
-> (UMLActivityDiagram, SimplePetriLike PetriKey)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SimplePetriLike PetriKey -> Bool
forall (p :: (* -> *) -> * -> *) (n :: * -> *) a.
(Net p n, Ord a) =>
p n a -> Bool
petriHasMultipleAutomorphisms (SimplePetriLike PetriKey -> Bool)
-> ((UMLActivityDiagram, SimplePetriLike PetriKey)
    -> SimplePetriLike PetriKey)
-> (UMLActivityDiagram, SimplePetriLike PetriKey)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UMLActivityDiagram, SimplePetriLike PetriKey)
-> SimplePetriLike PetriKey
forall a b. (a, b) -> b
snd)
        ([(UMLActivityDiagram, SimplePetriLike PetriKey)]
 -> [(UMLActivityDiagram, SimplePetriLike PetriKey)])
-> [(UMLActivityDiagram, SimplePetriLike PetriKey)]
-> [(UMLActivityDiagram, SimplePetriLike PetriKey)]
forall a b. (a -> b) -> a -> b
$ ((UMLActivityDiagram, SimplePetriLike PetriKey) -> Bool)
-> [(UMLActivityDiagram, SimplePetriLike PetriKey)]
-> [(UMLActivityDiagram, SimplePetriLike PetriKey)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Int, Maybe Int) -> SimplePetriLike PetriKey -> Bool
forall (p :: (* -> *) -> * -> *) (n :: * -> *) a.
(Net p n, Ord a) =>
(Int, Maybe Int) -> p n a -> Bool
checkPetriNodeCount (MatchPetriConfig -> (Int, Maybe Int)
countOfPetriNodesBounds MatchPetriConfig
config) (SimplePetriLike PetriKey -> Bool)
-> ((UMLActivityDiagram, SimplePetriLike PetriKey)
    -> SimplePetriLike PetriKey)
-> (UMLActivityDiagram, SimplePetriLike PetriKey)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UMLActivityDiagram, SimplePetriLike PetriKey)
-> SimplePetriLike PetriKey
forall a b. (a, b) -> b
snd)
        ([(UMLActivityDiagram, SimplePetriLike PetriKey)]
 -> [(UMLActivityDiagram, SimplePetriLike PetriKey)])
-> [(UMLActivityDiagram, SimplePetriLike PetriKey)]
-> [(UMLActivityDiagram, SimplePetriLike PetriKey)]
forall a b. (a -> b) -> a -> b
$ (UMLActivityDiagram
 -> (UMLActivityDiagram, SimplePetriLike PetriKey))
-> [UMLActivityDiagram]
-> [(UMLActivityDiagram, SimplePetriLike PetriKey)]
forall a b. (a -> b) -> [a] -> [b]
map ((UMLActivityDiagram -> SimplePetriLike PetriKey)
-> (UMLActivityDiagram, UMLActivityDiagram)
-> (UMLActivityDiagram, SimplePetriLike PetriKey)
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second UMLActivityDiagram -> SimplePetriLike PetriKey
forall (p :: (* -> *) -> * -> *) (n :: * -> *).
Net p n =>
UMLActivityDiagram -> p n PetriKey
convertToPetriNet ((UMLActivityDiagram, UMLActivityDiagram)
 -> (UMLActivityDiagram, SimplePetriLike PetriKey))
-> (UMLActivityDiagram -> (UMLActivityDiagram, UMLActivityDiagram))
-> UMLActivityDiagram
-> (UMLActivityDiagram, SimplePetriLike PetriKey)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UMLActivityDiagram -> (UMLActivityDiagram, UMLActivityDiagram)
forall a. a -> (a, a)
dupe) [UMLActivityDiagram]
activityDiagrams
  SimplePetriLike PetriKey
shuffledPetri <- (Map Int Int, SimplePetriLike PetriKey) -> SimplePetriLike PetriKey
forall a b. (a, b) -> b
snd ((Map Int Int, SimplePetriLike PetriKey)
 -> SimplePetriLike PetriKey)
-> RandT g m (Map Int Int, SimplePetriLike PetriKey)
-> RandT g m (SimplePetriLike PetriKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SimplePetriLike PetriKey
-> RandT g m (Map Int Int, SimplePetriLike PetriKey)
forall (m :: * -> *) (p :: (* -> *) -> * -> *) (n :: * -> *).
(MonadRandom m, Net p n) =>
p n PetriKey -> m (Map Int Int, p n PetriKey)
shufflePetri SimplePetriLike PetriKey
petri
  GraphvizCommand
layout <- MatchPetriConfig -> RandT g m GraphvizCommand
forall (m :: * -> *).
MonadRandom m =>
MatchPetriConfig -> m GraphvizCommand
pickRandomLayout MatchPetriConfig
config
  return $ MatchPetriInstance {
    $sel:activityDiagram:MatchPetriInstance :: UMLActivityDiagram
activityDiagram=UMLActivityDiagram
ad,
    $sel:petriNet:MatchPetriInstance :: SimplePetriLike PetriKey
petriNet = SimplePetriLike PetriKey
shuffledPetri,
    $sel:plantUMLConf:MatchPetriInstance :: PlantUmlConfig
plantUMLConf =
      PlantUmlConfig {
        suppressNodeNames :: Bool
suppressNodeNames = Bool
False,
        suppressBranchConditions :: Bool
suppressBranchConditions = MatchPetriConfig -> Bool
hideBranchConditions MatchPetriConfig
config
      },
    $sel:petriDrawConf:MatchPetriInstance :: DrawSettings
petriDrawConf =
      DrawSettings {
        $sel:withPlaceNames:DrawSettings :: Bool
withPlaceNames = Bool
True,
        $sel:withSvgHighlighting:DrawSettings :: Bool
withSvgHighlighting = MatchPetriConfig -> Bool
petriSvgHighlighting MatchPetriConfig
config,
        $sel:withTransitionNames:DrawSettings :: Bool
withTransitionNames = Bool
True,
        $sel:with1Weights:DrawSettings :: Bool
with1Weights = Bool
False,
        $sel:withGraphvizCommand:DrawSettings :: GraphvizCommand
withGraphvizCommand = GraphvizCommand
layout
      },
    $sel:showSolution:MatchPetriInstance :: Bool
showSolution = MatchPetriConfig -> Bool
printSolution MatchPetriConfig
config,
    $sel:addText:MatchPetriInstance :: Maybe (Map Language String)
addText = MatchPetriConfig -> Maybe (Map Language String)
extraText MatchPetriConfig
config
  }

defaultMatchPetriInstance :: MatchPetriInstance
defaultMatchPetriInstance :: MatchPetriInstance
defaultMatchPetriInstance = MatchPetriInstance
  { $sel:activityDiagram:MatchPetriInstance :: UMLActivityDiagram
activityDiagram = UMLActivityDiagram
    { nodes :: [AdNode]
nodes =
      [ AdActionNode
        { label :: Int
label = Int
1 , name :: String
name = String
"C" }
      , AdActionNode
        { label :: Int
label = Int
2
        , name :: String
name = String
"H" }
      , AdActionNode
        { label :: Int
label = Int
3
        , name :: String
name = String
"A" }
      , AdActionNode
        { label :: Int
label = Int
4
        , name :: String
name = String
"E" }
      , AdObjectNode
        { label :: Int
label = Int
5
        , name :: String
name = String
"F" }
      , AdObjectNode
        { label :: Int
label = Int
6
        , name :: String
name = String
"D" }
      , AdObjectNode
        { label :: Int
label = Int
7
        , name :: String
name = String
"G" }
      , AdObjectNode
        { label :: Int
label = Int
8
        , name :: String
name = String
"B" }
      , AdDecisionNode
        { label :: Int
label = Int
9 }
      , AdDecisionNode
        { label :: Int
label = Int
10 }
      , AdMergeNode
        { label :: Int
label = Int
11 }
      , AdMergeNode
        { label :: Int
label = Int
12 }
      , AdForkNode
        { label :: Int
label = Int
13 }
      , AdJoinNode
        { label :: Int
label = Int
14 }
      , AdActivityFinalNode
        { label :: Int
label = Int
15 }
      , AdFlowFinalNode
        { label :: Int
label = Int
16 }
      , AdInitialNode
        { label :: Int
label = Int
17 } ]
    , connections :: [AdConnection]
connections =
      [ AdConnection
        { from :: Int
from = Int
1
        , to :: Int
to = Int
12
        , guard :: String
guard = String
"" }
      , AdConnection
        { from :: Int
from = Int
2
        , to :: Int
to = Int
6
        , guard :: String
guard = String
"" }
      , AdConnection
        { from :: Int
from = Int
3
        , to :: Int
to = Int
4
        , guard :: String
guard = String
"" }
      , AdConnection
        { from :: Int
from = Int
4
        , to :: Int
to = Int
13
        , guard :: String
guard = String
"" }
      , AdConnection
        { from :: Int
from = Int
5
        , to :: Int
to = Int
12
        , guard :: String
guard = String
"" }
      , AdConnection
        { from :: Int
from = Int
6
        , to :: Int
to = Int
14
        , guard :: String
guard = String
"" }
      , AdConnection
        { from :: Int
from = Int
7
        , to :: Int
to = Int
15
        , guard :: String
guard = String
"" }
      , AdConnection
        { from :: Int
from = Int
8
        , to :: Int
to = Int
7
        , guard :: String
guard = String
"" }
      , AdConnection
        { from :: Int
from = Int
9
        , to :: Int
to = Int
11
        , guard :: String
guard = String
"a" }
      , AdConnection
        { from :: Int
from = Int
9
        , to :: Int
to = Int
14
        , guard :: String
guard = String
"b" }
      , AdConnection
        { from :: Int
from = Int
10
        , to :: Int
to = Int
1
        , guard :: String
guard = String
"b" }
      , AdConnection
        { from :: Int
from = Int
10
        , to :: Int
to = Int
5
        , guard :: String
guard = String
"c" }
      , AdConnection
        { from :: Int
from = Int
11
        , to :: Int
to = Int
10
        , guard :: String
guard = String
"" }
      , AdConnection
        { from :: Int
from = Int
12
        , to :: Int
to = Int
9
        , guard :: String
guard = String
"" }
      , AdConnection
        { from :: Int
from = Int
13
        , to :: Int
to = Int
2
        , guard :: String
guard = String
"" }
      , AdConnection
        { from :: Int
from = Int
13
        , to :: Int
to = Int
8
        , guard :: String
guard = String
"" }
      , AdConnection
        { from :: Int
from = Int
13
        , to :: Int
to = Int
11
        , guard :: String
guard = String
"" }
      , AdConnection
        { from :: Int
from = Int
14
        , to :: Int
to = Int
16
        , guard :: String
guard = String
"" }
      , AdConnection
        { from :: Int
from = Int
17
        , to :: Int
to = Int
3
        , guard :: String
guard = String
"" } ] }
  , $sel:petriNet:MatchPetriInstance :: SimplePetriLike PetriKey
petriNet = PetriLike
    { $sel:allNodes:PetriLike :: Map PetriKey (SimpleNode PetriKey)
allNodes = [(PetriKey, SimpleNode PetriKey)]
-> Map PetriKey (SimpleNode PetriKey)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
      [
        ( NormalPetriNode
          { $sel:label:AuxiliaryPetriNode :: Int
label = Int
1
          , $sel:sourceNode:AuxiliaryPetriNode :: AdNode
sourceNode = AdDecisionNode
            { label :: Int
label = Int
10 } }
        , SimplePlace
          { $sel:initial:SimplePlace :: Int
initial = Int
0
          , $sel:flowOut:SimplePlace :: Map PetriKey Int
flowOut = [(PetriKey, Int)] -> Map PetriKey Int
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
            [
              ( NormalPetriNode
                { $sel:label:AuxiliaryPetriNode :: Int
label = Int
7
                , $sel:sourceNode:AuxiliaryPetriNode :: AdNode
sourceNode = AdActionNode
                  { label :: Int
label = Int
1
                  , name :: String
name = String
"C" } }
              , Int
1 )
            ,
              ( AuxiliaryPetriNode
                { $sel:label:AuxiliaryPetriNode :: Int
label = Int
14 }
              , Int
1 ) ] } )
      ,
        ( NormalPetriNode
          { $sel:label:AuxiliaryPetriNode :: Int
label = Int
2
          , $sel:sourceNode:AuxiliaryPetriNode :: AdNode
sourceNode = AdJoinNode
            { label :: Int
label = Int
14 } }
        , SimpleTransition
          { $sel:flowOut:SimplePlace :: Map PetriKey Int
flowOut = Map PetriKey Int
forall k a. Map k a
M.empty } )
      ,
        ( NormalPetriNode
          { $sel:label:AuxiliaryPetriNode :: Int
label = Int
3
          , $sel:sourceNode:AuxiliaryPetriNode :: AdNode
sourceNode = AdInitialNode
            { label :: Int
label = Int
17 } }
        , SimplePlace
          { $sel:initial:SimplePlace :: Int
initial = Int
1
          , $sel:flowOut:SimplePlace :: Map PetriKey Int
flowOut = [(PetriKey, Int)] -> Map PetriKey Int
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
            [
              ( NormalPetriNode
                { $sel:label:AuxiliaryPetriNode :: Int
label = Int
19
                , $sel:sourceNode:AuxiliaryPetriNode :: AdNode
sourceNode = AdActionNode
                  { label :: Int
label = Int
3
                  , name :: String
name = String
"A" } }
              , Int
1 ) ] } )
      ,
        ( FinalPetriNode
          { $sel:label:AuxiliaryPetriNode :: Int
label = Int
4, $sel:sourceNode:AuxiliaryPetriNode :: AdNode
sourceNode = AdActivityFinalNode {label :: Int
label = Int
15} }
        , SimpleTransition
          { $sel:flowOut:SimplePlace :: Map PetriKey Int
flowOut = Map PetriKey Int
forall k a. Map k a
M.empty } )
      ,
        ( NormalPetriNode
          { $sel:label:AuxiliaryPetriNode :: Int
label = Int
5
          , $sel:sourceNode:AuxiliaryPetriNode :: AdNode
sourceNode = AdMergeNode
            { label :: Int
label = Int
11 } }
        , SimplePlace
          { $sel:initial:SimplePlace :: Int
initial = Int
0
          , $sel:flowOut:SimplePlace :: Map PetriKey Int
flowOut = [(PetriKey, Int)] -> Map PetriKey Int
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
            [
              ( AuxiliaryPetriNode
                { $sel:label:AuxiliaryPetriNode :: Int
label = Int
21 }
              , Int
1 ) ] } )
      ,
        ( NormalPetriNode
          { $sel:label:AuxiliaryPetriNode :: Int
label = Int
6
          , $sel:sourceNode:AuxiliaryPetriNode :: AdNode
sourceNode = AdObjectNode
            { label :: Int
label = Int
6
            , name :: String
name = String
"D" } }
        , SimplePlace
          { $sel:initial:SimplePlace :: Int
initial = Int
0
          , $sel:flowOut:SimplePlace :: Map PetriKey Int
flowOut = [(PetriKey, Int)] -> Map PetriKey Int
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
            [
              ( NormalPetriNode
                { $sel:label:AuxiliaryPetriNode :: Int
label = Int
2
                , $sel:sourceNode:AuxiliaryPetriNode :: AdNode
sourceNode = AdJoinNode
                  { label :: Int
label = Int
14 } }
              , Int
1 ) ] } )
      ,
        ( NormalPetriNode
          { $sel:label:AuxiliaryPetriNode :: Int
label = Int
7
          , $sel:sourceNode:AuxiliaryPetriNode :: AdNode
sourceNode = AdActionNode
            { label :: Int
label = Int
1
            , name :: String
name = String
"C" } }
        , SimpleTransition
          { $sel:flowOut:SimplePlace :: Map PetriKey Int
flowOut = [(PetriKey, Int)] -> Map PetriKey Int
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
            [
              ( NormalPetriNode
                { $sel:label:AuxiliaryPetriNode :: Int
label = Int
13
                , $sel:sourceNode:AuxiliaryPetriNode :: AdNode
sourceNode = AdMergeNode
                  { label :: Int
label = Int
12 } }
              , Int
1 ) ] } )
      ,
        ( AuxiliaryPetriNode
          { $sel:label:AuxiliaryPetriNode :: Int
label = Int
8 }
        , SimpleTransition
          { $sel:flowOut:SimplePlace :: Map PetriKey Int
flowOut = [(PetriKey, Int)] -> Map PetriKey Int
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
            [
              ( NormalPetriNode
                { $sel:label:AuxiliaryPetriNode :: Int
label = Int
13
                , $sel:sourceNode:AuxiliaryPetriNode :: AdNode
sourceNode = AdMergeNode
                  { label :: Int
label = Int
12 } }
              , Int
1 ) ] } )
      ,
        ( NormalPetriNode
          { $sel:label:AuxiliaryPetriNode :: Int
label = Int
9
          , $sel:sourceNode:AuxiliaryPetriNode :: AdNode
sourceNode = AdObjectNode
            { label :: Int
label = Int
7
            , name :: String
name = String
"G" } }
        , SimplePlace
          { $sel:initial:SimplePlace :: Int
initial = Int
0
          , $sel:flowOut:SimplePlace :: Map PetriKey Int
flowOut = [(PetriKey, Int)] -> Map PetriKey Int
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
            [
              ( FinalPetriNode
                { $sel:label:AuxiliaryPetriNode :: Int
label = Int
4, $sel:sourceNode:AuxiliaryPetriNode :: AdNode
sourceNode = AdActivityFinalNode {label :: Int
label = Int
15} }
              , Int
1 ) ] } )
      ,
        ( NormalPetriNode
          { $sel:label:AuxiliaryPetriNode :: Int
label = Int
10
          , $sel:sourceNode:AuxiliaryPetriNode :: AdNode
sourceNode = AdActionNode
            { label :: Int
label = Int
2
            , name :: String
name = String
"H" } }
        , SimpleTransition
          { $sel:flowOut:SimplePlace :: Map PetriKey Int
flowOut = [(PetriKey, Int)] -> Map PetriKey Int
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
            [
              ( NormalPetriNode
                { $sel:label:AuxiliaryPetriNode :: Int
label = Int
6
                , $sel:sourceNode:AuxiliaryPetriNode :: AdNode
sourceNode = AdObjectNode
                  { label :: Int
label = Int
6
                  , name :: String
name = String
"D" } }
              , Int
1 ) ] } )
      ,
        ( AuxiliaryPetriNode
          { $sel:label:AuxiliaryPetriNode :: Int
label = Int
11 }
        , SimplePlace
          { $sel:initial:SimplePlace :: Int
initial = Int
0
          , $sel:flowOut:SimplePlace :: Map PetriKey Int
flowOut = [(PetriKey, Int)] -> Map PetriKey Int
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
            [
              ( NormalPetriNode
                { $sel:label:AuxiliaryPetriNode :: Int
label = Int
12
                , $sel:sourceNode:AuxiliaryPetriNode :: AdNode
sourceNode = AdForkNode
                  { label :: Int
label = Int
13 } }
              , Int
1 ) ] } )
      ,
        ( NormalPetriNode
          { $sel:label:AuxiliaryPetriNode :: Int
label = Int
12
          , $sel:sourceNode:AuxiliaryPetriNode :: AdNode
sourceNode = AdForkNode
            { label :: Int
label = Int
13 } }
        , SimpleTransition
          { $sel:flowOut:SimplePlace :: Map PetriKey Int
flowOut = [(PetriKey, Int)] -> Map PetriKey Int
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
            [
              ( NormalPetriNode
                { $sel:label:AuxiliaryPetriNode :: Int
label = Int
5
                , $sel:sourceNode:AuxiliaryPetriNode :: AdNode
sourceNode = AdMergeNode
                  { label :: Int
label = Int
11 } }
              , Int
1 )
            ,
              ( AuxiliaryPetriNode
                { $sel:label:AuxiliaryPetriNode :: Int
label = Int
15 }
              , Int
1 )
            ,
              ( NormalPetriNode
                { $sel:label:AuxiliaryPetriNode :: Int
label = Int
22
                , $sel:sourceNode:AuxiliaryPetriNode :: AdNode
sourceNode = AdObjectNode
                  { label :: Int
label = Int
8
                  , name :: String
name = String
"B" } }
              , Int
1 ) ] } )
      ,
        ( NormalPetriNode
          { $sel:label:AuxiliaryPetriNode :: Int
label = Int
13
          , $sel:sourceNode:AuxiliaryPetriNode :: AdNode
sourceNode = AdMergeNode
            { label :: Int
label = Int
12 } }
        , SimplePlace
          { $sel:initial:SimplePlace :: Int
initial = Int
0
          , $sel:flowOut:SimplePlace :: Map PetriKey Int
flowOut = [(PetriKey, Int)] -> Map PetriKey Int
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
            [
              ( AuxiliaryPetriNode
                { $sel:label:AuxiliaryPetriNode :: Int
label = Int
23 }
              , Int
1 ) ] } )
      ,
        ( AuxiliaryPetriNode
          { $sel:label:AuxiliaryPetriNode :: Int
label = Int
14 }
        , SimpleTransition
          { $sel:flowOut:SimplePlace :: Map PetriKey Int
flowOut = [(PetriKey, Int)] -> Map PetriKey Int
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
            [
              ( NormalPetriNode
                { $sel:label:AuxiliaryPetriNode :: Int
label = Int
25
                , $sel:sourceNode:AuxiliaryPetriNode :: AdNode
sourceNode = AdObjectNode
                  { label :: Int
label = Int
5
                  , name :: String
name = String
"F" } }
              , Int
1 ) ] } )
      ,
        ( AuxiliaryPetriNode
          { $sel:label:AuxiliaryPetriNode :: Int
label = Int
15 }
        , SimplePlace
          { $sel:initial:SimplePlace :: Int
initial = Int
0
          , $sel:flowOut:SimplePlace :: Map PetriKey Int
flowOut = [(PetriKey, Int)] -> Map PetriKey Int
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
            [
              ( NormalPetriNode
                { $sel:label:AuxiliaryPetriNode :: Int
label = Int
10
                , $sel:sourceNode:AuxiliaryPetriNode :: AdNode
sourceNode = AdActionNode
                  { label :: Int
label = Int
2
                  , name :: String
name = String
"H" } }
              , Int
1 ) ] } )
      ,
        ( NormalPetriNode
          { $sel:label:AuxiliaryPetriNode :: Int
label = Int
16
          , $sel:sourceNode:AuxiliaryPetriNode :: AdNode
sourceNode = AdActionNode
            { label :: Int
label = Int
4
            , name :: String
name = String
"E" } }
        , SimpleTransition
          { $sel:flowOut:SimplePlace :: Map PetriKey Int
flowOut = [(PetriKey, Int)] -> Map PetriKey Int
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
            [
              ( AuxiliaryPetriNode
                { $sel:label:AuxiliaryPetriNode :: Int
label = Int
11 }
              , Int
1 ) ] } )
      ,
        ( AuxiliaryPetriNode
          { $sel:label:AuxiliaryPetriNode :: Int
label = Int
17 }
        , SimpleTransition
          { $sel:flowOut:SimplePlace :: Map PetriKey Int
flowOut = [(PetriKey, Int)] -> Map PetriKey Int
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
            [
              ( NormalPetriNode
                { $sel:label:AuxiliaryPetriNode :: Int
label = Int
9
                , $sel:sourceNode:AuxiliaryPetriNode :: AdNode
sourceNode = AdObjectNode
                  { label :: Int
label = Int
7
                  , name :: String
name = String
"G" } }
              , Int
1 ) ] } )
      ,
        ( AuxiliaryPetriNode
          { $sel:label:AuxiliaryPetriNode :: Int
label = Int
18 }
        , SimpleTransition
          { $sel:flowOut:SimplePlace :: Map PetriKey Int
flowOut = [(PetriKey, Int)] -> Map PetriKey Int
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
            [
              ( NormalPetriNode
                { $sel:label:AuxiliaryPetriNode :: Int
label = Int
5
                , $sel:sourceNode:AuxiliaryPetriNode :: AdNode
sourceNode = AdMergeNode
                  { label :: Int
label = Int
11 } }
              , Int
1 ) ] } )
      ,
        ( NormalPetriNode
          { $sel:label:AuxiliaryPetriNode :: Int
label = Int
19
          , $sel:sourceNode:AuxiliaryPetriNode :: AdNode
sourceNode = AdActionNode
            { label :: Int
label = Int
3
            , name :: String
name = String
"A" } }
        , SimpleTransition
          { $sel:flowOut:SimplePlace :: Map PetriKey Int
flowOut = [(PetriKey, Int)] -> Map PetriKey Int
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
            [
              ( AuxiliaryPetriNode
                { $sel:label:AuxiliaryPetriNode :: Int
label = Int
20 }
              , Int
1 ) ] } )
      ,
        ( AuxiliaryPetriNode
          { $sel:label:AuxiliaryPetriNode :: Int
label = Int
20 }
        , SimplePlace
          { $sel:initial:SimplePlace :: Int
initial = Int
0
          , $sel:flowOut:SimplePlace :: Map PetriKey Int
flowOut = [(PetriKey, Int)] -> Map PetriKey Int
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
            [
              ( NormalPetriNode
                { $sel:label:AuxiliaryPetriNode :: Int
label = Int
16
                , $sel:sourceNode:AuxiliaryPetriNode :: AdNode
sourceNode = AdActionNode
                  { label :: Int
label = Int
4
                  , name :: String
name = String
"E" } }
              , Int
1 ) ] } )
      ,
        ( AuxiliaryPetriNode
          { $sel:label:AuxiliaryPetriNode :: Int
label = Int
21 }
        , SimpleTransition
          { $sel:flowOut:SimplePlace :: Map PetriKey Int
flowOut = [(PetriKey, Int)] -> Map PetriKey Int
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
            [
              ( NormalPetriNode
                { $sel:label:AuxiliaryPetriNode :: Int
label = Int
1
                , $sel:sourceNode:AuxiliaryPetriNode :: AdNode
sourceNode = AdDecisionNode
                  { label :: Int
label = Int
10 } }
              , Int
1 ) ] } )
      ,
        ( NormalPetriNode
          { $sel:label:AuxiliaryPetriNode :: Int
label = Int
22
          , $sel:sourceNode:AuxiliaryPetriNode :: AdNode
sourceNode = AdObjectNode
            { label :: Int
label = Int
8
            , name :: String
name = String
"B" } }
        , SimplePlace
          { $sel:initial:SimplePlace :: Int
initial = Int
0
          , $sel:flowOut:SimplePlace :: Map PetriKey Int
flowOut = [(PetriKey, Int)] -> Map PetriKey Int
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
            [
              ( AuxiliaryPetriNode
                { $sel:label:AuxiliaryPetriNode :: Int
label = Int
17 }
              , Int
1 ) ] } )
      ,
        ( AuxiliaryPetriNode
          { $sel:label:AuxiliaryPetriNode :: Int
label = Int
23 }
        , SimpleTransition
          { $sel:flowOut:SimplePlace :: Map PetriKey Int
flowOut = [(PetriKey, Int)] -> Map PetriKey Int
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
            [
              ( NormalPetriNode
                { $sel:label:AuxiliaryPetriNode :: Int
label = Int
24
                , $sel:sourceNode:AuxiliaryPetriNode :: AdNode
sourceNode = AdDecisionNode
                  { label :: Int
label = Int
9 } }
              , Int
1 ) ] } )
      ,
        ( NormalPetriNode
          { $sel:label:AuxiliaryPetriNode :: Int
label = Int
24
          , $sel:sourceNode:AuxiliaryPetriNode :: AdNode
sourceNode = AdDecisionNode
            { label :: Int
label = Int
9 } }
        , SimplePlace
          { $sel:initial:SimplePlace :: Int
initial = Int
0
          , $sel:flowOut:SimplePlace :: Map PetriKey Int
flowOut = [(PetriKey, Int)] -> Map PetriKey Int
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
            [
              ( NormalPetriNode
                { $sel:label:AuxiliaryPetriNode :: Int
label = Int
2
                , $sel:sourceNode:AuxiliaryPetriNode :: AdNode
sourceNode = AdJoinNode
                  { label :: Int
label = Int
14 } }
              , Int
1 )
            ,
              ( AuxiliaryPetriNode
                { $sel:label:AuxiliaryPetriNode :: Int
label = Int
18 }
              , Int
1 ) ] } )
      ,
        ( NormalPetriNode
          { $sel:label:AuxiliaryPetriNode :: Int
label = Int
25
          , $sel:sourceNode:AuxiliaryPetriNode :: AdNode
sourceNode = AdObjectNode
            { label :: Int
label = Int
5
            , name :: String
name = String
"F" } }
        , SimplePlace
          { $sel:initial:SimplePlace :: Int
initial = Int
0
          , $sel:flowOut:SimplePlace :: Map PetriKey Int
flowOut = [(PetriKey, Int)] -> Map PetriKey Int
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
            [
              ( AuxiliaryPetriNode
                { $sel:label:AuxiliaryPetriNode :: Int
label = Int
8 }
              , Int
1 ) ] } ) ] }
  , $sel:plantUMLConf:MatchPetriInstance :: PlantUmlConfig
plantUMLConf = PlantUmlConfig
defaultPlantUmlConfig
  , $sel:petriDrawConf:MatchPetriInstance :: DrawSettings
petriDrawConf =
    DrawSettings {
      $sel:withPlaceNames:DrawSettings :: Bool
withPlaceNames = Bool
True,
      $sel:withSvgHighlighting:DrawSettings :: Bool
withSvgHighlighting = Bool
True,
      $sel:withTransitionNames:DrawSettings :: Bool
withTransitionNames = Bool
True,
      $sel:with1Weights:DrawSettings :: Bool
with1Weights = Bool
False,
      $sel:withGraphvizCommand:DrawSettings :: GraphvizCommand
withGraphvizCommand = GraphvizCommand
Dot
    },
  $sel:showSolution:MatchPetriInstance :: Bool
showSolution = Bool
False,
  $sel:addText:MatchPetriInstance :: Maybe (Map Language String)
addText = Maybe (Map Language String)
forall a. Maybe a
Nothing
  }