{-# LANGUAGE UnicodeSyntax, FlexibleInstances, MultiParamTypeClasses, FlexibleContexts #-}
module GraphRewriting.Strategies.Control where

import Data.View
import GraphRewriting.Graph
--import GraphRewriting.Layout.PortSpec
import qualified Data.IntMap as Map

data Wrapper n = Wrapper {forall n. Wrapper n -> Control
control :: Control, forall n. Wrapper n -> n
wrapped :: n}

data Control = Control {Control -> [Node]
stack ∷ [Node]} | NoControl

instance {-# Overlapping #-} View Control (Wrapper n) where
	inspect :: Wrapper n -> Control
inspect = Wrapper n -> Control
forall n. Wrapper n -> Control
control
	update :: Control -> Wrapper n -> Wrapper n
update Control
c Wrapper n
n = Wrapper n
n {control = c}

instance View v n ⇒ View v (Wrapper n) where
	inspect :: Wrapper n -> v
inspect = n -> v
forall v n. View v n => n -> v
inspect (n -> v) -> (Wrapper n -> n) -> Wrapper n -> v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Wrapper n -> n
forall n. Wrapper n -> n
wrapped
	update :: v -> Wrapper n -> Wrapper n
update v
v Wrapper n
n = Wrapper n
n {wrapped = update v $ wrapped n}

-- | Wraps the nodes of a graph, augmenting them with control information
wrapGraph :: Graph n -> Graph (Wrapper n)
wrapGraph :: forall n. Graph n -> Graph (Wrapper n)
wrapGraph Graph n
graph = Graph n
graph {nodeMap = newNodeMap} where
		wrapNode :: n -> Wrapper n
wrapNode n
n = Wrapper {control :: Control
control = Control
NoControl, wrapped :: n
wrapped = n
n}
		rootNodeId :: Key
rootNodeId = [Key] -> Key
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum (IntMap n -> [Key]
forall a. IntMap a -> [Key]
Map.keys (IntMap n -> [Key]) -> IntMap n -> [Key]
forall a b. (a -> b) -> a -> b
$ Graph n -> IntMap n
forall n. Graph n -> IntMap n
nodeMap Graph n
graph)
		controlgraph :: Graph (Wrapper n)
controlgraph = (n -> Wrapper n) -> Graph n -> Graph (Wrapper n)
forall n n'. (n -> n') -> Graph n -> Graph n'
unsafeMapNodes n -> Wrapper n
forall {n}. n -> Wrapper n
wrapNode Graph n
graph
 		newNodeMap :: IntMap (Wrapper n)
newNodeMap = (Wrapper n -> Maybe (Wrapper n))
-> Key -> IntMap (Wrapper n) -> IntMap (Wrapper n)
forall a. (a -> Maybe a) -> Key -> IntMap a -> IntMap a
Map.update (\Wrapper n
x → Wrapper n -> Maybe (Wrapper n)
forall a. a -> Maybe a
Just (Wrapper n -> Maybe (Wrapper n)) -> Wrapper n -> Maybe (Wrapper n)
forall a b. (a -> b) -> a -> b
$ Wrapper n
x {control = Control []}) Key
rootNodeId (Graph (Wrapper n) -> IntMap (Wrapper n)
forall n. Graph n -> IntMap n
nodeMap Graph (Wrapper n)
controlgraph)