{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}

module Modelling.ActivityDiagram.PetriNet (
  PetriKey (..),
  convertToPetriNet,
  convertToSimple,
  isAuxiliaryPetriNode,
  updatePetriKey,
) where

import qualified Data.Map as M (
  (!),
  filter,
  foldrWithKey,
  fromList,
  keys,
  lookup,
  mapMaybeWithKey,
  )

import qualified Modelling.ActivityDiagram.Datatype as Ad (
  UMLActivityDiagram(..),
  AdNode (..),
  AdConnection (..)
  )

import Modelling.ActivityDiagram.Datatype (
  isActivityFinalNode,
  isFlowFinalNode,
  )
import Modelling.PetriNet.Types (
  Net (..),
  PetriNode (..),
  SimplePetriLike,
  )

import Data.Map (Map)
import Data.Maybe (fromMaybe)
import Data.List (find)
import GHC.Generics (Generic)


data PetriKey
  = AuxiliaryPetriNode {PetriKey -> Int
label :: Int}
  | FinalPetriNode {
    label :: Int,
    PetriKey -> AdNode
sourceNode :: Ad.AdNode
    }
  | NormalPetriNode {label :: Int, sourceNode :: Ad.AdNode}
  deriving ((forall x. PetriKey -> Rep PetriKey x)
-> (forall x. Rep PetriKey x -> PetriKey) -> Generic PetriKey
forall x. Rep PetriKey x -> PetriKey
forall x. PetriKey -> Rep PetriKey x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PetriKey -> Rep PetriKey x
from :: forall x. PetriKey -> Rep PetriKey x
$cto :: forall x. Rep PetriKey x -> PetriKey
to :: forall x. Rep PetriKey x -> PetriKey
Generic, PetriKey -> PetriKey -> Bool
(PetriKey -> PetriKey -> Bool)
-> (PetriKey -> PetriKey -> Bool) -> Eq PetriKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PetriKey -> PetriKey -> Bool
== :: PetriKey -> PetriKey -> Bool
$c/= :: PetriKey -> PetriKey -> Bool
/= :: PetriKey -> PetriKey -> Bool
Eq, ReadPrec [PetriKey]
ReadPrec PetriKey
Int -> ReadS PetriKey
ReadS [PetriKey]
(Int -> ReadS PetriKey)
-> ReadS [PetriKey]
-> ReadPrec PetriKey
-> ReadPrec [PetriKey]
-> Read PetriKey
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS PetriKey
readsPrec :: Int -> ReadS PetriKey
$creadList :: ReadS [PetriKey]
readList :: ReadS [PetriKey]
$creadPrec :: ReadPrec PetriKey
readPrec :: ReadPrec PetriKey
$creadListPrec :: ReadPrec [PetriKey]
readListPrec :: ReadPrec [PetriKey]
Read, Int -> PetriKey -> ShowS
[PetriKey] -> ShowS
PetriKey -> String
(Int -> PetriKey -> ShowS)
-> (PetriKey -> String) -> ([PetriKey] -> ShowS) -> Show PetriKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PetriKey -> ShowS
showsPrec :: Int -> PetriKey -> ShowS
$cshow :: PetriKey -> String
show :: PetriKey -> String
$cshowList :: [PetriKey] -> ShowS
showList :: [PetriKey] -> ShowS
Show)

instance Ord PetriKey where
  PetriKey
