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

module Modelling.ActivityDiagram.SelectPetri (
  SelectPetriInstance(..),
  SelectPetriConfig(..),
  SelectPetriSolution(..),
  defaultSelectPetriConfig,
  checkSelectPetriConfig,
  checkPetriInstance,
  selectPetriAlloy,
  selectPetriNet,
  selectPetriNetWithMatchingNet,
  selectPetriTask,
  selectPetriSyntax,
  selectPetriEvaluation,
  selectPetriSolution,
  selectPetri,
  defaultSelectPetriInstance
  ) where

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 qualified Data.Map as M (empty, size, fromList, toList, keys, map, filter)
import qualified Modelling.ActivityDiagram.Datatype as Ad (AdNode(label))
import qualified Modelling.ActivityDiagram.PetriNet as PK (PetriKey (label))

import Modelling.ActivityDiagram.Alloy  (adConfigToAlloy, modulePetriNet)
import Modelling.ActivityDiagram.Auxiliary.PetriValidation (
  validatePetriConfig,
  )
import Modelling.ActivityDiagram.Auxiliary.Util (
  finalNodesAdvice,
  )
import qualified Modelling.ActivityDiagram.Config as Config (
  AdConfig(activityFinalNodes,flowFinalNodes),
  )
import Modelling.ActivityDiagram.Config (
  AdConfig,
  checkAdConfig,
  defaultAdConfig,
  )
import Modelling.ActivityDiagram.Datatype (
  AdConnection (..),
  AdNode (..),
  UMLActivityDiagram (..),
  isActivityFinalNode,
  isFlowFinalNode,
  isInitialNode,
  )
import Modelling.ActivityDiagram.Instance (parseInstance)
import Modelling.ActivityDiagram.Isomorphism (isPetriIsomorphic)
import Modelling.ActivityDiagram.PetriNet (PetriKey (..), convertToPetriNet)
import Modelling.ActivityDiagram.PlantUMLConverter (
  PlantUmlConfig (..),
  defaultPlantUmlConfig,
  drawAdToFile,
  )
import Modelling.ActivityDiagram.Shuffle (shuffleAdNames, shufflePetri)

import Modelling.Auxiliary.Common (
  TaskGenerationException (NoInstanceAvailable),
  oneOf,
  weightedShuffle,
  )
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 (unless, when)
import Control.Monad.Catch              (MonadThrow, throwM)
import Control.Monad.Extra (loopM, firstJustM)
import Control.OutputCapable.Blocks (
  ArticleToUse (DefiniteArticle),
  GenericOutputCapable (..),
  LangM,
  Language,
  OutputCapable,
  ($=<<),
  english,
  german,
  reRefuseLangM,
  translate,
  translations,
  singleChoice,
  singleChoiceSyntax,
  )
import Control.Monad.Random (
  MonadRandom,
  RandT,
  RandomGen,
  evalRandT,
  mkStdGen
  )
import Data.Bifunctor (second)
import Data.List (find, genericLength)
import Data.Map (Map)
import Data.Maybe (fromJust)
import Data.Graph.Inductive (Gr, mkGraph, lab, level)
import Data.GraphViz.Commands (GraphvizCommand(..))
import Data.String.Interpolate          (i)
import Data.Traversable                 (for)
import GHC.Generics (Generic)
import System.Random.Shuffle (shuffleM)
import Modelling.ActivityDiagram.MatchPetri (
  MatchPetriSolution (..),
  mapTypesToLabels,
  )


data SelectPetriInstance = SelectPetriInstance {
  SelectPetriInstance -> UMLActivityDiagram
activityDiagram :: UMLActivityDiagram,
  SelectPetriInstance -> PlantUmlConfig
plantUMLConf :: PlantUmlConfig,
  SelectPetriInstance -> DrawSettings
petriDrawConf :: DrawSettings,
  SelectPetriInstance -> Map Int (Bool, SimplePetriLike PetriKey)
petriNets :: Map Int (Bool, SimplePetriLike PetriKey),
  SelectPetriInstance -> Bool
showSolution :: Bool,
  SelectPetriInstance -> Maybe (Map Language String)
addText :: Maybe (Map Language String)
} deriving ((forall x. SelectPetriInstance -> Rep SelectPetriInstance x)
-> (forall x. Rep SelectPetriInstance x -> SelectPetriInstance)
-> Generic SelectPetriInstance
forall x. Rep SelectPetriInstance x -> SelectPetriInstance
forall x. SelectPetriInstance -> Rep SelectPetriInstance x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SelectPetriInstance -> Rep SelectPetriInstance x
from :: forall x. SelectPetriInstance -> Rep SelectPetriInstance x
$cto :: forall x. Rep SelectPetriInstance x -> SelectPetriInstance
to :: forall x. Rep SelectPetriInstance x -> SelectPetriInstance
Generic, Int -> SelectPetriInstance -> ShowS
[SelectPetriInstance] -> ShowS
SelectPetriInstance -> String
(Int -> SelectPetriInstance -> ShowS)
-> (SelectPetriInstance -> String)
-> ([SelectPetriInstance] -> ShowS)
-> Show SelectPetriInstance
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SelectPetriInstance -> ShowS
showsPrec :: Int -> SelectPetriInstance -> ShowS
$cshow :: SelectPetriInstance -> String
show :: SelectPetriInstance -> String
$cshowList :: [SelectPetriInstance] -> ShowS
showList :: [SelectPetriInstance] -> ShowS
Show)

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

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

defaultSelectPetriConfig :: SelectPetriConfig
defaultSelectPetriConfig :: SelectPetriConfig
defaultSelectPetriConfig = SelectPetriConfig {
  $sel:adConfig:SelectPetriConfig :: AdConfig
adConfig = AdConfig
defaultAdConfig
    { activityFinalNodes :: Int
Config.activityFinalNodes = Int
0
    , flowFinalNodes :: Int
Config.flowFinalNodes = Int
2
    },
  $sel:countOfPetriNodesBounds:SelectPetriConfig :: (Int, Maybe Int)
countOfPetriNodesBounds = (Int
0, Maybe Int
forall a. Maybe a
Nothing),
  $sel:maxInstances:SelectPetriConfig :: Maybe Integer
maxInstances = Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
50,
  $sel:hideNodeNames:SelectPetriConfig :: Bool
hideNodeNames = Bool
False,
  $sel:hideBranchConditions:SelectPetriConfig :: Bool
hideBranchConditions = Bool
False,
  $sel:hidePetriNodeLabels:SelectPetriConfig :: Bool
hidePetriNodeLabels = Bool
False,
  $sel:petriLayout:SelectPetriConfig :: [GraphvizCommand]
petriLayout = [GraphvizCommand
Dot],
  $sel:petriSvgHighlighting:SelectPetriConfig :: Bool
petriSvgHighlighting = Bool
True,
  $sel:numberOfWrongAnswers:SelectPetriConfig :: Int
numberOfWrongAnswers = Int
2,
  $sel:numberOfModifications:SelectPetriConfig :: Int
numberOfModifications = Int
3,
  $sel:modifyAtMid:SelectPetriConfig :: Bool
modifyAtMid = Bool
True,
  $sel:auxiliaryPetriNodeAbsent:SelectPetriConfig :: Maybe Bool
auxiliaryPetriNodeAbsent = Maybe Bool
forall a. Maybe a
Nothing,
  $sel:presenceOfSinkTransitionsForFinals:SelectPetriConfig :: Maybe Bool
presenceOfSinkTransitionsForFinals = Maybe Bool
forall a. Maybe a
Nothing,
  $sel:withActivityFinalInForkBlocks:SelectPetriConfig :: Maybe Bool
withActivityFinalInForkBlocks = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False,
  $sel:printSolution:SelectPetriConfig :: Bool
printSolution = Bool
False,
  $sel:extraText:SelectPetriConfig :: Maybe (Map Language String)
extraText = Maybe (Map Language String)
forall a. Maybe a
Nothing
}

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

checkSelectPetriConfig' :: SelectPetriConfig -> Maybe String
checkSelectPetriConfig' :: SelectPetriConfig -> Maybe String
checkSelectPetriConfig' SelectPetriConfig {
    AdConfig
$sel:adConfig:SelectPetriConfig :: SelectPetriConfig -> AdConfig
adConfig :: AdConfig
adConfig,
    (Int, Maybe Int)
$sel:countOfPetriNodesBounds:SelectPetriConfig :: SelectPetriConfig -> (Int, Maybe Int)
countOfPetriNodesBounds :: (Int, Maybe Int)
countOfPetriNodesBounds,
    Maybe Integer
$sel:maxInstances:SelectPetriConfig :: SelectPetriConfig -> Maybe Integer
maxInstances :: Maybe Integer
maxInstances,
    [GraphvizCommand]
$sel:petriLayout:SelectPetriConfig :: SelectPetriConfig -> [GraphvizCommand]
petriLayout :: [GraphvizCommand]
petriLayout,
    Int
$sel:numberOfWrongAnswers:SelectPetriConfig :: SelectPetriConfig -> Int
numberOfWrongAnswers :: Int
numberOfWrongAnswers,
    Int
$sel:numberOfModifications:SelectPetriConfig :: SelectPetriConfig -> Int
numberOfModifications :: Int
numberOfModifications,
    Maybe Bool
$sel:auxiliaryPetriNodeAbsent:SelectPetriConfig :: SelectPetriConfig -> Maybe Bool
auxiliaryPetriNodeAbsent :: Maybe Bool
auxiliaryPetriNodeAbsent,
    Maybe Bool
$sel:presenceOfSinkTransitionsForFinals:SelectPetriConfig :: SelectPetriConfig -> Maybe Bool
presenceOfSinkTransitionsForFinals :: Maybe Bool
presenceOfSinkTransitionsForFinals,
    Maybe Bool
$sel:withActivityFinalInForkBlocks:SelectPetriConfig :: SelectPetriConfig -> Maybe Bool
withActivityFinalInForkBlocks :: Maybe Bool
withActivityFinalInForkBlocks
  } = Int -> Int -> Maybe String
validateSelectPetriSpecific Int
numberOfWrongAnswers Int
numberOfModifications
    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
<|> 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

-- | Additional validation specific to SelectPetri configurations
validateSelectPetriSpecific
  :: Int  -- numberOfWrongAnswers
  -> Int  -- numberOfModifications
  -> Maybe String
validateSelectPetriSpecific :: Int -> Int -> Maybe String
validateSelectPetriSpecific Int
numberOfWrongAnswers Int
numberOfModifications
  | Int
numberOfWrongAnswers Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1
    = String -> Maybe String
forall a. a -> Maybe a
Just String
"The parameter 'numberOfWrongAnswers' must be set to a positive value"
  | Int
numberOfModifications Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1
    = String -> Maybe String
forall a. a -> Maybe a
Just String
"The parameter 'numberOfModifications' must be set to a positive value"
  | Bool
otherwise
    = Maybe String
forall a. Maybe a
Nothing

