{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}

module Modelling.ActivityDiagram.Shuffle (
  shuffleAdLabels,
  shuffleAdNames,
  shufflePetri,
) where

import qualified Data.Map as M ((!), fromList, keys)
import qualified Modelling.ActivityDiagram.Datatype as Ad (AdNode (label))
import qualified Modelling.ActivityDiagram.PetriNet as PK (PetriKey(label))
import qualified Modelling.PetriNet.Types as PN (
  Net (..)
  )

import Modelling.ActivityDiagram.Datatype (
  UMLActivityDiagram(..),
  AdNode (..),
  AdConnection (..),
  isActionNode, isObjectNode)

import Modelling.ActivityDiagram.PetriNet (PetriKey (..), updatePetriKey)
import Modelling.PetriNet.Types (
  Net,
  )

import Control.Monad.Random (MonadRandom)
import Data.Map (Map)
import System.Random.Shuffle (shuffleM)


shuffleAdLabels
  :: (MonadRandom m)
  => UMLActivityDiagram
  -> m (Map Int Int, UMLActivityDiagram)
shuffleAdLabels :: forall (m :: * -> *).
MonadRandom m =>
UMLActivityDiagram -> m (Map Int Int, UMLActivityDiagram)
shuffleAdLabels UMLActivityDiagram
diag = do
  let labels :: [Int]
labels = (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
$ UMLActivityDiagram -> [AdNode]
nodes UMLActivityDiagram
diag
  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, Int)]) -> [Int] -> Map Int Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [Int] -> [(Int, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int]
labels ([Int] -> Map Int Int) -> m [Int] -> m (Map Int Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int] -> m [Int]
forall (m :: * -> *) a. MonadRandom m => [a] -> m [a]
shuffleM [Int]
labels
  let newNodes :: [AdNode]
newNodes = (AdNode -> AdNode) -> [AdNode] -> [AdNode]
forall a b. (a -> b) -> [a] -> [b]
map (Map Int Int -> AdNode -> AdNode
updateNodeLabel Map Int Int
relabeling) ([AdNode] -> [AdNode]) -> [AdNode] -> [AdNode]
forall a b. (a -> b) -> a -> b
$ UMLActivityDiagram -> [AdNode]
nodes UMLActivityDiagram
diag
      newConnections :: [AdConnection]
newConnections = (AdConnection -> AdConnection) -> [AdConnection] -> [AdConnection]
forall a b. (a -> b) -> [a] -> [b]
map (Map Int Int -> AdConnection -> AdConnection
updateConnection Map Int Int
relabeling) ([AdConnection] -> [AdConnection])
-> [AdConnection] -> [AdConnection]
forall a b. (a -> b) -> a -> b
$ UMLActivityDiagram -> [AdConnection]
connections UMLActivityDiagram
diag
  (Map Int Int, UMLActivityDiagram)
-> m (Map Int Int, UMLActivityDiagram)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Map Int Int
relabeling, UMLActivityDiagram {nodes :: [AdNode]
nodes=[AdNode]
newNodes, connections :: [AdConnection]
connections=[AdConnection]
newConnections})

updateNodeLabel :: Map Int Int -> AdNode -> AdNode
updateNodeLabel :: Map Int Int -> AdNode -> AdNode
updateNodeLabel Map Int Int
relabeling AdNode
node =
  case AdNode
node of
    AdActionNode {Int
label :: AdNode -> Int
label :: Int
label, String
name :: String
name :: AdNode -> String
name} -> AdActionNode {
      label :: Int
label = Int -> Int
relabel Int
label,
      name :: String
name = String
name
      }
    AdObjectNode {Int
label :: AdNode -> Int
label :: Int
label, String
name :: AdNode -> String
name :: String
name} -> AdObjectNode {
      label :: Int
label = Int -> Int
relabel Int
label,
      name :: String
name = String
name
      }
    AdDecisionNode {Int
label :: AdNode -> Int
label :: Int
label} -> AdDecisionNode {label :: Int
label = Int -> Int
relabel Int
label}
    AdMergeNode {Int
label :: AdNode -> Int
label :: Int
label} -> AdMergeNode {label :: Int
label = Int -> Int
relabel Int
label}
    AdForkNode {Int
label :: AdNode -> Int
label :: Int
label} -> AdForkNode {label :: Int
label = Int -> Int
relabel Int
label}
    AdJoinNode {Int
label :: AdNode -> Int
label :: Int
label} -> AdJoinNode {label :: Int
label = Int -> Int
relabel Int
label}
    AdInitialNode {Int
label :: AdNode -> Int
label :: Int
label} -> AdInitialNode {label :: Int
label = Int -> Int
relabel Int
label}
    AdActivityFinalNode {Int
label :: AdNode -> Int
label :: Int
label} -> AdActivityFinalNode {label :: Int
label = Int -> Int
relabel Int
label}
    AdFlowFinalNode {Int
label :: AdNode -> Int
label :: Int
label} -> AdFlowFinalNode {label :: Int
label = Int -> Int
relabel Int
label}
  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