pk1 compare :: PetriKey -> PetriKey -> Ordering
`compare` PetriKey
pk2 = PetriKey -> Int
label PetriKey
pk1 Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` PetriKey -> Int
label PetriKey
pk2

isAuxiliaryPetriNode :: PetriKey -> Bool
isAuxiliaryPetriNode :: PetriKey -> Bool
isAuxiliaryPetriNode = \case
  AuxiliaryPetriNode {} -> Bool
True
  PetriKey
_ -> Bool
False

convertToSimple :: Ad.UMLActivityDiagram -> SimplePetriLike PetriKey
convertToSimple :: UMLActivityDiagram -> SimplePetriLike PetriKey
convertToSimple = UMLActivityDiagram -> SimplePetriLike PetriKey
forall (p :: (* -> *) -> * -> *) (n :: * -> *).
Net p n =>
UMLActivityDiagram -> p n PetriKey
convertToPetriNet

convertToPetriNet :: Net p n => Ad.UMLActivityDiagram -> p n PetriKey
convertToPetriNet :: forall (p :: (* -> *) -> * -> *) (n :: * -> *).
Net p n =>
UMLActivityDiagram -> p n PetriKey
convertToPetriNet UMLActivityDiagram
diag =
  let st_petri :: p n PetriKey
st_petri = (AdNode -> p n PetriKey -> p n PetriKey)
-> p n PetriKey -> [AdNode] -> p n PetriKey
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr AdNode -> p n PetriKey -> p n PetriKey
forall (p :: (* -> *) -> * -> *) (n :: * -> *).
Net p n =>
AdNode -> p n PetriKey -> p n PetriKey
insertNode p n PetriKey
forall a. p n a
forall (p :: (* -> *) -> * -> *) (n :: * -> *) a. Net p n => p n a
emptyNet (UMLActivityDiagram -> [AdNode]
Ad.nodes UMLActivityDiagram
diag)
      st_edges_petri :: p n PetriKey
st_edges_petri = (AdConnection -> p n PetriKey -> p n PetriKey)
-> p n PetriKey -> [AdConnection] -> p n PetriKey
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr AdConnection -> p n PetriKey -> p n PetriKey
forall (p :: (* -> *) -> * -> *) (n :: * -> *).
Net p n =>
AdConnection -> p n PetriKey -> p n PetriKey
insertEdge p n PetriKey
st_petri (UMLActivityDiagram -> [AdConnection]
Ad.connections UMLActivityDiagram
diag)
      auxiliaryPetri :: p n PetriKey
auxiliaryPetri = (PetriKey -> p n PetriKey -> p n PetriKey)
-> p n PetriKey -> [PetriKey] -> p n PetriKey
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
        PetriKey -> p n PetriKey -> p n PetriKey
forall (p :: (* -> *) -> * -> *) (n :: * -> *).
Net p n =>
PetriKey -> p n PetriKey -> p n PetriKey
addAuxiliaryPetriNode
        p n PetriKey
st_edges_petri
        (Map PetriKey (n PetriKey) -> [PetriKey]
forall k a. Map k a -> [k]
M.keys (Map PetriKey (n PetriKey) -> [PetriKey])
-> Map PetriKey (n PetriKey) -> [PetriKey]
forall a b. (a -> b) -> a -> b
$ p n PetriKey -> Map PetriKey (n PetriKey)
forall a. Ord a => p n a -> Map a (n a)
forall (p :: (* -> *) -> * -> *) (n :: * -> *) a.
(Net p n, Ord a) =>
p n a -> Map a (n a)
nodes p n PetriKey
st_edges_petri)
  in p n PetriKey -> p n PetriKey
forall (p :: (* -> *) -> * -> *) (n :: * -> *).
Net p n =>
p n PetriKey -> p n PetriKey
relabelPetri (p n PetriKey -> p n PetriKey) -> p n PetriKey -> p n PetriKey
forall a b. (a -> b) -> a -> b
$ p n PetriKey -> p n PetriKey
forall (p :: (* -> *) -> * -> *) (n :: * -> *).
Net p n =>
p n PetriKey -> p n PetriKey
removeFinalPlaces p n PetriKey
auxiliaryPetri

{-|
Relabel Petri net nodes in order to avoid "missing" numbers
resulting from the creation of sink transitions.
-}
relabelPetri
  :: Net p n
  => p n PetriKey
  -> p n PetriKey
relabelPetri :: forall (p :: (* -> *) -> * -> *) (n :: * -> *).
Net p n =>
p n PetriKey -> p n PetriKey
relabelPetri p n PetriKey
petri =
  let labels :: [Int]
labels = (PetriKey -> Int) -> [PetriKey] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map PetriKey -> Int
label ([PetriKey] -> [Int]) -> [PetriKey] -> [Int]
forall a b. (a -> b) -> a -> b
$ Map PetriKey (n PetriKey) -> [PetriKey]
forall k a. Map k a -> [k]
M.keys (Map PetriKey (n PetriKey) -> [PetriKey])
-> Map PetriKey (n PetriKey) -> [PetriKey]
forall a b. (a -> b) -> a -> b
$ p n PetriKey -> Map PetriKey (n PetriKey)
forall a. Ord a => p n a -> Map a (n a)
forall (p :: (* -> *) -> * -> *) (n :: * -> *) a.
(Net p n, Ord a) =>
p n a -> Map a (n a)
nodes p n PetriKey
petri
      relabeling :: Map Int Int
relabeling = [(Int, Int)] -> Map Int Int
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Int, Int)] -> Map Int Int) -> [(Int, Int)] -> Map Int Int
forall a b. (a -> b) -> a -> b
$ [Int] -> [Int] -> [(Int, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int]
labels [Int
1 ..]
  in (PetriKey -> PetriKey) -> p n PetriKey -> p n PetriKey
forall b a. Ord b => (a -> b) -> p n a -> p n b
forall (p :: (* -> *) -> * -> *) (n :: * -> *) b a.
(Net p n, Ord b) =>
(a -> b) -> p n a -> p n b
mapNet (Map Int Int -> PetriKey -> PetriKey
updatePetriKey Map Int Int
relabeling) p n PetriKey
petri

updatePetriKey :: Map Int Int -> PetriKey -> PetriKey
updatePetriKey :: Map Int Int -> PetriKey -> PetriKey
updatePetriKey Map Int Int
relabeling PetriKey
key =
  case PetriKey
key of
    NormalPetriNode {Int
$sel:label:AuxiliaryPetriNode :: PetriKey -> Int
label :: Int
label, AdNode
$sel:sourceNode:AuxiliaryPetriNode :: PetriKey -> AdNode
sourceNode :: AdNode
sourceNode} ->
      NormalPetriNode {$sel:label:AuxiliaryPetriNode :: Int
label = Int -> Int
relabel Int
label, $sel:sourceNode:AuxiliaryPetriNode :: AdNode
sourceNode = AdNode
sourceNode}
    AuxiliaryPetriNode {Int
$sel:label:AuxiliaryPetriNode :: PetriKey -> Int
label :: Int
label} -> AuxiliaryPetriNode {$sel:label:AuxiliaryPetriNode :: Int
label = Int -> Int
relabel Int
label}
    FinalPetriNode {Int
$sel:label:AuxiliaryPetriNode :: PetriKey -> Int
label :: Int
label, AdNode
$sel:sourceNode:AuxiliaryPetriNode :: PetriKey -> AdNode
sourceNode :: AdNode
sourceNode} ->
      FinalPetriNode {$sel:label:AuxiliaryPetriNode :: Int
label = Int -> Int
relabel Int
label, $sel:sourceNode:AuxiliaryPetriNode :: AdNode
sourceNode = AdNode
sourceNode}
  where relabel :: Int -> Int
relabel Int
n = Map Int Int
relabeling Map Int Int -> Int -> Int
forall k a. Ord k => Map k a -> k -> a
M.! Int
n

removeFinalPlaces
  :: Net p n
  => p n PetriKey
  -> p n PetriKey
removeFinalPlaces :: forall (p :: (* -> *) -> * -> *) (n :: * -> *).
Net p n =>
p n PetriKey -> p n PetriKey
removeFinalPlaces p n PetriKey
petri = (PetriKey -> p n PetriKey -> p n PetriKey)
-> p n PetriKey -> [PetriKey] -> p n PetriKey
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr PetriKey -> p n PetriKey -> p n PetriKey
forall (p :: (* -> *) -> * -> *) (n :: * -> *).
Net p n =>
PetriKey -> p n PetriKey -> p n PetriKey
removeIfFinal p n PetriKey
petri (Map PetriKey (n PetriKey) -> [PetriKey]
forall k a. Map k a -> [k]
M.keys (Map PetriKey (n PetriKey) -> [PetriKey])
-> Map PetriKey (n PetriKey) -> [PetriKey]
forall a b. (a -> b) -> a -> b
$ p n PetriKey -> Map PetriKey (n PetriKey)
forall a. Ord a => p n a -> Map a (n a)
forall (p :: (* -> *) -> * -> *) (n :: * -> *) a.
(Net p n, Ord a) =>
p n a -> Map a (n a)
nodes p n PetriKey
petri)

{-|
Removes normal nodes that reference final nodes in the activity diagram.
'FinalPetriNodes' are not removed!
(i.e only places at the end are removed, transitions are kept)
-}
removeIfFinal
  :: Net p n
  => PetriKey
  -> p n PetriKey
  -> p n PetriKey
removeIfFinal :: forall (p :: (* -> *) -> * -> *) (n :: * -> *).
Net p n =>
PetriKey -> p n PetriKey -> p n PetriKey
removeIfFinal PetriKey
key =
  case PetriKey
key of
    AuxiliaryPetriNode {} -> p n PetriKey -> p n PetriKey
forall a. a -> a
id
    FinalPetriNode {} -> p n PetriKey -> p n PetriKey
forall a. a -> a
id
    NormalPetriNode {AdNode
$sel:sourceNode:AuxiliaryPetriNode :: PetriKey -> AdNode
sourceNode :: AdNode
sourceNode} ->
      if AdNode -> Bool
isActivityFinalNode AdNode
sourceNode Bool -> Bool -> Bool
|| AdNode -> Bool
isFlowFinalNode AdNode
sourceNode
      then PetriKey -> p n PetriKey -> p n PetriKey
forall a. Ord a => a -> p n a -> p n a
forall (p :: (* -> *) -> * -> *) (n :: * -> *) a.
(Net p n, Ord a) =>
a -> p n a -> p n a
deleteNode PetriKey
key
      else p n PetriKey -> p n PetriKey
forall a. a -> a
id

addAuxiliaryPetriNode :: Net p n => PetriKey -> p n PetriKey -> p n PetriKey
addAuxiliaryPetriNode :: forall (p :: (* -> *) -> * -> *) (n :: * -> *).
Net p n =>
PetriKey -> p n PetriKey -> p n PetriKey
addAuxiliaryPetriNode PetriKey
sourceKey p n PetriKey
petri =
  let petriSourceNode :: n PetriKey
petriSourceNode = p n PetriKey -> Map PetriKey (n PetriKey)
forall a. Ord a => p n a -> Map a (n a)
forall (p :: (* -> *) -> * -> *) (n :: * -> *) a.
(Net p n, Ord a) =>
p n a -> Map a (n a)
nodes p n PetriKey
petri Map PetriKey (n PetriKey) -> PetriKey -> n PetriKey
forall k a. Ord k => Map k a -> k -> a
M.! PetriKey
sourceKey
      fn :: n a -> Bool
fn = if n PetriKey -> Bool
forall a. n a -> Bool
forall (n :: * -> *) a. PetriNode n => n a -> Bool
isPlaceNode n PetriKey
petriSourceNode then n a -> Bool
forall a. n a -> Bool
forall (n :: * -> *) a. PetriNode n => n a -> Bool
isPlaceNode else n a -> Bool
forall a. n a -> Bool
forall (n :: * -> *) a. PetriNode n => n a -> Bool
isTransitionNode
      nodesToBeFixed :: Map PetriKey (n PetriKey)
nodesToBeFixed = (n PetriKey -> Bool)
-> Map PetriKey (n PetriKey) -> Map PetriKey (n PetriKey)
forall a k. (a -> Bool) -> Map k a -> Map k a
M.filter n PetriKey -> Bool
forall a. n a -> Bool
fn
        (Map PetriKey (n PetriKey) -> Map PetriKey (n PetriKey))
-> Map PetriKey (n PetriKey) -> Map PetriKey (n PetriKey)
forall a b. (a -> b) -> a -> b
$ (PetriKey -> Int -> Maybe (n PetriKey))
-> Map PetriKey Int -> Map PetriKey (n PetriKey)
forall k a b. (k -> a -> Maybe b) -> Map k a -> Map k b
M.mapMaybeWithKey (\PetriKey
k Int
_ -> PetriKey -> Map PetriKey (n PetriKey) -> Maybe (n PetriKey)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup PetriKey
k (p n PetriKey -> Map PetriKey (n PetriKey)
forall a. Ord a => p n a -> Map a (n a)
forall (p :: (* -> *) -> * -> *) (n :: * -> *) a.
(Net p n, Ord a) =>
p n a -> Map a (n a)
nodes p n PetriKey
petri))
        (Map PetriKey Int -> Map PetriKey (n PetriKey))
-> Map PetriKey Int -> Map PetriKey (n PetriKey)
forall a b. (a -> b) -> a -> b
$ PetriKey -> p n PetriKey -> Map PetriKey Int
forall a. Ord a => a -> p n a -> Map a Int
forall (p :: (* -> *) -> * -> *) (n :: * -> *) a.
(Net p n, Ord a) =>
a -> p n a -> Map a Int
outFlow PetriKey
sourceKey p n PetriKey
petri
  in (PetriKey -> n PetriKey -> p n PetriKey -> p n PetriKey)
-> p n PetriKey -> Map PetriKey (n PetriKey) -> p n PetriKey
forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
M.foldrWithKey (PetriKey -> PetriKey -> n PetriKey -> p n PetriKey -> p n PetriKey
forall (p :: (* -> *) -> * -> *) (n :: * -> *).
Net p n =>
PetriKey -> PetriKey -> n PetriKey -> p n PetriKey -> p n PetriKey
addAuxiliaryPetriNode' PetriKey
sourceKey) p n PetriKey
petri Map PetriKey (n PetriKey)
nodesToBeFixed

{-|
Add a 'FinalPetriNode' instead of a 'AuxiliaryPetriNode'
if the target is a final node in the activity diagram.
-}
addAuxiliaryPetriNode'
  :: Net p n
  => PetriKey
  -> PetriKey
  -> n PetriKey
  -> p n PetriKey
  -> p n PetriKey
addAuxiliaryPetriNode' :: forall (p :: (* -> *) -> * -> *) (n :: * -> *).
Net p n =>
PetriKey -> PetriKey -> n PetriKey -> p n PetriKey -> p n PetriKey
addAuxiliaryPetriNode' PetriKey
sourceKey PetriKey
targetKey n PetriKey
targetNode p n PetriKey
petri =
  PetriKey -> Int -> PetriKey -> p n PetriKey -> p n PetriKey
forall a. Ord a => a -> Int -> a -> p n a -> p n a
forall (p :: (* -> *) -> * -> *) (n :: * -> *) a.
(Net p n, Ord a) =>
a -> Int -> a -> p n a -> p n a
alterFlow PetriKey
supportKey Int
1 PetriKey
targetKey
  (p n PetriKey -> p n PetriKey)
-> (p n PetriKey -> p n PetriKey) -> p n PetriKey -> p n PetriKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PetriKey -> Int -> PetriKey -> p n PetriKey -> p n PetriKey
forall a. Ord a => a -> Int -> a -> p n a -> p n a
forall (p :: (* -> *) -> * -> *) (n :: * -> *) a.
(Net p n, Ord a) =>
a -> Int -> a -> p n a -> p n a
alterFlow PetriKey
sourceKey Int
1 PetriKey
supportKey
  (p n PetriKey -> p n PetriKey)
-> (p n PetriKey -> p n PetriKey) -> p n PetriKey -> p n PetriKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PetriKey -> Maybe Int -> p n PetriKey -> p n PetriKey
forall a. Ord a => a -> Maybe Int -> p n a -> p n a
forall (p :: (* -> *) -> * -> *) (n :: * -> *) a.
(Net p n, Ord a) =>
a -> Maybe Int -> p n a -> p n a
alterNode PetriKey
supportKey (if n PetriKey -> Bool
forall a. n a -> Bool
forall (n :: * -> *) a. PetriNode n => n a -> Bool
isPlaceNode n PetriKey
targetNode then Maybe Int
forall a. Maybe a
Nothing else Int -> Maybe Int
forall a. a -> Maybe a
Just Int
0)
  (p n PetriKey -> p n PetriKey)
-> (p n PetriKey -> p n PetriKey) -> p n PetriKey -> p n PetriKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PetriKey -> PetriKey -> p n PetriKey -> p n PetriKey
forall a. Ord a => a -> a -> p n a -> p n a
forall (p :: (* -> *) -> * -> *) (n :: * -> *) a.
(Net p n, Ord a) =>
a -> a -> p n a -> p n a
deleteFlow PetriKey
sourceKey PetriKey
targetKey
  (p n PetriKey -> p n PetriKey) -> p n PetriKey -> p n PetriKey
forall a b. (a -> b) -> a -> b
$ p n PetriKey
petri
  where
    label' :: Int
label' = (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (PetriKey -> Int) -> [PetriKey] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map PetriKey -> Int
label ([PetriKey] -> [Int]) -> [PetriKey] -> [Int]
forall a b. (a -> b) -> a -> b
$ Map PetriKey (n PetriKey) -> [PetriKey]
forall k a. Map k a -> [k]
M.keys (Map PetriKey (n PetriKey) -> [PetriKey])
-> Map PetriKey (n PetriKey) -> [PetriKey]
forall a b. (a -> b) -> a -> b
$ p n PetriKey -> Map PetriKey (n PetriKey)
forall a. Ord a => p n a -> Map a (n a)
forall (p :: (* -> *) -> * -> *) (n :: * -> *) a.
(Net p n, Ord a) =>
p n a -> Map a (n a)
nodes p n PetriKey
petri
    targetAdNode :: AdNode
targetAdNode = PetriKey -> AdNode
sourceNode PetriKey
targetKey
    supportKey :: PetriKey
supportKey
      | AdNode -> Bool
isFlowFinalNode AdNode
targetAdNode Bool -> Bool -> Bool
|| AdNode -> Bool
isActivityFinalNode AdNode
targetAdNode
      = FinalPetriNode {$sel:label:AuxiliaryPetriNode :: Int
label = Int
label', $sel:sourceNode:AuxiliaryPetriNode :: AdNode
sourceNode = AdNode
targetAdNode}
      | Bool
otherwise
      = AuxiliaryPetriNode {$sel:label:AuxiliaryPetriNode :: Int
label = Int
label'}

insertNode
  :: Net p n
  => Ad.AdNode
  -> p n PetriKey
  -> p n PetriKey
insertNode :: forall (p :: (* -> *) -> * -> *) (n :: * -> *).
Net p n =>
AdNode -> p n PetriKey -> p n PetriKey
insertNode =
  (PetriKey -> Maybe Int -> p n PetriKey -> p n PetriKey)
-> (PetriKey, Maybe Int) -> p n PetriKey -> p n PetriKey
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry PetriKey -> Maybe Int -> p n PetriKey -> p n PetriKey
forall a. Ord a => a -> Maybe Int -> p n a -> p n a
forall (p :: (* -> *) -> * -> *) (n :: * -> *) a.
(Net p n, Ord a) =>
a -> Maybe Int -> p n a -> p n a
alterNode ((PetriKey, Maybe Int) -> p n PetriKey -> p n PetriKey)
-> (AdNode -> (PetriKey, Maybe Int))
-> AdNode
-> p n PetriKey
-> p n PetriKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AdNode -> (PetriKey, Maybe Int)
nodeToPetriNode

nodeToPetriNode :: Ad.AdNode -> (PetriKey, Maybe Int)
nodeToPetriNode :: AdNode -> (PetriKey, Maybe Int)
nodeToPetriNode AdNode
node =
  case AdNode
node of
    Ad.AdInitialNode {Int
label :: Int
label :: AdNode -> Int
label} -> (
      NormalPetriNode {$sel:label:AuxiliaryPetriNode :: Int
label = Int
label, $sel:sourceNode:AuxiliaryPetriNode :: AdNode
sourceNode = AdNode
node},
      Int -> Maybe Int
forall a. a -> Maybe a
Just Int
1
      )
    Ad.AdActionNode {Int
label :: AdNode -> Int
label :: Int
label} -> (
      NormalPetriNode {$sel:label:AuxiliaryPetriNode :: Int
label = Int
label, $sel:sourceNode:AuxiliaryPetriNode :: AdNode
sourceNode = AdNode
node},
      Maybe Int
forall a. Maybe a
Nothing
      )
    Ad.AdObjectNode {Int
label :: AdNode -> Int
label :: Int
label} -> (
      NormalPetriNode {$sel:label:AuxiliaryPetriNode :: Int
label = Int
label, $sel:sourceNode:AuxiliaryPetriNode :: AdNode
sourceNode = AdNode
node},
      Int -> Maybe Int
forall a. a -> Maybe a
Just Int
0
      )
    Ad.AdDecisionNode {Int
label :: AdNode -> Int
label :: Int
label} -> (
      NormalPetriNode {$sel:label:AuxiliaryPetriNode :: Int
label = Int
label, $sel:sourceNode:AuxiliaryPetriNode :: AdNode
sourceNode = AdNode
node},
      Int -> Maybe Int
forall a. a -> Maybe a
Just Int
0
      )
    Ad.AdMergeNode {Int
label :: AdNode -> Int
label :: Int
label} -> (
      NormalPetriNode {$sel:label:AuxiliaryPetriNode :: Int
label = Int
label, $sel:sourceNode:AuxiliaryPetriNode :: AdNode
sourceNode = AdNode
node},
      Int -> Maybe Int
forall a. a -> Maybe a
Just Int
0
      )
    Ad.AdForkNode {Int
label :: AdNode -> Int
label :: Int
label} -> (
      NormalPetriNode {$sel:label:AuxiliaryPetriNode :: Int
label = Int
label, $sel:sourceNode:AuxiliaryPetriNode :: AdNode
sourceNode = AdNode
node},
      Maybe Int
forall a. Maybe a
Nothing
      )
    Ad.AdJoinNode {Int
label :: AdNode -> Int
label :: Int
label} -> (
      NormalPetriNode {$sel:label:AuxiliaryPetriNode :: Int
label = Int
label, $sel:sourceNode:AuxiliaryPetriNode :: AdNode
sourceNode = AdNode
node},
      Maybe Int
forall a. Maybe a
Nothing
      )
    Ad.AdActivityFinalNode {Int
label :: AdNode -> Int
label :: Int
label} -> (
      NormalPetriNode {$sel:label:AuxiliaryPetriNode :: Int
label = Int
label, $sel:sourceNode:AuxiliaryPetriNode :: AdNode
sourceNode = AdNode
node},
      Int -> Maybe Int
forall a. a -> Maybe a
Just Int
0
      )
    Ad.AdFlowFinalNode {Int
label :: AdNode -> Int
label :: Int
label} -> (
      NormalPetriNode {$sel:label:AuxiliaryPetriNode :: Int
label = Int
label, $sel:sourceNode:AuxiliaryPetriNode :: AdNode
sourceNode = AdNode
node},
      Int -> Maybe Int
forall a. a -> Maybe a
Just Int
0
      )

insertEdge
  :: Net p n
  => Ad.AdConnection
  -> p n PetriKey
  -> p n PetriKey
insertEdge :: forall (p :: (* -> *) -> * -> *) (n :: * -> *).
Net p n =>
AdConnection -> p n PetriKey -> p n PetriKey
insertEdge AdConnection
edge p n PetriKey
petri = p n PetriKey -> Maybe (p n PetriKey) -> p n PetriKey
forall a. a -> Maybe a -> a
fromMaybe p n PetriKey
petri (Maybe (p n PetriKey) -> p n PetriKey)
-> Maybe (p n PetriKey) -> p n PetriKey
forall a b. (a -> b) -> a -> b
$ do
  PetriKey
sourceKey <- (PetriKey -> Bool) -> [PetriKey] -> Maybe PetriKey
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\PetriKey
k -> PetriKey -> Int
label PetriKey
k Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== AdConnection -> Int
Ad.from AdConnection
edge) ([PetriKey] -> Maybe PetriKey) -> [PetriKey] -> Maybe PetriKey
forall a b. (a -> b) -> a -> b
$ Map PetriKey (n PetriKey) -> [PetriKey]
forall k a. Map k a -> [k]
M.keys (Map PetriKey (n PetriKey) -> [PetriKey])
-> Map PetriKey (n PetriKey) -> [PetriKey]
forall a b. (a -> b) -> a -> b
$ p n PetriKey -> Map PetriKey (n PetriKey)
forall a. Ord a => p n a -> Map a (n a)
forall (p :: (* -> *) -> * -> *) (n :: * -> *) a.
(Net p n, Ord a) =>
p n a -> Map a (n a)
nodes p n PetriKey
petri
  PetriKey
targetKey <- (PetriKey -> Bool) -> [PetriKey] -> Maybe PetriKey
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\PetriKey
k -> PetriKey -> Int
label PetriKey
k Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== AdConnection -> Int
Ad.to AdConnection
edge) ([PetriKey] -> Maybe PetriKey) -> [PetriKey] -> Maybe PetriKey
forall a b. (a -> b) -> a -> b
$ Map PetriKey (n PetriKey) -> [PetriKey]
forall k a. Map k a -> [k]
M.keys (Map PetriKey (n PetriKey) -> [PetriKey])
-> Map PetriKey (n PetriKey) -> [PetriKey]
forall a b. (a -> b) -> a -> b
$ p n PetriKey -> Map PetriKey (n PetriKey)
forall a. Ord a => p n a -> Map a (n a)
forall (p :: (* -> *) -> * -> *) (n :: * -> *) a.
(Net p n, Ord a) =>
p n a -> Map a (n a)
nodes p n PetriKey
petri
  p n PetriKey -> Maybe (p n PetriKey)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (p n PetriKey -> Maybe (p n PetriKey))
-> p n PetriKey -> Maybe (p n PetriKey)
forall a b. (a -> b) -> a -> b
$ PetriKey -> Int -> PetriKey -> p n PetriKey -> p n PetriKey
forall a. Ord a => a -> Int -> a -> p n a -> p n a
forall (p :: (* -> *) -> * -> *) (n :: * -> *) a.
(Net p n, Ord a) =>
a -> Int -> a -> p n a -> p n a
alterFlow PetriKey
sourceKey Int
1 PetriKey
targetKey p n PetriKey
petri