selectPetriAlloy :: SelectPetriConfig -> String
selectPetriAlloy :: SelectPetriConfig -> String
selectPetriAlloy SelectPetriConfig {
  AdConfig
$sel:adConfig:SelectPetriConfig :: SelectPetriConfig -> AdConfig
adConfig :: AdConfig
adConfig,
  Maybe Bool
$sel:auxiliaryPetriNodeAbsent:SelectPetriConfig :: SelectPetriConfig -> Maybe Bool
auxiliaryPetriNodeAbsent :: Maybe Bool
auxiliaryPetriNodeAbsent,
  Maybe Bool
$sel:presenceOfSinkTransitionsForFinals:SelectPetriConfig :: SelectPetriConfig -> Maybe Bool
presenceOfSinkTransitionsForFinals :: Maybe Bool
presenceOfSinkTransitionsForFinals,
  Maybe Bool
$sel:withActivityFinalInForkBlocks:SelectPetriConfig :: SelectPetriConfig -> 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
""

checkPetriInstance :: SelectPetriInstance -> SelectPetriConfig -> Maybe String
checkPetriInstance :: SelectPetriInstance -> SelectPetriConfig -> Maybe String
checkPetriInstance SelectPetriInstance
inst SelectPetriConfig {
    Int
$sel:numberOfWrongAnswers:SelectPetriConfig :: SelectPetriConfig -> Int
numberOfWrongAnswers :: Int
numberOfWrongAnswers
  }
  | Map Int (Bool, SimplePetriLike PetriKey) -> Int
forall k a. Map k a -> Int
M.size (((Bool, SimplePetriLike PetriKey) -> Bool)
-> Map Int (Bool, SimplePetriLike PetriKey)
-> Map Int (Bool, SimplePetriLike PetriKey)
forall a k. (a -> Bool) -> Map k a -> Map k a
M.filter (Bool -> Bool
not (Bool -> Bool)
-> ((Bool, SimplePetriLike PetriKey) -> Bool)
-> (Bool, SimplePetriLike PetriKey)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool, SimplePetriLike PetriKey) -> Bool
forall a b. (a, b) -> a
fst) (Map Int (Bool, SimplePetriLike PetriKey)
 -> Map Int (Bool, SimplePetriLike PetriKey))
-> Map Int (Bool, SimplePetriLike PetriKey)
-> Map Int (Bool, SimplePetriLike PetriKey)
forall a b. (a -> b) -> a -> b
$ SelectPetriInstance -> Map Int (Bool, SimplePetriLike PetriKey)
petriNets SelectPetriInstance
inst) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
numberOfWrongAnswers
    = String -> Maybe String
forall a. a -> Maybe a
Just String
"Number of wrong nets found for given instance is unequal to numberOfWrongAnswers"
  | Bool
otherwise
    = Maybe String
forall a. Maybe a
Nothing

data SelectPetriSolution = SelectPetriSolution {
  SelectPetriSolution -> SimplePetriLike PetriKey
matchingNet :: SimplePetriLike PetriKey,
  SelectPetriSolution -> [SimplePetriLike PetriKey]
wrongNets :: [SimplePetriLike PetriKey]
} deriving (Int -> SelectPetriSolution -> ShowS
[SelectPetriSolution] -> ShowS
SelectPetriSolution -> String
(Int -> SelectPetriSolution -> ShowS)
-> (SelectPetriSolution -> String)
-> ([SelectPetriSolution] -> ShowS)
-> Show SelectPetriSolution
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SelectPetriSolution -> ShowS
showsPrec :: Int -> SelectPetriSolution -> ShowS
$cshow :: SelectPetriSolution -> String
show :: SelectPetriSolution -> String
$cshowList :: [SelectPetriSolution] -> ShowS
showList :: [SelectPetriSolution] -> ShowS
Show)

selectPetriNet
  :: (MonadRandom m)
  => Int
  -> Int
  -> Bool
  -> (Int, Maybe Int)
  -> UMLActivityDiagram
  -> m SelectPetriSolution
selectPetriNet :: forall (m :: * -> *).
MonadRandom m =>
Int
-> Int
-> Bool
-> (Int, Maybe Int)
-> UMLActivityDiagram
-> m SelectPetriSolution
selectPetriNet Int
numberOfWrongNets Int
numberOfModifications Bool
modifyAtMid (Int, Maybe Int)
countOfPetriNodesBounds UMLActivityDiagram
ad =
  Int
-> Int
-> Bool
-> (Int, Maybe Int)
-> UMLActivityDiagram
-> SimplePetriLike PetriKey
-> m SelectPetriSolution
forall (m :: * -> *).
MonadRandom m =>
Int
-> Int
-> Bool
-> (Int, Maybe Int)
-> UMLActivityDiagram
-> SimplePetriLike PetriKey
-> m SelectPetriSolution
selectPetriNetWithMatchingNet Int
numberOfWrongNets Int
numberOfModifications Bool
modifyAtMid (Int, Maybe Int)
countOfPetriNodesBounds UMLActivityDiagram
ad (UMLActivityDiagram -> SimplePetriLike PetriKey
forall (p :: (* -> *) -> * -> *) (n :: * -> *).
Net p n =>
UMLActivityDiagram -> p n PetriKey
convertToPetriNet UMLActivityDiagram
ad)

selectPetriNetWithMatchingNet
  :: (MonadRandom m)
  => Int
  -> Int
  -> Bool
  -> (Int, Maybe Int)
  -> UMLActivityDiagram
  -> SimplePetriLike PetriKey
  -> m SelectPetriSolution
selectPetriNetWithMatchingNet :: forall (m :: * -> *).
MonadRandom m =>
Int
-> Int
-> Bool
-> (Int, Maybe Int)
-> UMLActivityDiagram
-> SimplePetriLike PetriKey
-> m SelectPetriSolution
selectPetriNetWithMatchingNet Int
numberOfWrongNets Int
numberOfModifications Bool
modifyAtMid (Int, Maybe Int)
countOfPetriNodesBounds UMLActivityDiagram
ad SimplePetriLike PetriKey
matchingNet = do
  [SimplePetriLike PetriKey]
wrongNets <- ([SimplePetriLike PetriKey]
 -> m (Either
         [SimplePetriLike PetriKey] [SimplePetriLike PetriKey]))
-> [SimplePetriLike PetriKey] -> m [SimplePetriLike PetriKey]
forall (m :: * -> *) a b.
Monad m =>
(a -> m (Either a b)) -> a -> m b
loopM (\[SimplePetriLike PetriKey]
xs -> do
      UMLActivityDiagram
modAd <- UMLActivityDiagram -> Int -> Bool -> m UMLActivityDiagram
forall (m :: * -> *).
MonadRandom m =>
UMLActivityDiagram -> Int -> Bool -> m UMLActivityDiagram
modifyAd UMLActivityDiagram
ad Int
numberOfModifications Bool
modifyAtMid
      let petri :: SimplePetriLike PetriKey
petri = UMLActivityDiagram -> SimplePetriLike PetriKey
forall (p :: (* -> *) -> * -> *) (n :: * -> *).
Net p n =>
UMLActivityDiagram -> p n PetriKey
convertToPetriNet UMLActivityDiagram
modAd
      if Bool -> Bool
not ((Int, Maybe Int) -> SimplePetriLike PetriKey -> Bool
forall (p :: (* -> *) -> * -> *) (n :: * -> *) a.
(Net p n, Ord a) =>
(Int, Maybe Int) -> p n a -> Bool
checkPetriNodeCount (Int, Maybe Int)
countOfPetriNodesBounds SimplePetriLike PetriKey
petri)
         Bool -> Bool -> Bool
|| (SimplePetriLike PetriKey -> Bool)
-> [SimplePetriLike PetriKey] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (SimplePetriLike PetriKey -> SimplePetriLike PetriKey -> Bool
forall (p :: (* -> *) -> * -> *) (n :: * -> *)
       (p' :: (* -> *) -> * -> *) (n' :: * -> *) a.
(Net p n, Net p' n', Ord a) =>
p n a -> p' n' a -> Bool
isPetriIsomorphic SimplePetriLike PetriKey
petri) (SimplePetriLike PetriKey
matchingNetSimplePetriLike PetriKey
-> [SimplePetriLike PetriKey] -> [SimplePetriLike PetriKey]
forall a. a -> [a] -> [a]
:[SimplePetriLike PetriKey]
xs)
        then Either [SimplePetriLike PetriKey] [SimplePetriLike PetriKey]
-> m (Either [SimplePetriLike PetriKey] [SimplePetriLike PetriKey])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either [SimplePetriLike PetriKey] [SimplePetriLike PetriKey]
 -> m (Either
         [SimplePetriLike PetriKey] [SimplePetriLike PetriKey]))
-> Either [SimplePetriLike PetriKey] [SimplePetriLike PetriKey]
-> m (Either [SimplePetriLike PetriKey] [SimplePetriLike PetriKey])
forall a b. (a -> b) -> a -> b
$ [SimplePetriLike PetriKey]
-> Either [SimplePetriLike PetriKey] [SimplePetriLike PetriKey]
forall a b. a -> Either a b
Left [SimplePetriLike PetriKey]
xs
      else
        if [SimplePetriLike PetriKey] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (SimplePetriLike PetriKey
petriSimplePetriLike PetriKey
-> [SimplePetriLike PetriKey] -> [SimplePetriLike PetriKey]
forall a. a -> [a] -> [a]
:[SimplePetriLike PetriKey]
xs) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
numberOfWrongNets
          then Either [SimplePetriLike PetriKey] [SimplePetriLike PetriKey]
-> m (Either [SimplePetriLike PetriKey] [SimplePetriLike PetriKey])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either [SimplePetriLike PetriKey] [SimplePetriLike PetriKey]
 -> m (Either
         [SimplePetriLike PetriKey] [SimplePetriLike PetriKey]))
-> Either [SimplePetriLike PetriKey] [SimplePetriLike PetriKey]
-> m (Either [SimplePetriLike PetriKey] [SimplePetriLike PetriKey])
forall a b. (a -> b) -> a -> b
$ [SimplePetriLike PetriKey]
-> Either [SimplePetriLike PetriKey] [SimplePetriLike PetriKey]
forall a b. a -> Either a b
Left (SimplePetriLike PetriKey
petriSimplePetriLike PetriKey
-> [SimplePetriLike PetriKey] -> [SimplePetriLike PetriKey]
forall a. a -> [a] -> [a]
:[SimplePetriLike PetriKey]
xs)
        else Either [SimplePetriLike PetriKey] [SimplePetriLike PetriKey]
-> m (Either [SimplePetriLike PetriKey] [SimplePetriLike PetriKey])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either [SimplePetriLike PetriKey] [SimplePetriLike PetriKey]
 -> m (Either
         [SimplePetriLike PetriKey] [SimplePetriLike PetriKey]))
-> Either [SimplePetriLike PetriKey] [SimplePetriLike PetriKey]
-> m (Either [SimplePetriLike PetriKey] [SimplePetriLike PetriKey])
forall a b. (a -> b) -> a -> b
$ [SimplePetriLike PetriKey]
-> Either [SimplePetriLike PetriKey] [SimplePetriLike PetriKey]
forall a b. b -> Either a b
Right (SimplePetriLike PetriKey
petriSimplePetriLike PetriKey
-> [SimplePetriLike PetriKey] -> [SimplePetriLike PetriKey]
forall a. a -> [a] -> [a]
:[SimplePetriLike PetriKey]
xs)
    ) []
  return SelectPetriSolution {
    $sel:matchingNet:SelectPetriSolution :: SimplePetriLike PetriKey
matchingNet = SimplePetriLike PetriKey
matchingNet,
    $sel:wrongNets:SelectPetriSolution :: [SimplePetriLike PetriKey]
wrongNets = [SimplePetriLike PetriKey]
wrongNets
  }

modifyAd
  :: (MonadRandom m)
  => UMLActivityDiagram
  -> Int
  -> Bool
  -> m UMLActivityDiagram
modifyAd :: forall (m :: * -> *).
MonadRandom m =>
UMLActivityDiagram -> Int -> Bool -> m UMLActivityDiagram
modifyAd UMLActivityDiagram
diag Int
numberOfModifications Bool
modifyAtMid = do
  let ns :: [(AdNode, Int)]
ns = UMLActivityDiagram -> [(AdNode, Int)]
distToStartNode UMLActivityDiagram
diag
      filteredNodes :: [(AdNode, Int)]
filteredNodes = ((AdNode, Int) -> Bool) -> [(AdNode, Int)] -> [(AdNode, Int)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(AdNode
x,Int
_) ->
        Bool -> Bool
not (AdNode -> Bool
isInitialNode AdNode
x) Bool -> Bool -> Bool
&&
        Bool -> Bool
not (AdNode -> Bool
isActivityFinalNode AdNode
x) Bool -> Bool -> Bool
&&
        Bool -> Bool
not (AdNode -> Bool
isFlowFinalNode AdNode
x)) [(AdNode, Int)]
ns
      weightFunc :: Int -> Double