updateConnection :: Map Int Int -> AdConnection -> AdConnection
updateConnection :: Map Int Int -> AdConnection -> AdConnection
updateConnection Map Int Int
relabeling AdConnection {Int
from :: Int
from :: AdConnection -> Int
from, Int
to :: Int
to :: AdConnection -> Int
to, String
guard :: String
guard :: AdConnection -> String
guard} =
  let newFrom :: Int
newFrom = Map Int Int
relabeling Map Int Int -> Int -> Int
forall k a. Ord k => Map k a -> k -> a
M.! Int
from
      newTo :: Int
newTo = Map Int Int
relabeling Map Int Int -> Int -> Int
forall k a. Ord k => Map k a -> k -> a
M.! Int
to
  in AdConnection {from :: Int
from=Int
newFrom, to :: Int
to=Int
newTo, guard :: String
guard=String
guard}


shuffleAdNames
  :: (MonadRandom m)
  => UMLActivityDiagram
  -> m (Map String String, UMLActivityDiagram)
shuffleAdNames :: forall (m :: * -> *).
MonadRandom m =>
UMLActivityDiagram -> m (Map String String, UMLActivityDiagram)
shuffleAdNames UMLActivityDiagram{[AdNode]
nodes :: UMLActivityDiagram -> [AdNode]
nodes :: [AdNode]
nodes, [AdConnection]
connections :: UMLActivityDiagram -> [AdConnection]
connections :: [AdConnection]
connections} = do
  let names :: [String]
names = (AdNode -> String) -> [AdNode] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map AdNode -> String
name ([AdNode] -> [String]) -> [AdNode] -> [String]
forall a b. (a -> b) -> a -> b
$ (AdNode -> Bool) -> [AdNode] -> [AdNode]
forall a. (a -> Bool) -> [a] -> [a]
filter (\AdNode
n -> AdNode -> Bool
isActionNode AdNode
n Bool -> Bool -> Bool
|| AdNode -> Bool
isObjectNode AdNode
n) [AdNode]
nodes
  Map String String
renaming <- [(String, String)] -> Map String String
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(String, String)] -> Map String String)
-> ([String] -> [(String, String)])
-> [String]
-> Map String String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String] -> [(String, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip [String]
names ([String] -> Map String String)
-> m [String] -> m (Map String String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String] -> m [String]
forall (m :: * -> *) a. MonadRandom m => [a] -> m [a]
shuffleM [String]
names
  let newNodes :: [AdNode]
newNodes = (AdNode -> AdNode) -> [AdNode] -> [AdNode]
forall a b. (a -> b) -> [a] -> [b]
map (Map String String -> AdNode -> AdNode
updateName Map String String
renaming) [AdNode]
nodes
  (Map String String, UMLActivityDiagram)
-> m (Map String String, UMLActivityDiagram)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Map String String
renaming, UMLActivityDiagram {nodes :: [AdNode]
nodes=[AdNode]
newNodes, connections :: [AdConnection]
connections=[AdConnection]
connections})

updateName :: Map String String -> AdNode -> AdNode
updateName :: Map String String -> AdNode -> AdNode
updateName Map String String
renaming AdNode
node =
  case AdNode
node of
    AdActionNode {Int
label :: AdNode -> Int
label :: Int
label, String
name :: AdNode -> String
name :: String
name} -> AdActionNode {label :: Int
label=Int
label, name :: String
name=String -> String
rename String
name}
    AdObjectNode {Int
label :: AdNode -> Int
label :: Int
label, String
name :: AdNode -> String
name :: String
name} -> AdObjectNode {label :: Int
label=Int
label, name :: String
name=String -> String
rename String
name}
    AdNode
_ -> AdNode
node
  where rename :: String -> String
rename String
s = Map String String
renaming Map String String -> String -> String
forall k a. Ord k => Map k a -> k -> a
M.! String
s


shufflePetri
  :: (MonadRandom m, Net p n)
  => p n PetriKey
  -> m (Map Int Int, p n PetriKey)
shufflePetri :: forall (m :: * -> *) (p :: (* -> *) -> * -> *) (n :: * -> *).
(MonadRandom m, Net p n) =>
p n PetriKey -> m (Map Int Int, p n PetriKey)
shufflePetri p n PetriKey
petri = do
  let labels :: [Int]
labels = (PetriKey -> Int) -> [PetriKey] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map PetriKey -> Int
PK.label ([PetriKey] -> [Int]) -> [PetriKey] -> [Int]
forall a b. (a -> b) -> a -> b
$ 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)
PN.nodes p n PetriKey
petri
  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, Int)]) -> [Int] -> Map Int Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [Int] -> [(Int, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int]
labels ([Int] -> Map Int Int) -> m [Int] -> m (Map Int Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int] -> m [Int]
forall (m :: * -> *) a. MonadRandom m => [a] -> m [a]
shuffleM [Int]
labels
  (Map Int Int, p n PetriKey) -> m (Map Int Int, p n PetriKey)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Map Int Int
relabeling, (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
PN.mapNet (Map Int Int -> PetriKey -> PetriKey
updatePetriKey Map Int Int
relabeling) p n PetriKey
petri)