{-# LANGUAGE UnicodeSyntax, FlexibleInstances, MultiParamTypeClasses, FlexibleContexts, GeneralizedNewtypeDeriving, StandaloneDeriving #-}
module GraphRewriting.Graph.Internal where

import Prelude.Unicode
import Control.Monad.State
import Data.IntMap as Map (IntMap, lookup)
import Data.IntSet (IntSet)
import Control.Monad.Reader


-- | Hypergraph that holds nodes of type @n@. Nodes can be referenced by type 'Node', edges by type 'Edge', see "GraphRewriting.Graph.Read" and "GraphRewriting.Graph.Write"
data Graph n = Graph {forall n. Graph n -> IntMap n
nodeMap ∷ IntMap n, forall n. Graph n -> IntMap IntSet
edgeMap ∷ IntMap IntSet, forall n. Graph n -> Int
nextKey ∷ Int}

newtype Rewrite n a = Rewrite {forall n a. Rewrite n a -> State (Graph n) a
rewrite ∷ State (Graph n) a}
	deriving (MonadState (Graph n), forall {n}. Applicative (Rewrite n)
forall a. a -> Rewrite n a
forall n a. a -> Rewrite n a
forall a b. Rewrite n a -> Rewrite n b -> Rewrite n b
forall a b. Rewrite n a -> (a -> Rewrite n b) -> Rewrite n b
forall n a b. Rewrite n a -> Rewrite n b -> Rewrite n b
forall n a b. Rewrite n a -> (a -> Rewrite n b) -> Rewrite n b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> Rewrite n a
$creturn :: forall n a. a -> Rewrite n a
>> :: forall a b. Rewrite n a -> Rewrite n b -> Rewrite n b
$c>> :: forall n a b. Rewrite n a -> Rewrite n b -> Rewrite n b
>>= :: forall a b. Rewrite n a -> (a -> Rewrite n b) -> Rewrite n b
$c>>= :: forall n a b. Rewrite n a -> (a -> Rewrite n b) -> Rewrite n b
Monad, forall a b. a -> Rewrite n b -> Rewrite n a
forall a b. (a -> b) -> Rewrite n a -> Rewrite n b
forall n a b. a -> Rewrite n b -> Rewrite n a
forall n a b. (a -> b) -> Rewrite n a -> Rewrite n b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Rewrite n b -> Rewrite n a
$c<$ :: forall n a b. a -> Rewrite n b -> Rewrite n a
fmap :: forall a b. (a -> b) -> Rewrite n a -> Rewrite n b
$cfmap :: forall n a b. (a -> b) -> Rewrite n a -> Rewrite n b
Functor, forall {n}. Monad (Rewrite n)
forall a. (a -> Rewrite n a) -> Rewrite n a
forall n a. (a -> Rewrite n a) -> Rewrite n a
forall (m :: * -> *).
Monad m -> (forall a. (a -> m a) -> m a) -> MonadFix m
mfix :: forall a. (a -> Rewrite n a) -> Rewrite n a
$cmfix :: forall n a. (a -> Rewrite n a) -> Rewrite n a
MonadFix)

instance MonadFail (Rewrite n) where fail :: forall a. String -> Rewrite n a
fail = forall a. HasCallStack => String -> a
error

deriving instance Applicative (Rewrite n)

newtype Node = Node {Node -> Int
nKey ∷ Int} deriving (Node -> Node -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Node -> Node -> Bool
$c/= :: Node -> Node -> Bool
== :: Node -> Node -> Bool
$c== :: Node -> Node -> Bool
Eq, Eq Node
Node -> Node -> Bool
Node -> Node -> Ordering
Node -> Node -> Node
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Node -> Node -> Node
$cmin :: Node -> Node -> Node
max :: Node -> Node -> Node
$cmax :: Node -> Node -> Node
>= :: Node -> Node -> Bool
$c>= :: Node -> Node -> Bool
> :: Node -> Node -> Bool
$c> :: Node -> Node -> Bool
<= :: Node -> Node -> Bool
$c<= :: Node -> Node -> Bool
< :: Node -> Node -> Bool
$c< :: Node -> Node -> Bool
compare :: Node -> Node -> Ordering
$ccompare :: Node -> Node -> Ordering
Ord) -- TODO: change this into Integer to avert overflow
newtype Port = Edge {Edge -> Int
eKey ∷ Int} deriving (Edge -> Edge -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Edge -> Edge -> Bool
$c/= :: Edge -> Edge -> Bool
== :: Edge -> Edge -> Bool
$c== :: Edge -> Edge -> Bool
Eq, Eq Edge
Edge -> Edge -> Bool
Edge -> Edge -> Ordering
Edge -> Edge -> Edge
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Edge -> Edge -> Edge
$cmin :: Edge -> Edge -> Edge
max :: Edge -> Edge -> Edge
$cmax :: Edge -> Edge -> Edge
>= :: Edge -> Edge -> Bool
$c>= :: Edge -> Edge -> Bool
> :: Edge -> Edge -> Bool
$c> :: Edge -> Edge -> Bool
<= :: Edge -> Edge -> Bool
$c<= :: Edge -> Edge -> Bool
< :: Edge -> Edge -> Bool
$c< :: Edge -> Edge -> Bool
compare :: Edge -> Edge -> Ordering
$ccompare :: Edge -> Edge -> Ordering
Ord) -- TODO: change this into Integer to avert overflow
type Edge = Port -- ^ a hyperedge really, connecting a non-empty subset of the graph's nodes (see 'attachedNodes')

instance Show Node where show :: Node -> String
show = forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. Node -> Int
nKey
instance Show Edge where show :: Edge -> String
show = forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. Edge -> Int
eKey

instance MonadReader (Graph n) (Rewrite n) where
	ask :: Rewrite n (Graph n)
ask = forall n a. State (Graph n) a -> Rewrite n a
Rewrite forall s (m :: * -> *). MonadState s m => m s
get
	local :: forall a. (Graph n -> Graph n) -> Rewrite n a -> Rewrite n a
local Graph n -> Graph n
f Rewrite n a
m = forall n a. State (Graph n) a -> Rewrite n a
Rewrite forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (forall s a. State s a -> s -> a
evalState (forall n a. Rewrite n a -> State (Graph n) a
rewrite Rewrite n a
m) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Graph n -> Graph n
f)

readRef ∷ MonadFail m ⇒ Int → IntMap a → m a
readRef :: forall (m :: * -> *) a. MonadFail m => Int -> IntMap a -> m a
readRef Int
key = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"readRef: referentiation failed") forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> IntMap a -> Maybe a
Map.lookup Int
key