weightFunc =
        if Bool
modifyAtMid then [(AdNode, Int)] -> Int -> Double
forall w a. Real w => [(a, w)] -> w -> Double
weightBySquaredDev [(AdNode, Int)]
filteredNodes
        else Double -> Int -> Double
forall a b. a -> b -> a
const (Double
1.0 :: Double)
      weightedNodes :: [(AdNode, Double)]
weightedNodes = ((AdNode, Int) -> (AdNode, Double))
-> [(AdNode, Int)] -> [(AdNode, Double)]
forall a b. (a -> b) -> [a] -> [b]
map ((Int -> Double) -> (AdNode, Int) -> (AdNode, Double)
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 Int -> Double
weightFunc) [(AdNode, Int)]
filteredNodes
  [AdNode]
shuffledNodes <- [(AdNode, Double)] -> m [AdNode]
forall (m :: * -> *) a w.
(MonadRandom m, Eq a, Real w) =>
[(a, w)] -> m [a]
weightedShuffle [(AdNode, Double)]
weightedNodes
  let toBeModified :: [AdNode]
toBeModified = Int -> [AdNode] -> [AdNode]
forall a. Int -> [a] -> [a]
take Int
numberOfModifications ([AdNode] -> [AdNode]) -> [AdNode] -> [AdNode]
forall a b. (a -> b) -> a -> b
$ [AdNode] -> [AdNode]
forall a. [a] -> [a]
reverse [AdNode]
shuffledNodes
      swappedNodes :: [AdNode]
swappedNodes = (AdNode -> AdNode) -> [AdNode] -> [AdNode]
forall a b. (a -> b) -> [a] -> [b]
map
        (\AdNode
x -> if AdNode
x AdNode -> [AdNode] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [AdNode]
toBeModified then AdNode -> AdNode
swapPetriNode AdNode
x else AdNode
x)
        ([AdNode] -> [AdNode]) -> [AdNode] -> [AdNode]
forall a b. (a -> b) -> a -> b
$ UMLActivityDiagram -> [AdNode]
nodes UMLActivityDiagram
diag
  UMLActivityDiagram -> m UMLActivityDiagram
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
return UMLActivityDiagram {nodes :: [AdNode]
nodes=[AdNode]
swappedNodes, connections :: [AdConnection]
connections=UMLActivityDiagram -> [AdConnection]
connections UMLActivityDiagram
diag}

-- Swap nodes translated to places to nodes translated to transitions and vice versa
swapPetriNode :: AdNode -> AdNode
swapPetriNode :: AdNode -> AdNode
swapPetriNode AdNode
node =
  case AdNode
node of
    AdActionNode {Int
label :: AdNode -> Int
label :: Int
label, String
name :: String
name :: AdNode -> String
name} -> AdObjectNode {label :: Int
label=Int
label, name :: String
name=String
name}
    AdObjectNode {Int
label :: AdNode -> Int
label :: Int
label, String
name :: AdNode -> String
name :: String
name} -> AdActionNode {label :: Int
label=Int
label, name :: String
name=String
name}
    AdDecisionNode {Int
label :: AdNode -> Int
label :: Int
label} -> AdForkNode {Int
label :: Int
label :: Int
label}
    AdForkNode {Int
label :: AdNode -> Int
label :: Int
label} -> AdDecisionNode {Int
label :: Int
label :: Int
label}
    AdMergeNode {Int
label :: AdNode -> Int
label :: Int
label} -> AdJoinNode {Int
label :: Int
label :: Int
label}
    AdJoinNode {Int
label :: AdNode -> Int
label :: Int
label} -> AdMergeNode {Int
label :: Int
label :: Int
label}
    AdNode
_ -> AdNode
node

distToStartNode :: UMLActivityDiagram -> [(AdNode, Int)]
distToStartNode :: UMLActivityDiagram -> [(AdNode, Int)]
distToStartNode UMLActivityDiagram
diag =
  let startNode :: Int
startNode = [Int] -> Int
forall a. HasCallStack => [a] -> a
head ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (AdNode -> Int) -> [AdNode] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map AdNode -> Int
Ad.label ([AdNode] -> [Int]) -> [AdNode] -> [Int]
forall a b. (a -> b) -> a -> b
$ (AdNode -> Bool) -> [AdNode] -> [AdNode]
forall a. (a -> Bool) -> [a] -> [a]
filter AdNode -> Bool
isInitialNode ([AdNode] -> [AdNode]) -> [AdNode] -> [AdNode]
forall a b. (a -> b) -> a -> b
$ UMLActivityDiagram -> [AdNode]
nodes UMLActivityDiagram
diag
      grNodes :: [(Int, AdNode)]
grNodes = (AdNode -> (Int, AdNode)) -> [AdNode] -> [(Int, AdNode)]
forall a b. (a -> b) -> [a] -> [b]
map (\AdNode
x -> (AdNode -> Int
Ad.label AdNode
x, AdNode
x)) ([AdNode] -> [(Int, AdNode)]) -> [AdNode] -> [(Int, AdNode)]
forall a b. (a -> b) -> a -> b
$ UMLActivityDiagram -> [AdNode]
nodes UMLActivityDiagram
diag
      grEdges :: [(Int, Int, String)]
grEdges = (AdConnection -> (Int, Int, String))
-> [AdConnection] -> [(Int, Int, String)]
forall a b. (a -> b) -> [a] -> [b]
map (\AdConnection
x -> (AdConnection -> Int
from AdConnection
x, AdConnection -> Int
to AdConnection
x, AdConnection -> String
guard AdConnection
x)) ([AdConnection] -> [(Int, Int, String)])
-> [AdConnection] -> [(Int, Int, String)]
forall a b. (a -> b) -> a -> b
$ UMLActivityDiagram -> [AdConnection]
connections UMLActivityDiagram
diag
      graph :: Gr AdNode String
graph = [(Int, AdNode)] -> [(Int, Int, String)] -> Gr AdNode String
forall a b. [LNode a] -> [LEdge b] -> Gr a b
forall (gr :: * -> * -> *) a b.
Graph gr =>
[LNode a] -> [LEdge b] -> gr a b
mkGraph [(Int, AdNode)]
grNodes [(Int, Int, String)]
grEdges :: Gr AdNode String
  in ((Int, Int) -> (AdNode, Int)) -> [(Int, Int)] -> [(AdNode, Int)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Int
x,Int
y) -> (Maybe AdNode -> AdNode
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe AdNode -> AdNode) -> Maybe AdNode -> AdNode
forall a b. (a -> b) -> a -> b
$ Gr AdNode String -> Int -> Maybe AdNode
forall (gr :: * -> * -> *) a b.
Graph gr =>
gr a b -> Int -> Maybe a
lab Gr AdNode String
graph Int
x, Int
y)) ([(Int, Int)] -> [(AdNode, Int)])
-> [(Int, Int)] -> [(AdNode, Int)]
forall a b. (a -> b) -> a -> b
$ Int -> Gr AdNode String -> [(Int, Int)]
forall (gr :: * -> * -> *) a b.
Graph gr =>
Int -> gr a b -> [(Int, Int)]
level Int
startNode Gr AdNode String
graph

weightBySquaredDev :: (Real w) => [(a, w)] -> w -> Double
weightBySquaredDev :: forall w a. Real w => [(a, w)] -> w -> Double
weightBySquaredDev [(a, w)]
xs w
w = Double -> Double
forall {a}. Num a => a -> a
square (w -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac w
w Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
avg) Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
epsilon
  where
    epsilon :: Double
epsilon = Double
0.1 -- Small constant to avoid 0-weights
    square :: a -> a
square a
x = a
x a -> a -> a
forall a. Num a => a -> a -> a
* a
x
    avg :: Double
avg = w -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac ([w] -> w
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (((a, w) -> w) -> [(a, w)] -> [w]
forall a b. (a -> b) -> [a] -> [b]
map (a, w) -> w
forall a b. (a, b) -> b
snd [(a, w)]
xs)) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ [(a, w)] -> Double
forall i a. Num i => [a] -> i
genericLength [(a, w)]
xs

selectPetriTask
  :: (
    MonadCache m,
    MonadDiagrams m,
    MonadGraphviz m,
    MonadPlantUml m,
    MonadThrow m,
    MonadWriteFile m,
    OutputCapable m
    )
  => FilePath
  -> SelectPetriInstance
  -> LangM m
selectPetriTask :: forall (m :: * -> *).
(MonadCache m, MonadDiagrams m, MonadGraphviz m, MonadPlantUml m,
 MonadThrow m, MonadWriteFile m, OutputCapable m) =>
String -> SelectPetriInstance -> LangM m
selectPetriTask String
path SelectPetriInstance
task = do
  let mapping :: Map Int (SimplePetriLike PetriKey)
mapping = ((Bool, SimplePetriLike PetriKey) -> SimplePetriLike PetriKey)
-> Map Int (Bool, SimplePetriLike PetriKey)
-> Map Int (SimplePetriLike PetriKey)
forall a b k. (a -> b) -> Map k a -> Map k b
M.map (Bool, SimplePetriLike PetriKey) -> SimplePetriLike PetriKey
forall a b. (a, b) -> b
snd (Map Int (Bool, SimplePetriLike PetriKey)
 -> Map Int (SimplePetriLike PetriKey))
-> Map Int (Bool, SimplePetriLike PetriKey)
-> Map Int (SimplePetriLike PetriKey)
forall a b. (a -> b) -> a -> b
$ SelectPetriInstance -> Map Int (Bool, SimplePetriLike PetriKey)
petriNets SelectPetriInstance
task
  LangM m -> LangM m
forall l (m :: * -> *).
GenericOutputCapable l m =>
GenericLangM l m () -> GenericLangM l m ()
paragraph (LangM m -> LangM m) -> LangM m -> LangM m
forall a b. (a -> b) -> a -> b
$ State (Map Language String) () -> LangM m
forall l (m :: * -> *).
GenericOutputCapable l m =>
State (Map l String) () -> GenericLangM l m ()
translate (State (Map Language String) () -> LangM m)
-> State (Map Language String) () -> LangM m
forall a b. (a -> b) -> a -> b
$ do
    String -> State (Map Language String) ()
english String
"Consider the following activity diagram:"
    String -> State (Map Language String) ()
german String
"Betrachten Sie folgendes Aktivitätsdiagramm:"
  String -> LangM m
forall l (m :: * -> *).
GenericOutputCapable l m =>
String -> GenericLangM l m ()
image (String -> LangM m) -> m String -> LangM m
forall (m :: * -> *) a l b.
Monad m =>
(a -> GenericLangM l m b) -> m a -> GenericLangM l m b
$=<< String -> PlantUmlConfig -> UMLActivityDiagram -> m String
forall (m :: * -> *).
(MonadPlantUml m, MonadWriteFile m) =>
String -> PlantUmlConfig -> UMLActivityDiagram -> m String
drawAdToFile String
path (SelectPetriInstance -> PlantUmlConfig
plantUMLConf SelectPetriInstance
task) (UMLActivityDiagram -> m String) -> UMLActivityDiagram -> m String
forall a b. (a -> b) -> a -> b
$ SelectPetriInstance -> UMLActivityDiagram
activityDiagram SelectPetriInstance
task
  let drawSetting :: DrawSettings
drawSetting = SelectPetriInstance -> DrawSettings
petriDrawConf SelectPetriInstance
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 nets:"
    String -> State (Map Language String) ()
german String
"Betrachten Sie die folgenden Petrinetze:"
  (Int -> String) -> ShowS -> Map Int String -> LangM m
forall k a. (k -> String) -> (a -> String) -> Map k a -> LangM m
forall l (m :: * -> *) k a.
GenericOutputCapable l m =>
(k -> String) -> (a -> String) -> Map k a -> GenericLangM l m ()
images Int -> String
forall a. Show a => a -> String
show ShowS
forall a. a -> a
id
    (Map Int String -> LangM m) -> m (Map Int String) -> LangM m
forall (m :: * -> *) a l b.
Monad m =>
(a -> GenericLangM l m b) -> m a -> GenericLangM l m b
$=<< Map Int (SimplePetriLike PetriKey)
-> (SimplePetriLike PetriKey -> m String) -> m (Map Int String)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for
      Map Int (SimplePetriLike PetriKey)
mapping
      (\SimplePetriLike PetriKey
c -> 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
c) 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 [i|Which of these Petri nets is the translation of the given activity diagram?
Please state your answer by giving a number indicating the matching Petri net.|]
    String -> State (Map Language String) ()
german [i|Welches dieser Petrinetze ist die Übersetzung des gegebenen Aktivitätsdiagramms?
Bitte geben Sie Ihre Antwort als Zahl an, welche das passende Petrinetz repräsentiert.|]
  LangM m -> LangM m
forall l (m :: * -> *).
GenericOutputCapable l m =>
GenericLangM l m () -> GenericLangM l m ()
paragraph (LangM m -> LangM m) -> LangM m -> LangM m
forall a b. (a -> b) -> a -> b
$ do
    State (Map Language String) () -> LangM m
forall l (m :: * -> *).
GenericOutputCapable l m =>
State (Map l String) () -> GenericLangM l m ()
translate (State (Map Language String) () -> LangM m)
-> State (Map Language String) () -> LangM m
forall a b. (a -> b) -> a -> b
$ do
      String -> State (Map Language String) ()
english [i|For example,|]
      String -> State (Map Language String) ()
german [i|Zum Beispiel würde|]
    String -> LangM m
forall l (m :: * -> *).
GenericOutputCapable l m =>
String -> GenericLangM l m ()
code String
"2"
    State (Map Language String) () -> LangM m
forall l (m :: * -> *).
GenericOutputCapable l m =>
State (Map l String) () -> GenericLangM l m ()
translate (State (Map Language String) () -> LangM m)
-> State (Map Language String) () -> LangM m
forall a b. (a -> b) -> a -> b
$ do
      String -> State (Map Language String) ()
english [i|would indicate that Petri net 2 is the matching Petri net.|]
      String -> State (Map Language String) ()
german  [i|bedeuten, dass Petrinetz 2 das passende Petrinetz ist.|]
    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
$ SelectPetriInstance -> Maybe (Map Language String)
addText SelectPetriInstance
task

  pure ()

selectPetriSolutionToMap
  :: (MonadRandom m)
  => SelectPetriSolution
  -> m (Map Int (Bool, SimplePetriLike PetriKey))
selectPetriSolutionToMap :: forall (m :: * -> *).
MonadRandom m =>
SelectPetriSolution -> m (Map Int (Bool, SimplePetriLike PetriKey))
selectPetriSolutionToMap SelectPetriSolution
sol = do
  let xs :: [(Bool, SimplePetriLike PetriKey)]
xs = (Bool
True, SelectPetriSolution -> SimplePetriLike PetriKey
matchingNet SelectPetriSolution
sol) (Bool, SimplePetriLike PetriKey)
-> [(Bool, SimplePetriLike PetriKey)]
-> [(Bool, SimplePetriLike PetriKey)]
forall a. a -> [a] -> [a]
: (SimplePetriLike PetriKey -> (Bool, SimplePetriLike PetriKey))
-> [SimplePetriLike PetriKey] -> [(Bool, SimplePetriLike PetriKey)]
forall a b. (a -> b) -> [a] -> [b]
map (Bool
False, ) (SelectPetriSolution -> [SimplePetriLike PetriKey]
wrongNets SelectPetriSolution
sol)
  [(Bool, SimplePetriLike PetriKey)]
solution <- [(Bool, SimplePetriLike PetriKey)]
-> m [(Bool, SimplePetriLike PetriKey)]
forall (m :: * -> *) a. MonadRandom m => [a] -> m [a]
shuffleM [(Bool, SimplePetriLike PetriKey)]
xs
  return $ [(Int, (Bool, SimplePetriLike PetriKey))]
-> Map Int (Bool, SimplePetriLike PetriKey)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Int, (Bool, SimplePetriLike PetriKey))]
 -> Map Int (Bool, SimplePetriLike PetriKey))
-> [(Int, (Bool, SimplePetriLike PetriKey))]
-> Map Int (Bool, SimplePetriLike PetriKey)
forall a b. (a -> b) -> a -> b
$ [Int]
-> [(Bool, SimplePetriLike PetriKey)]
-> [(Int, (Bool, SimplePetriLike PetriKey))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1..] [(Bool, SimplePetriLike PetriKey)]
solution

selectPetriSyntax
  :: OutputCapable m
  => SelectPetriInstance
  -> Int
  -> LangM m
selectPetriSyntax :: forall (m :: * -> *).
OutputCapable m =>
SelectPetriInstance -> Int -> LangM m
selectPetriSyntax SelectPetriInstance
task Int
sub = LangM' m () -> LangM' m ()
forall (m :: * -> *) a. OutputCapable m => LangM' m a -> LangM' m a
addPretext (LangM' m () -> LangM' m ()) -> LangM' m () -> LangM' m ()
forall a b. (a -> b) -> a -> b
$ do
  let options :: [Int]
options = Map Int (Bool, SimplePetriLike PetriKey) -> [Int]
forall k a. Map k a -> [k]
M.keys (Map Int (Bool, SimplePetriLike PetriKey) -> [Int])
-> Map Int (Bool, SimplePetriLike PetriKey) -> [Int]
forall a b. (a -> b) -> a -> b
$ SelectPetriInstance -> Map Int (Bool, SimplePetriLike PetriKey)
petriNets SelectPetriInstance
task
  Bool -> [Int] -> Int -> LangM' m ()
forall (m :: * -> *) a.
(OutputCapable m, Eq a, Show a) =>
Bool -> [a] -> a -> LangM m
singleChoiceSyntax Bool
False [Int]
options Int
sub

selectPetriEvaluation
  :: (
    Alternative m,
    MonadCache m,
    MonadDiagrams m,
    MonadGraphviz m,
    MonadPlantUml m,
    MonadThrow m,
    MonadWriteFile m,
    OutputCapable m
    )
  => FilePath
  -> SelectPetriInstance
  -> Int
  -> LangM m
selectPetriEvaluation :: forall (m :: * -> *).
(Alternative m, MonadCache m, MonadDiagrams m, MonadGraphviz m,
 MonadPlantUml m, MonadThrow m, MonadWriteFile m,
 OutputCapable m) =>
String -> SelectPetriInstance -> Int -> LangM m
selectPetriEvaluation String
path SelectPetriInstance
task Int
n = LangM' m () -> LangM' m ()
forall (m :: * -> *) a. OutputCapable m => LangM' m a -> LangM' m a
addPretext (LangM' m () -> LangM' m ()) -> LangM' m () -> LangM' m ()
forall a b. (a -> b) -> a -> b
$ do
  let as :: Map Language String
as = State (Map Language String) () -> Map Language String
forall l a. State (Map l a) () -> Map l a
translations (State (Map Language String) () -> Map Language String)
-> State (Map Language String) () -> Map Language String
forall a b. (a -> b) -> a -> b
$ do
        String -> State (Map Language String) ()
english String
"Petri net"
        String -> State (Map Language String) ()
german String
"Petrinetz"
      solMap :: Map Int (Bool, SimplePetriLike PetriKey)
solMap = SelectPetriInstance -> Map Int (Bool, SimplePetriLike PetriKey)
petriNets SelectPetriInstance
task
      (Int
solution, SimplePetriLike PetriKey
_) = [(Int, SimplePetriLike PetriKey)]
-> (Int, SimplePetriLike PetriKey)
forall a. HasCallStack => [a] -> a
head ([(Int, SimplePetriLike PetriKey)]
 -> (Int, SimplePetriLike PetriKey))
-> [(Int, SimplePetriLike PetriKey)]
-> (Int, SimplePetriLike PetriKey)
forall a b. (a -> b) -> a -> b
$ Map Int (SimplePetriLike PetriKey)
-> [(Int, SimplePetriLike PetriKey)]
forall k a. Map k a -> [(k, a)]
M.toList (Map Int (SimplePetriLike PetriKey)
 -> [(Int, SimplePetriLike PetriKey)])
-> Map Int (SimplePetriLike PetriKey)
-> [(Int, SimplePetriLike PetriKey)]
forall a b. (a -> b) -> a -> b
$ ((Bool, SimplePetriLike PetriKey) -> SimplePetriLike PetriKey)
-> Map Int (Bool, SimplePetriLike PetriKey)
-> Map Int (SimplePetriLike PetriKey)
forall a b k. (a -> b) -> Map k a -> Map k b
M.map (Bool, SimplePetriLike PetriKey) -> SimplePetriLike PetriKey
forall a b. (a, b) -> b
snd (Map Int (Bool, SimplePetriLike PetriKey)
 -> Map Int (SimplePetriLike PetriKey))
-> Map Int (Bool, SimplePetriLike PetriKey)
-> Map Int (SimplePetriLike PetriKey)
forall a b. (a -> b) -> a -> b
$ ((Bool, SimplePetriLike PetriKey) -> Bool)
-> Map Int (Bool, SimplePetriLike PetriKey)
-> Map Int (Bool, SimplePetriLike PetriKey)
forall a k. (a -> Bool) -> Map k a -> Map k a
M.filter (Bool, SimplePetriLike PetriKey) -> Bool
forall a b. (a, b) -> a
fst Map Int (Bool, SimplePetriLike PetriKey)
solMap
      maybeSolutionString :: Maybe String
maybeSolutionString =
        if SelectPetriInstance -> Bool
showSolution SelectPetriInstance
task
        then String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
solution
        else Maybe String
forall a. Maybe a
Nothing
  LangM' m () -> LangM' m () -> LangM' m ()
forall (m :: * -> *).
(Alternative m, Monad m, OutputCapable m) =>
LangM m -> LangM m -> LangM m
reRefuseLangM (ArticleToUse
-> Map Language String -> Maybe String -> Int -> Int -> LangM' m ()
forall (m :: * -> *) a.
(OutputCapable m, Eq a) =>
ArticleToUse
-> Map Language String -> Maybe String -> a -> a -> LangM m
singleChoice ArticleToUse
DefiniteArticle Map Language String
as Maybe String
maybeSolutionString Int
solution Int
n) (LangM' m () -> LangM' m ()) -> LangM' m () -> LangM' m ()
forall a b. (a -> b) -> a -> b
$ do
    Bool -> LangM' m () -> LangM' m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (SelectPetriInstance -> Bool
showSolution SelectPetriInstance
task) (LangM' m () -> LangM' m ()) -> LangM' m () -> LangM' m ()
forall a b. (a -> b) -> a -> b
$ do

      Bool -> LangM' m () -> LangM' m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (PlantUmlConfig -> Bool
suppressNodeNames (PlantUmlConfig -> Bool) -> PlantUmlConfig -> Bool
forall a b. (a -> b) -> a -> b
$ SelectPetriInstance -> PlantUmlConfig
plantUMLConf SelectPetriInstance
task) (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
$ 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 String
"The original activity diagram with node names looks like this:"
          String -> State (Map Language String) ()
german String
"Das originale Aktivitätsdiagramm sieht mit Knotennamen wie folgt aus:"

        let alteredConfig :: PlantUmlConfig
alteredConfig = (SelectPetriInstance -> PlantUmlConfig
plantUMLConf SelectPetriInstance
task) { suppressNodeNames :: Bool
suppressNodeNames = Bool
False }
        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 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"feedback") PlantUmlConfig