readEdge ∷ MonadFail r ⇒ MonadReader (Graph n) r ⇒ Edge → r IntSet
readEdge :: forall (r :: * -> *) n.
(MonadFail r, MonadReader (Graph n) r) =>
Edge -> r IntSet
readEdge (Edge Int
e) = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"readEdge: edge with ID " forall α. [α] -> [α] -> [α]
⧺ forall a. Show a => a -> String
show Int
e forall α. [α] -> [α] -> [α]
⧺ String
" does not exist") forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadFail m => Int -> IntMap a -> m a
readRef Int
e forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks forall n. Graph n -> IntMap IntSet
edgeMap

modifyNodeMap ∷ (IntMap n → IntMap n) → Rewrite n ()
modifyNodeMap :: forall n. (IntMap n -> IntMap n) -> Rewrite n ()
modifyNodeMap IntMap n -> IntMap n
f = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \Graph n
g → Graph n
g {nodeMap :: IntMap n
nodeMap = IntMap n -> IntMap n
f forall a b. (a -> b) -> a -> b
$ forall n. Graph n -> IntMap n
nodeMap Graph n
g}

modifyEdgeMap ∷ (IntMap IntSet → IntMap IntSet) → Rewrite n ()
modifyEdgeMap :: forall n. (IntMap IntSet -> IntMap IntSet) -> Rewrite n ()
modifyEdgeMap IntMap IntSet -> IntMap IntSet
f = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \Graph n
g → Graph n
g {edgeMap :: IntMap IntSet
edgeMap = IntMap IntSet -> IntMap IntSet
f forall a b. (a -> b) -> a -> b
$ forall n. Graph n -> IntMap IntSet
edgeMap Graph n
g}

-- | allocate and reserve a new ref
newRef ∷ Rewrite n Int
newRef :: forall n. Rewrite n Int
newRef = do
	Int
i ← forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall n. Graph n -> Int
nextKey
	forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \Graph n
g → Graph n
g {nextKey :: Int
nextKey = Int
i forall a. Num a => a -> a -> a
+ Int
1}
	forall (m :: * -> *) a. Monad m => a -> m a
return Int
i

-- | Hand out an infinite number of fresh refs, without reserving them (obviously).
freeRefs ∷ MonadReader (Graph n) r ⇒ r [Int]
freeRefs :: forall n (r :: * -> *). MonadReader (Graph n) r => r [Int]
freeRefs = forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (forall a. Enum a => a -> [a]
enumFrom forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Graph n -> Int
nextKey)

reserveRefs ∷ [Int] → Rewrite n ()
reserveRefs :: forall n. [Int] -> Rewrite n ()
reserveRefs [Int]
refs = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \Graph n
g → Graph n
g {nextKey :: Int
nextKey = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Int]
refs}