alteredConfig
          (UMLActivityDiagram -> m String) -> UMLActivityDiagram -> m String
forall a b. (a -> b) -> a -> b
$ SelectPetriInstance -> UMLActivityDiagram
activityDiagram SelectPetriInstance
task
        pure ()

      let (Bool
_, SimplePetriLike PetriKey
correctNet) = Maybe (Bool, SimplePetriLike PetriKey)
-> (Bool, SimplePetriLike PetriKey)
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (Bool, SimplePetriLike PetriKey)
 -> (Bool, SimplePetriLike PetriKey))
-> Maybe (Bool, SimplePetriLike PetriKey)
-> (Bool, SimplePetriLike PetriKey)
forall a b. (a -> b) -> a -> b
$ ((Bool, SimplePetriLike PetriKey) -> Bool)
-> Map Int (Bool, SimplePetriLike PetriKey)
-> Maybe (Bool, SimplePetriLike PetriKey)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (Bool, SimplePetriLike PetriKey) -> Bool
forall a b. (a, b) -> a
fst (Map Int (Bool, SimplePetriLike PetriKey)
 -> Maybe (Bool, SimplePetriLike PetriKey))
-> Map Int (Bool, SimplePetriLike PetriKey)
-> Maybe (Bool, SimplePetriLike PetriKey)
forall a b. (a -> b) -> a -> b
$ SelectPetriInstance -> Map Int (Bool, SimplePetriLike PetriKey)
petriNets SelectPetriInstance
task
      Bool -> LangM' m () -> LangM' m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (DrawSettings -> Bool
withPlaceNames (DrawSettings -> Bool) -> DrawSettings -> Bool
forall a b. (a -> b) -> a -> b
$ SelectPetriInstance -> DrawSettings
petriDrawConf SelectPetriInstance
task) (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
$ 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 String
"The translated Petri net (including node names) looks like this:"
          String -> State (Map Language String) ()
german String
"Das aus dem Aktivitätsdiagramm übersetzte Petrinetz sieht mit Knotennamen wie folgt aus:"

        let drawSetting :: DrawSettings
drawSetting = (SelectPetriInstance -> DrawSettings
petriDrawConf SelectPetriInstance
task)
              { $sel:withPlaceNames:DrawSettings :: Bool
withPlaceNames = Bool
True
              , $sel:withTransitionNames:DrawSettings :: Bool
withTransitionNames = Bool
True
              }
        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
correctNet) DrawSettings
drawSetting
        pure ()

      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
"The mapping of the nodes from the activity diagram to nodes from the Petri net is as follows:"
        String -> State (Map Language String) ()
german String
"Die Zuordnung der Knoten aus dem Aktivitätsdiagramm zu Knoten aus dem Petrinetz sieht wie folgt aus:"


      let MatchPetriSolution{[Int]
[(String, Int)]
actionNodes :: [(String, Int)]
objectNodes :: [(String, Int)]
decisionNodes :: [Int]
mergeNodes :: [Int]
forks :: [Int]
joins :: [Int]
initialNodes :: [Int]
activityFinalNodes :: [Int]
flowFinalNodes :: [Int]
auxiliaryPetriNodes :: [Int]
$sel:actionNodes:MatchPetriSolution :: MatchPetriSolution -> [(String, Int)]
$sel:objectNodes:MatchPetriSolution :: MatchPetriSolution -> [(String, Int)]
$sel:decisionNodes:MatchPetriSolution :: MatchPetriSolution -> [Int]
$sel:mergeNodes:MatchPetriSolution :: MatchPetriSolution -> [Int]
$sel:forks:MatchPetriSolution :: MatchPetriSolution -> [Int]
$sel:joins:MatchPetriSolution :: MatchPetriSolution -> [Int]
$sel:initialNodes:MatchPetriSolution :: MatchPetriSolution -> [Int]
$sel:activityFinalNodes:MatchPetriSolution :: MatchPetriSolution -> [Int]
$sel:flowFinalNodes:MatchPetriSolution :: MatchPetriSolution -> [Int]
$sel:auxiliaryPetriNodes:MatchPetriSolution :: MatchPetriSolution -> [Int]
..} = SimplePetriLike PetriKey -> MatchPetriSolution
forall (p :: (* -> *) -> * -> *) (n :: * -> *).
Net p n =>
p n PetriKey -> MatchPetriSolution
mapTypesToLabels SimplePetriLike PetriKey
correctNet

      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 String
"Action nodes:"
          String -> State (Map Language String) ()
german String
"Aktionsknoten:"
        String -> LangM' m ()
forall l (m :: * -> *).
GenericOutputCapable l m =>
String -> GenericLangM l m ()
code (String -> LangM' m ()) -> String -> LangM' m ()
forall a b. (a -> b) -> a -> b
$ [(String, Int)] -> String
forall a. Show a => a -> String
show [(String, Int)]
actionNodes
        pure ()

      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 String
"Activity final nodes:"
          String -> State (Map Language String) ()
german String
"Aktivitätsenden:"
        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
$ [Int] -> String
forall a. Show a => a -> String
show [Int]
activityFinalNodes
        pure ()

      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 String
"Object nodes:"
          String -> State (Map Language String) ()
german String
"Objektknoten:"
        String -> LangM' m ()
forall l (m :: * -> *).
GenericOutputCapable l m =>
String -> GenericLangM l m ()
code (String -> LangM' m ()) -> String -> LangM' m ()
forall a b. (a -> b) -> a -> b
$ [(String, Int)] -> String
forall a. Show a => a -> String
show [(String, Int)]
objectNodes
        pure ()

      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 String
"Decision nodes:"
          String -> State (Map Language String) ()
german String
"Verzweigungsknoten:"
        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
$ [Int] -> String
forall a. Show a => a -> String
show [Int]
decisionNodes
        pure ()

      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 String
"Flow final nodes:"
          String -> State (Map Language String) ()
german String
"Flussenden:"
        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
$ [Int] -> String
forall a. Show a => a -> String
show [Int]
flowFinalNodes
        pure ()

      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 String
"Merge nodes:"
          String -> State (Map Language String) ()
german String
"Verbindungsknoten:"
        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
$ [Int] -> String
forall a. Show a => a -> String
show [Int]
mergeNodes
        pure ()

      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 String
"Forks:"
          String -> State (Map Language String) ()
german String
"Gabelungen:"
        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
$ [Int] -> String
forall a. Show a => a -> String
show [Int]
forks
        pure ()

      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 String
"Joins:"
          String -> State (Map Language String) ()
german String
"Vereinigungen:"
        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
$ [Int] -> String
forall a. Show a => a -> String
show [Int]
joins
        pure ()

      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 String
"Initial nodes:"
          String -> State (Map Language String) ()
german String
"Startknoten:"
        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
$ [Int] -> String
forall a. Show a => a -> String
show [Int]
initialNodes
        pure ()

      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 String
"Auxiliary places / transitions:"
          String -> State (Map Language String) ()
german String
"Hilfsstellen und -transitionen:"
        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
$ [Int] -> String
forall a. Show a => a -> String
show [Int]
auxiliaryPetriNodes
        pure ()

      pure ()

selectPetriSolution
  :: SelectPetriInstance
  -> Int
selectPetriSolution :: SelectPetriInstance -> Int
selectPetriSolution = [Int] -> Int
forall a. HasCallStack => [a] -> a
head ([Int] -> Int)
-> (SelectPetriInstance -> [Int]) -> SelectPetriInstance -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Int (Bool, SimplePetriLike PetriKey) -> [Int]
forall k a. Map k a -> [k]
M.keys (Map Int (Bool, SimplePetriLike PetriKey) -> [Int])
-> (SelectPetriInstance
    -> Map Int (Bool, SimplePetriLike PetriKey))
-> SelectPetriInstance
-> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Bool, SimplePetriLike PetriKey) -> Bool)
-> Map Int (Bool, SimplePetriLike PetriKey)
-> Map Int (Bool, SimplePetriLike PetriKey)
forall a k. (a -> Bool) -> Map k a -> Map k a
M.filter (Bool, SimplePetriLike PetriKey) -> Bool
forall a b. (a, b) -> a
fst (Map Int (Bool, SimplePetriLike PetriKey)
 -> Map Int (Bool, SimplePetriLike PetriKey))
-> (SelectPetriInstance
    -> Map Int (Bool, SimplePetriLike PetriKey))
-> SelectPetriInstance
-> Map Int (Bool, SimplePetriLike PetriKey)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SelectPetriInstance -> Map Int (Bool, SimplePetriLike PetriKey)
petriNets

selectPetri
  :: (MonadAlloy m, MonadThrow m)
  => SelectPetriConfig
  -> Int
  -> Int
  -> m SelectPetriInstance
selectPetri :: forall (m :: * -> *).
(MonadAlloy m, MonadThrow m) =>
SelectPetriConfig -> Int -> Int -> m SelectPetriInstance
selectPetri SelectPetriConfig
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 SelectPetriInstance
-> StdGen -> m SelectPetriInstance
forall (m :: * -> *) g a. Monad m => RandT g m a -> g -> m a
evalRandT (SelectPetriConfig -> RandT StdGen m SelectPetriInstance
forall (m :: * -> *) g.
(MonadAlloy m, MonadThrow m, RandomGen g) =>
SelectPetriConfig -> RandT g m SelectPetriInstance
getSelectPetriTask SelectPetriConfig
config) StdGen
g

getSelectPetriTask
  :: (MonadAlloy m, MonadThrow m, RandomGen g)
  => SelectPetriConfig
  -> RandT g m SelectPetriInstance
getSelectPetriTask :: forall (m :: * -> *) g.
(MonadAlloy m, MonadThrow m, RandomGen g) =>
SelectPetriConfig -> RandT g m SelectPetriInstance
getSelectPetriTask SelectPetriConfig
config = do
  [AlloyInstance]
instances <- Maybe Integer -> Maybe Int -> String -> RandT g m [AlloyInstance]
forall (m :: * -> *).
MonadAlloy m =>
Maybe Integer -> Maybe Int -> String -> m [AlloyInstance]
getInstances
    (SelectPetriConfig -> Maybe Integer
maxInstances SelectPetriConfig
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
$ SelectPetriConfig -> String
selectPetriAlloy SelectPetriConfig
config
  [UMLActivityDiagram]
randomInstances <- [AlloyInstance] -> RandT g m [AlloyInstance]
forall (m :: * -> *) a. MonadRandom m => [a] -> m [a]
shuffleM [AlloyInstance]
instances RandT g m [AlloyInstance]
-> ([AlloyInstance] -> RandT g m [UMLActivityDiagram])
-> RandT g m [UMLActivityDiagram]
forall a b. RandT g m a -> (a -> RandT g m b) -> RandT g m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (AlloyInstance -> RandT g m UMLActivityDiagram)
-> [AlloyInstance] -> RandT g m [UMLActivityDiagram]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM AlloyInstance -> RandT g m UMLActivityDiagram
forall (m :: * -> *).
MonadThrow m =>
AlloyInstance -> m UMLActivityDiagram
parseInstance
  GraphvizCommand
layout <- SelectPetriConfig -> RandT g m GraphvizCommand
forall (m :: * -> *).
MonadRandom m =>
SelectPetriConfig -> m GraphvizCommand
pickRandomLayout SelectPetriConfig
config
  let plantUMLConf :: PlantUmlConfig
plantUMLConf = PlantUmlConfig {
        suppressNodeNames :: Bool
suppressNodeNames = SelectPetriConfig -> Bool
hideNodeNames SelectPetriConfig
config,
        suppressBranchConditions :: Bool
suppressBranchConditions = SelectPetriConfig -> Bool
hideBranchConditions SelectPetriConfig
config
      }
      petriDrawConf :: DrawSettings
petriDrawConf = DrawSettings {
        $sel:withPlaceNames:DrawSettings :: Bool
withPlaceNames = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ SelectPetriConfig -> Bool
hidePetriNodeLabels SelectPetriConfig
config,
        $sel:withSvgHighlighting:DrawSettings :: Bool
withSvgHighlighting = SelectPetriConfig -> Bool
petriSvgHighlighting SelectPetriConfig
config,
        $sel:withTransitionNames:DrawSettings :: Bool
withTransitionNames = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ SelectPetriConfig -> Bool
hidePetriNodeLabels SelectPetriConfig
config,
        $sel:with1Weights:DrawSettings :: Bool
with1Weights = Bool
False,
        $sel:withGraphvizCommand:DrawSettings :: GraphvizCommand
withGraphvizCommand = GraphvizCommand
layout
      }
  Maybe SelectPetriInstance
ad <- (UMLActivityDiagram -> RandT g m UMLActivityDiagram)
-> [UMLActivityDiagram] -> RandT g m [UMLActivityDiagram]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (((Map String String, UMLActivityDiagram) -> UMLActivityDiagram)
-> RandT g m (Map String String, UMLActivityDiagram)
-> RandT g m UMLActivityDiagram
forall a b. (a -> b) -> RandT g m a -> RandT g m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Map String String, UMLActivityDiagram) -> UMLActivityDiagram
forall a b. (a, b) -> b
snd (RandT g m (Map String String, UMLActivityDiagram)
 -> RandT g m UMLActivityDiagram)
-> (UMLActivityDiagram
    -> RandT g m (Map String String, UMLActivityDiagram))
-> UMLActivityDiagram
-> RandT g m UMLActivityDiagram
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UMLActivityDiagram
-> RandT g m (Map String String, UMLActivityDiagram)
forall (m :: * -> *).
MonadRandom m =>
UMLActivityDiagram -> m (Map String String, UMLActivityDiagram)
shuffleAdNames) [UMLActivityDiagram]
randomInstances
    RandT g m [UMLActivityDiagram]
-> ([UMLActivityDiagram] -> RandT g m (Maybe SelectPetriInstance))
-> RandT g m (Maybe SelectPetriInstance)
forall a b. RandT g m a -> (a -> RandT g m b) -> RandT g m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (UMLActivityDiagram -> RandT g m (Maybe SelectPetriInstance))
-> [UMLActivityDiagram] -> RandT g m (Maybe SelectPetriInstance)
forall (m :: * -> *) a b.
Monad m =>
(a -> m (Maybe b)) -> [a] -> m (Maybe b)
firstJustM (\UMLActivityDiagram
ad -> do
      let petriNet :: SimplePetriLike PetriKey
petriNet = forall (p :: (* -> *) -> * -> *) (n :: * -> *).
Net p n =>
UMLActivityDiagram -> p n PetriKey
convertToPetriNet @PetriLike @SimpleNode UMLActivityDiagram
ad
      if Bool -> Bool
not ((Int, Maybe Int) -> SimplePetriLike PetriKey -> Bool
forall (p :: (* -> *) -> * -> *) (n :: * -> *) a.
(Net p n, Ord a) =>
(Int, Maybe Int) -> p n a -> Bool
checkPetriNodeCount (SelectPetriConfig -> (Int, Maybe Int)
countOfPetriNodesBounds SelectPetriConfig
config) SimplePetriLike PetriKey
petriNet)
        then Maybe SelectPetriInstance -> RandT g m (Maybe SelectPetriInstance)
forall a. a -> RandT g m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe SelectPetriInstance
forall a. Maybe a
Nothing
        else do
          SelectPetriSolution
sol <- Int
-> Int
-> Bool
-> (Int, Maybe Int)
-> UMLActivityDiagram
-> SimplePetriLike PetriKey
-> RandT g m SelectPetriSolution
forall (m :: * -> *).
MonadRandom m =>
Int
-> Int
-> Bool
-> (Int, Maybe Int)
-> UMLActivityDiagram
-> SimplePetriLike PetriKey
-> m SelectPetriSolution
selectPetriNetWithMatchingNet
            (SelectPetriConfig -> Int
numberOfWrongAnswers SelectPetriConfig
config)
            (SelectPetriConfig -> Int
numberOfModifications SelectPetriConfig
config)
            (SelectPetriConfig -> Bool
modifyAtMid SelectPetriConfig
config)
            (SelectPetriConfig -> (Int, Maybe Int)
countOfPetriNodesBounds SelectPetriConfig
config)
            UMLActivityDiagram
ad
            SimplePetriLike PetriKey
petriNet
          SimplePetriLike PetriKey
p <- ((Map Int Int, SimplePetriLike PetriKey)
 -> SimplePetriLike PetriKey)
-> RandT g m (Map Int Int, SimplePetriLike PetriKey)
-> RandT g m (SimplePetriLike PetriKey)
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 Int Int, SimplePetriLike PetriKey) -> SimplePetriLike PetriKey
forall a b. (a, b) -> b
snd (RandT g m (Map Int Int, SimplePetriLike PetriKey)
 -> RandT g m (SimplePetriLike PetriKey))
-> RandT g m (Map Int Int, SimplePetriLike PetriKey)
-> RandT g m (SimplePetriLike PetriKey)
forall a b. (a -> b) -> a -> 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
 -> RandT g m (Map Int Int, SimplePetriLike PetriKey))
-> SimplePetriLike PetriKey
-> RandT g m (Map Int Int, SimplePetriLike PetriKey)
forall a b. (a -> b) -> a -> b
$ SelectPetriSolution -> SimplePetriLike PetriKey
matchingNet SelectPetriSolution
sol
          [SimplePetriLike PetriKey]
ps <- (SimplePetriLike PetriKey -> RandT g m (SimplePetriLike PetriKey))
-> [SimplePetriLike PetriKey]
-> RandT g m [SimplePetriLike PetriKey]
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 Int Int, SimplePetriLike PetriKey)
 -> SimplePetriLike PetriKey)
-> RandT g m (Map Int Int, SimplePetriLike PetriKey)
-> RandT g m (SimplePetriLike PetriKey)
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 Int Int, SimplePetriLike PetriKey) -> SimplePetriLike PetriKey
forall a b. (a, b) -> b
snd (RandT g m (Map Int Int, SimplePetriLike PetriKey)
 -> RandT g m (SimplePetriLike PetriKey))
-> (SimplePetriLike PetriKey
    -> RandT g m (Map Int Int, SimplePetriLike PetriKey))
-> SimplePetriLike PetriKey
-> RandT g m (SimplePetriLike PetriKey)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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]
 -> RandT g m [SimplePetriLike PetriKey])
-> [SimplePetriLike PetriKey]
-> RandT g m [SimplePetriLike PetriKey]
forall a b. (a -> b) -> a -> b
$ SelectPetriSolution -> [SimplePetriLike PetriKey]
wrongNets SelectPetriSolution
sol
          Map Int (Bool, SimplePetriLike PetriKey)
petriNets <- SelectPetriSolution
-> RandT g m (Map Int (Bool, SimplePetriLike PetriKey))
forall (m :: * -> *).
MonadRandom m =>
SelectPetriSolution -> m (Map Int (Bool, SimplePetriLike PetriKey))
selectPetriSolutionToMap
            (SelectPetriSolution
 -> RandT g m (Map Int (Bool, SimplePetriLike PetriKey)))
-> SelectPetriSolution
-> RandT g m (Map Int (Bool, SimplePetriLike PetriKey))
forall a b. (a -> b) -> a -> b
$ SelectPetriSolution {$sel:matchingNet:SelectPetriSolution :: SimplePetriLike PetriKey
matchingNet=SimplePetriLike PetriKey
p, $sel:wrongNets:SelectPetriSolution :: [SimplePetriLike PetriKey]
wrongNets=[SimplePetriLike PetriKey]
ps}
          let petriInst :: SelectPetriInstance
petriInst = SelectPetriInstance {
                $sel:activityDiagram:SelectPetriInstance :: UMLActivityDiagram
activityDiagram=UMLActivityDiagram
ad,
                $sel:plantUMLConf:SelectPetriInstance :: PlantUmlConfig
plantUMLConf=PlantUmlConfig
plantUMLConf,
                $sel:petriDrawConf:SelectPetriInstance :: DrawSettings
petriDrawConf=DrawSettings
petriDrawConf,
                $sel:petriNets:SelectPetriInstance :: Map Int (Bool, SimplePetriLike PetriKey)
petriNets = Map Int (Bool, SimplePetriLike PetriKey)
petriNets,
                $sel:showSolution:SelectPetriInstance :: Bool
showSolution = SelectPetriConfig -> Bool
printSolution SelectPetriConfig
config,
                $sel:addText:SelectPetriInstance :: Maybe (Map Language String)
addText = SelectPetriConfig -> Maybe (Map Language String)
extraText SelectPetriConfig
config
              }
          case SelectPetriInstance -> SelectPetriConfig -> Maybe String
checkPetriInstance SelectPetriInstance
petriInst SelectPetriConfig
config of
            Just String
_ -> Maybe SelectPetriInstance -> RandT g m (Maybe SelectPetriInstance)
forall a. a -> RandT g m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe SelectPetriInstance
forall a. Maybe a
Nothing
            Maybe String
Nothing -> Maybe SelectPetriInstance -> RandT g m (Maybe SelectPetriInstance)
forall a. a -> RandT g m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe SelectPetriInstance
 -> RandT g m (Maybe SelectPetriInstance))
-> Maybe SelectPetriInstance
-> RandT g m (Maybe SelectPetriInstance)
forall a b. (a -> b) -> a -> b
$ SelectPetriInstance -> Maybe SelectPetriInstance
forall a. a -> Maybe a
Just SelectPetriInstance
petriInst
    )
  case Maybe SelectPetriInstance
ad of
    Just SelectPetriInstance
x -> SelectPetriInstance -> RandT g m SelectPetriInstance
forall a. a -> RandT g m a
forall (m :: * -> *) a. Monad m => a -> m a
return SelectPetriInstance
x
    Maybe SelectPetriInstance
Nothing -> TaskGenerationException -> RandT g m SelectPetriInstance
forall e a. Exception e => e -> RandT g m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM TaskGenerationException
NoInstanceAvailable

defaultSelectPetriInstance :: SelectPetriInstance
defaultSelectPetriInstance :: SelectPetriInstance
defaultSelectPetriInstance =  SelectPetriInstance {
  $sel:activityDiagram:SelectPetriInstance :: UMLActivityDiagram
activityDiagram = UMLActivityDiagram {
    nodes :: [AdNode]
nodes = [
      AdActionNode {label :: Int
label = Int
1, name :: String
name = String
"A"},
      AdActionNode {label :: Int
label = Int
2, name :: String
name = String
"B"},
      AdActionNode {label :: Int
label = Int
3, name :: String
name = String
"E"},
      AdActionNode {label :: Int
label = Int
4, name :: String
name = String
"G"},
      AdObjectNode {label :: Int
label = Int
5, name :: String
name = String
"D"},
      AdObjectNode {label :: Int
label = Int
6, name :: String
name = String
"C"},
      AdObjectNode {label :: Int
label = Int
7, name :: String
name = String
"F"},
      AdObjectNode {label :: Int
label = Int
8, name :: String
name = String
"H"},
      AdDecisionNode {label :: Int
label = Int
9},
      AdDecisionNode {label :: Int
label = Int
10},
      AdMergeNode {label :: Int
label = Int
11},
      AdMergeNode {label :: Int
label = Int
12},
      AdForkNode {label :: Int
label = Int
13},
      AdJoinNode {label :: Int
label = Int
14},
      AdActivityFinalNode {label :: Int
label = Int
15},
      AdFlowFinalNode {label :: Int
label = Int
16},
      AdInitialNode {label :: Int
label = Int
17}
    ],
    connections :: [AdConnection]
connections = [
      AdConnection {from :: Int
from = Int
1, to :: Int
to = Int
12, guard :: String
guard = String
""},
      AdConnection {from :: Int
from = Int
2, to :: Int
to = Int
12, guard :: String
guard = String
""},
      AdConnection {from :: Int
from = Int
3, to :: Int
to = Int
10, guard :: String
guard = String
""},
      AdConnection {from :: Int
from = Int
4, to :: Int
to = Int
15, guard :: String
guard = String
""},
      AdConnection {from :: Int
from = Int
5, to :: Int
to = Int
14, 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
13, guard :: String
guard = String
""},
      AdConnection {from :: Int
from = Int
8, to :: Int
to = Int
4, guard :: String
guard = String
""},
      AdConnection {from :: Int
from = Int
9, to :: Int
to = Int
1, guard :: String
guard = String
"b"},
      AdConnection {from :: Int
from = Int
9, to :: Int
to = Int
2, guard :: String
guard = String
"a"},
      AdConnection {from :: Int
from = Int
10, to :: Int
to = Int
9, guard :: String
guard = String
"b"},
      AdConnection {from :: Int
from = Int
10, to :: Int
to = Int
11, guard :: String
guard = String
"a"},
      AdConnection {from :: Int
from = Int
11, to :: Int
to = Int
3, guard :: String
guard = String
""},
      AdConnection {from :: Int
from = Int
12, to :: Int
to = Int
8, guard :: String
guard = String
""},
      AdConnection {from :: Int
from = Int
13, to :: Int
to = Int
5, guard :: String
guard = String
""},
      AdConnection {from :: Int
from = Int
13, to :: Int
to = Int
6, 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
7, guard :: String
guard = String
""}
    ]
  },
  $sel:plantUMLConf:SelectPetriInstance :: PlantUmlConfig
plantUMLConf = PlantUmlConfig
defaultPlantUmlConfig,
  $sel:petriDrawConf:SelectPetriInstance :: 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:petriNets:SelectPetriInstance :: Map Int (Bool, SimplePetriLike PetriKey)
petriNets = [(Int, (Bool, SimplePetriLike PetriKey))]
-> Map Int (Bool, SimplePetriLike PetriKey)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [
    (Int
1,(Bool
False, 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 = AdActionNode {label :: Int
label = Int
2, name :: String
name = String
"B"}},
        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
9},Int
1)]}),
        (AuxiliaryPetriNode {$sel:label:AuxiliaryPetriNode :: Int
label = Int
2},
        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
24, $sel:sourceNode:AuxiliaryPetriNode :: AdNode
sourceNode = AdJoinNode {label :: Int
label = Int
12}},Int
1)]}),
        (NormalPetriNode {$sel:label:AuxiliaryPetriNode :: Int
label = Int
3, $sel:sourceNode:AuxiliaryPetriNode :: AdNode
sourceNode = AdActionNode {label :: Int
label = Int
8, 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 [(AuxiliaryPetriNode {$sel:label:AuxiliaryPetriNode :: Int
label = Int
18},Int
1)]}),
        (NormalPetriNode {$sel:label:AuxiliaryPetriNode :: Int
label = Int
4, $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 [(AuxiliaryPetriNode {$sel:label:AuxiliaryPetriNode :: Int
label = Int
6},Int
1),(AuxiliaryPetriNode {$sel:label:AuxiliaryPetriNode :: Int
label = Int
23},Int
1)]}),
        (AuxiliaryPetriNode {$sel:label:AuxiliaryPetriNode :: Int
label = Int
5},
        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
6, name :: String
name = String
"C"}},Int
1)]}),
        (AuxiliaryPetriNode {$sel:label:AuxiliaryPetriNode :: Int
label = Int
6},
        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
20, $sel:sourceNode:AuxiliaryPetriNode :: AdNode
sourceNode = AdDecisionNode {label :: Int
label = Int
9}},Int
1)]}),
        (NormalPetriNode {$sel:label:AuxiliaryPetriNode :: Int
label = Int
7, $sel:sourceNode:AuxiliaryPetriNode :: AdNode
sourceNode = AdActionNode {label :: Int
label = Int
6, 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 [(AuxiliaryPetriNode {$sel:label:AuxiliaryPetriNode :: Int
label = Int
12},Int
1)]}),
        (NormalPetriNode {$sel:label:AuxiliaryPetriNode :: Int
label = Int
8, $sel:sourceNode:AuxiliaryPetriNode :: AdNode
sourceNode = AdActionNode {label :: Int
label = Int
3, 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 [(NormalPetriNode {$sel:label:AuxiliaryPetriNode :: Int
label = Int
4, $sel:sourceNode:AuxiliaryPetriNode :: AdNode
sourceNode = AdDecisionNode {label :: Int
label = Int
10}},Int
1)]}),
        (AuxiliaryPetriNode {$sel:label:AuxiliaryPetriNode :: 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
24, $sel:sourceNode:AuxiliaryPetriNode :: AdNode
sourceNode = AdJoinNode {label :: Int
label = Int
12}},Int
1)]}),
        (AuxiliaryPetriNode {$sel:label:AuxiliaryPetriNode :: 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
3, $sel:sourceNode:AuxiliaryPetriNode :: AdNode
sourceNode = AdActionNode {label :: Int
label = Int
8, name :: String
name = String
"H"}},Int
1)]}),
        (NormalPetriNode {$sel:label:AuxiliaryPetriNode :: Int
label = Int
11, $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 [(NormalPetriNode {$sel:label:AuxiliaryPetriNode :: Int
label = Int
8, $sel:sourceNode:AuxiliaryPetriNode :: AdNode
sourceNode = AdActionNode {label :: Int
label = Int
3, name :: String
name = String
"E"}},Int
1)]}),
        (AuxiliaryPetriNode {$sel:label:AuxiliaryPetriNode :: 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 [(NormalPetriNode {$sel:label:AuxiliaryPetriNode :: Int
label = Int
14, $sel:sourceNode:AuxiliaryPetriNode :: AdNode
sourceNode = AdJoinNode {label :: Int
label = Int
14}},Int
1)]}),
        (NormalPetriNode {$sel:label:AuxiliaryPetriNode :: Int
label = Int
13, $sel:sourceNode:AuxiliaryPetriNode :: AdNode
sourceNode = AdActionNode {label :: Int
label = Int
4, name :: String
name = String
"G"}},
        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
14, $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
15, $sel:sourceNode:AuxiliaryPetriNode :: AdNode
sourceNode = AdObjectNode {label :: Int
label = Int
7, 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 [(NormalPetriNode {$sel:label:AuxiliaryPetriNode :: Int
label = Int
21, $sel:sourceNode:AuxiliaryPetriNode :: AdNode
sourceNode = AdForkNode {label :: Int
label = Int
13}},Int
1)]}),
        (NormalPetriNode {$sel:label:AuxiliaryPetriNode :: Int
label = Int
16, $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 [(AuxiliaryPetriNode {$sel:label:AuxiliaryPetriNode :: Int
label = Int
19},Int
1)]}),
        (NormalPetriNode {$sel:label:AuxiliaryPetriNode :: Int
label = Int
17, $sel:sourceNode:AuxiliaryPetriNode :: AdNode
sourceNode = AdActionNode {label :: Int
label = Int
1, 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
2},Int
1)]}),
        (AuxiliaryPetriNode {$sel:label:AuxiliaryPetriNode :: Int
label = Int
18},
        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
13, $sel:sourceNode:AuxiliaryPetriNode :: AdNode
sourceNode = AdActionNode {label :: Int
label = Int
4, name :: String
name = String
"G"}},Int
1)]}),
        (AuxiliaryPetriNode {$sel:label:AuxiliaryPetriNode :: Int
label = Int
19},
        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
15, $sel:sourceNode:AuxiliaryPetriNode :: AdNode
sourceNode = AdObjectNode {label :: Int
label = Int
7, name :: String
name = String
"F"}},Int
1)]}),
        (NormalPetriNode {$sel:label:AuxiliaryPetriNode :: Int
label = Int
20, $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
1, $sel:sourceNode:AuxiliaryPetriNode :: AdNode
sourceNode = AdActionNode {label :: Int
label = Int
2, name :: String
name = String
"B"}},Int
1),
            (NormalPetriNode {$sel:label:AuxiliaryPetriNode :: Int
label = Int
17, $sel:sourceNode:AuxiliaryPetriNode :: AdNode
sourceNode = AdActionNode {label :: Int
label = Int
1, name :: String
name = String
"A"}},Int
1)]}),
        (NormalPetriNode {$sel:label:AuxiliaryPetriNode :: Int
label = Int
21, $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 [(AuxiliaryPetriNode {$sel:label:AuxiliaryPetriNode :: Int
label = Int
5},Int
1),
            (NormalPetriNode {$sel:label:AuxiliaryPetriNode :: Int
label = Int
11, $sel:sourceNode:AuxiliaryPetriNode :: AdNode
sourceNode = AdMergeNode {label :: Int
label = Int
11}},Int
1),
            (NormalPetriNode {$sel:label:AuxiliaryPetriNode :: Int
label = Int
22, $sel:sourceNode:AuxiliaryPetriNode :: AdNode
sourceNode = AdObjectNode {label :: Int
label = Int
5, name :: String
name = String
"D"}},Int
1)]}),
        (NormalPetriNode {$sel:label:AuxiliaryPetriNode :: Int
label = Int
22, $sel:sourceNode:AuxiliaryPetriNode :: AdNode
sourceNode = AdObjectNode {label :: Int
label = Int
5, 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
14, $sel:sourceNode:AuxiliaryPetriNode :: AdNode
sourceNode = AdJoinNode {label :: Int
label = Int
14}},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
11, $sel:sourceNode:AuxiliaryPetriNode :: AdNode
sourceNode = AdMergeNode {label :: Int
label = Int
11}},Int
1)]}),
        (NormalPetriNode {$sel:label:AuxiliaryPetriNode :: Int
label = Int
24, $sel:sourceNode:AuxiliaryPetriNode :: AdNode
sourceNode = AdJoinNode {label :: Int
label = Int
12}},
        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
10},Int
1)]})
      ]
    }
  )),
  (Int
2,(Bool
True,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 = 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
3, $sel:sourceNode:AuxiliaryPetriNode :: AdNode
sourceNode = AdObjectNode {label :: Int
label = Int
5, name :: String
name = String
"D"}},Int
1),
          (NormalPetriNode {$sel:label:AuxiliaryPetriNode :: Int
label = Int
5, $sel:sourceNode:AuxiliaryPetriNode :: AdNode
sourceNode = AdObjectNode {label :: Int
label = Int
6, name :: String
name = String
"C"}},Int
1),
          (NormalPetriNode {$sel:label:AuxiliaryPetriNode :: Int
label = Int
12, $sel:sourceNode:AuxiliaryPetriNode :: AdNode
sourceNode = AdMergeNode {label :: Int
label = Int
11}},Int
1)]}),
      (AuxiliaryPetriNode {$sel:label:AuxiliaryPetriNode :: Int
label = Int
2},
      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
7, name :: String
name = String
"F"}},Int
1)]}),
      (NormalPetriNode {$sel:label:AuxiliaryPetriNode :: Int
label = Int
3, $sel:sourceNode:AuxiliaryPetriNode :: AdNode
sourceNode = AdObjectNode {label :: Int
label = Int
5, 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
19, $sel:sourceNode:AuxiliaryPetriNode :: AdNode
sourceNode = AdJoinNode {label :: Int
label = Int
14}},Int
1)]}),
      (NormalPetriNode {$sel:label:AuxiliaryPetriNode :: Int
label = Int
4, $sel:sourceNode:AuxiliaryPetriNode :: AdNode
sourceNode = AdActionNode {label :: Int
label = Int
4, name :: String
name = String
"G"}},
      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 = AdObjectNode {label :: Int
label = Int
6, name :: String
name = String
"C"}},
      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
19, $sel:sourceNode:AuxiliaryPetriNode :: AdNode
sourceNode = AdJoinNode {label :: Int
label = Int
14}},Int
1)]}),
      (NormalPetriNode {$sel:label:AuxiliaryPetriNode :: Int
label = Int
6, $sel:sourceNode:AuxiliaryPetriNode :: AdNode
sourceNode = AdObjectNode {label :: Int
label = Int
7, 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 [(NormalPetriNode {$sel:label:AuxiliaryPetriNode :: Int
label = Int
1, $sel:sourceNode:AuxiliaryPetriNode :: AdNode
sourceNode = AdForkNode {label :: Int
label = Int
13}},Int
1)]}),
      (NormalPetriNode {$sel:label:AuxiliaryPetriNode :: Int
label = Int
7, $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
9, $sel:sourceNode:AuxiliaryPetriNode :: AdNode
sourceNode = AdActionNode {label :: Int
label = Int
1, name :: String
name = String
"A"}},Int
1),
          (NormalPetriNode {$sel:label:AuxiliaryPetriNode :: Int
label = Int
11, $sel:sourceNode:AuxiliaryPetriNode :: AdNode
sourceNode = AdActionNode {label :: Int
label = Int
2, name :: String
name = String
"B"}},Int
1)]}),
      (NormalPetriNode {$sel:label:AuxiliaryPetriNode :: Int
label = Int
8, $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
18},Int
1)]}),
      (NormalPetriNode {$sel:label:AuxiliaryPetriNode :: Int
label = Int
9, $sel:sourceNode:AuxiliaryPetriNode :: AdNode
sourceNode = AdActionNode {label :: Int
label = Int
1, 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 [(NormalPetriNode {$sel:label:AuxiliaryPetriNode :: Int
label = Int
8, $sel:sourceNode:AuxiliaryPetriNode :: AdNode
sourceNode = AdMergeNode {label :: Int
label = Int
12}},Int
1)]}),
      (NormalPetriNode {$sel:label:AuxiliaryPetriNode :: Int
label = Int
10, $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 [(AuxiliaryPetriNode {$sel:label:AuxiliaryPetriNode :: Int
label = Int
2},Int
1)]}),
      (NormalPetriNode {$sel:label:AuxiliaryPetriNode :: Int
label = Int
11, $sel:sourceNode:AuxiliaryPetriNode :: AdNode
sourceNode = AdActionNode {label :: Int
label = Int
2, name :: String
name = String
"B"}},
      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
8, $sel:sourceNode:AuxiliaryPetriNode :: AdNode
sourceNode = AdMergeNode {label :: Int
label = Int
12}},Int
1)]}),
      (NormalPetriNode {$sel:label:AuxiliaryPetriNode :: Int
label = Int
12, $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 [(NormalPetriNode {$sel:label:AuxiliaryPetriNode :: Int
label = Int
15, $sel:sourceNode:AuxiliaryPetriNode :: AdNode
sourceNode = AdActionNode {label :: Int
label = Int
3, name :: String
name = String
"E"}},Int
1)]}),
      (AuxiliaryPetriNode {$sel:label:AuxiliaryPetriNode :: 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
7, $sel:sourceNode:AuxiliaryPetriNode :: AdNode
sourceNode = AdDecisionNode {label :: Int
label = Int
9}},Int
1)]}),
      (NormalPetriNode {$sel:label:AuxiliaryPetriNode :: Int
label = Int
14, $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 [(AuxiliaryPetriNode {$sel:label:AuxiliaryPetriNode :: Int
label = Int
13},Int
1), (AuxiliaryPetriNode {$sel:label:AuxiliaryPetriNode :: Int
label = Int
17},Int
1)]}),
      (NormalPetriNode {$sel:label:AuxiliaryPetriNode :: Int
label = Int
15, $sel:sourceNode:AuxiliaryPetriNode :: AdNode
sourceNode = AdActionNode {label :: Int
label = Int
3, 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 [(NormalPetriNode {$sel:label:AuxiliaryPetriNode :: Int
label = Int
14, $sel:sourceNode:AuxiliaryPetriNode :: AdNode
sourceNode = AdDecisionNode {label :: Int
label = Int
10}},Int
1)]}),
      (NormalPetriNode {$sel:label:AuxiliaryPetriNode :: Int
label = Int
16, $sel:sourceNode:AuxiliaryPetriNode :: AdNode
sourceNode = AdObjectNode {label :: Int
label = Int
8, name :: String
name = String
"H"}},
      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
4, $sel:sourceNode:AuxiliaryPetriNode :: AdNode
sourceNode = AdActionNode {label :: Int
label = Int
4, name :: String
name = String
"G"}},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
12, $sel:sourceNode:AuxiliaryPetriNode :: AdNode
sourceNode = AdMergeNode {label :: Int
label = Int
11}},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
16, $sel:sourceNode:AuxiliaryPetriNode :: AdNode
sourceNode = AdObjectNode {label :: Int
label = Int
8, name :: String
name = String
"H"}},Int
1)]}),
      (NormalPetriNode {$sel:label:AuxiliaryPetriNode :: Int
label = Int
19, $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})
    ]
  })),
  (Int
3,(Bool
False,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 = AdJoinNode {label :: Int
label = Int
12}},
      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
20, $sel:sourceNode:AuxiliaryPetriNode :: AdNode
sourceNode = AdObjectNode {label :: Int
label = Int
8, name :: String
name = String
"H"}},Int
1)]}),
      (AuxiliaryPetriNode {$sel:label:AuxiliaryPetriNode :: Int
label = Int
2},
      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 = AdDecisionNode {label :: Int
label = Int
9}},Int
1)]}),
      (NormalPetriNode {$sel:label:AuxiliaryPetriNode :: Int
label = Int
3, $sel:sourceNode:AuxiliaryPetriNode :: AdNode
sourceNode = AdActionNode {label :: Int
label = Int
3, 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 [(NormalPetriNode {$sel:label:AuxiliaryPetriNode :: Int
label = Int
12, $sel:sourceNode:AuxiliaryPetriNode :: AdNode
sourceNode = AdDecisionNode {label :: Int
label = Int
10}},Int
1)]}),
      (AuxiliaryPetriNode {$sel:label:AuxiliaryPetriNode :: Int
label = Int
4},
      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
"F"}},Int
1)]}),
      (AuxiliaryPetriNode {$sel:label:AuxiliaryPetriNode :: Int
label = Int
5},
      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
19, $sel:sourceNode:AuxiliaryPetriNode :: AdNode
sourceNode = AdMergeNode {label :: Int
label = Int
11}},Int
1)]}),
      (NormalPetriNode {$sel:label:AuxiliaryPetriNode :: Int
label = Int
6, $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 [(AuxiliaryPetriNode {$sel:label:AuxiliaryPetriNode :: Int
label = Int
8},Int
1),(AuxiliaryPetriNode {$sel:label:AuxiliaryPetriNode :: Int
label = Int
18},Int
1)]}),
      (NormalPetriNode {$sel:label:AuxiliaryPetriNode :: Int
label = Int
7, $sel:sourceNode:AuxiliaryPetriNode :: AdNode
sourceNode = AdObjectNode {label :: Int
label = Int
5, 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
11, $sel:sourceNode:AuxiliaryPetriNode :: AdNode
sourceNode = AdJoinNode {label :: Int
label = Int
14}},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
17, $sel:sourceNode:AuxiliaryPetriNode :: AdNode
sourceNode = AdObjectNode {label :: Int
label = Int
1, name :: String
name = String
"A"}},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
"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 [(NormalPetriNode {$sel:label:AuxiliaryPetriNode :: Int
label = Int
16, $sel:sourceNode:AuxiliaryPetriNode :: AdNode
sourceNode = AdForkNode {label :: Int
label = Int
13}},Int
1)]}),
      (NormalPetriNode {$sel:label:AuxiliaryPetriNode :: Int
label = Int
10, $sel:sourceNode:AuxiliaryPetriNode :: AdNode
sourceNode = AdActionNode {label :: Int
label = Int
4, name :: String
name = String
"G"}},
      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
11, $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
12, $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 [(AuxiliaryPetriNode {$sel:label:AuxiliaryPetriNode :: Int
label = Int
2},Int
1),(AuxiliaryPetriNode {$sel:label:AuxiliaryPetriNode :: Int
label = Int
5},Int
1)]}),
      (NormalPetriNode {$sel:label:AuxiliaryPetriNode :: Int
label = Int
13, $sel:sourceNode:AuxiliaryPetriNode :: AdNode
sourceNode = AdObjectNode {label :: Int
label = Int
6, name :: String
name = String
"C"}},
      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
11, $sel:sourceNode:AuxiliaryPetriNode :: AdNode
sourceNode = AdJoinNode {label :: Int
label = Int
14}},Int
1)]}),
      (NormalPetriNode {$sel:label:AuxiliaryPetriNode :: Int
label = Int
14, $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 [(AuxiliaryPetriNode {$sel:label:AuxiliaryPetriNode :: Int
label = Int
4},Int
1)]}),
      (NormalPetriNode {$sel:label:AuxiliaryPetriNode :: Int
label = Int
15, $sel:sourceNode:AuxiliaryPetriNode :: AdNode
sourceNode = AdObjectNode {label :: Int
label = Int
2, 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 [(NormalPetriNode {$sel:label:AuxiliaryPetriNode :: Int
label = Int
1, $sel:sourceNode:AuxiliaryPetriNode :: AdNode
sourceNode = AdJoinNode {label :: Int
label = Int
12}},Int
1)]}),
      (NormalPetriNode {$sel:label:AuxiliaryPetriNode :: Int
label = Int
16, $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
7, $sel:sourceNode:AuxiliaryPetriNode :: AdNode
sourceNode = AdObjectNode {label :: Int
label = Int
5, name :: String
name = String
"D"}},Int
1),
          (NormalPetriNode {$sel:label:AuxiliaryPetriNode :: Int
label = Int
13, $sel:sourceNode:AuxiliaryPetriNode :: AdNode
sourceNode = AdObjectNode {label :: Int
label = Int
6, name :: String
name = String
"C"}},Int
1),
          (NormalPetriNode {$sel:label:AuxiliaryPetriNode :: Int
label = Int
19, $sel:sourceNode:AuxiliaryPetriNode :: AdNode
sourceNode = AdMergeNode {label :: Int
label = Int
11}},Int
1)]}),
      (NormalPetriNode {$sel:label:AuxiliaryPetriNode :: Int
label = Int
17, $sel:sourceNode:AuxiliaryPetriNode :: AdNode
sourceNode = AdObjectNode {label :: Int
label = Int
1, name :: String
name = String
"A"}},
      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
1, $sel:sourceNode:AuxiliaryPetriNode :: AdNode
sourceNode = AdJoinNode {label :: Int
label = Int
12}},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
15, $sel:sourceNode:AuxiliaryPetriNode :: AdNode
sourceNode = AdObjectNode {label :: Int
label = Int
2, name :: String
name = String
"B"}},Int
1)]}),
      (NormalPetriNode {$sel:label:AuxiliaryPetriNode :: Int
label = Int
19, $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 [(NormalPetriNode {$sel:label:AuxiliaryPetriNode :: Int
label = Int
3, $sel:sourceNode:AuxiliaryPetriNode :: AdNode
sourceNode = AdActionNode {label :: Int
label = Int
3, name :: String
name = String
"E"}},Int
1)]}),
      (NormalPetriNode {$sel:label:AuxiliaryPetriNode :: Int
label = Int
20, $sel:sourceNode:AuxiliaryPetriNode :: AdNode
sourceNode = AdObjectNode {label :: Int
label = Int
8, name :: String
name = String
"H"}},
      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
4, name :: String
name = String
"G"}},Int
1)]})
    ]
  }))],
  $sel:showSolution:SelectPetriInstance :: Bool
showSolution = Bool
False,
  $sel:addText:SelectPetriInstance :: Maybe (Map Language String)
addText = Maybe (Map Language String)
forall a. Maybe a
Nothing
}