{-# LANGUAGE UnicodeSyntax, FlexibleContexts, FlexibleInstances, TypeSynonymInstances, MultiParamTypeClasses, ScopedTypeVariables #-}

-- | Enquiry of the graph structure. Note: In this module the term "node" is often used synonymously to "node reference" and "node value". The two can easily distinguished by their type: the former has type 'Node' the latter usually 'n'.
module GraphRewriting.Graph.Read
	(module Data.View,
	 module GraphRewriting.Graph.Types,
	 module GraphRewriting.Graph.Read)
where

import Prelude.Unicode
import GraphRewriting.Graph.Types
import GraphRewriting.Graph.Internal
import Control.Monad.Reader
import qualified Data.IntMap as Map
import qualified Data.IntSet as Set
import Data.View
import Data.List (nub)


type WithGraph n = Reader (Graph n)

-- | This forces the use of the 'Reader' monad. Wrapping a sequence of monadic read-only operations (such as those defined below) into a read-only block can save much overhead e.g. in the state monad.
readOnly ∷ MonadReader (Graph n) m ⇒ Reader (Graph n) a → m a
readOnly :: forall n (m :: * -> *) a.
MonadReader (Graph n) m =>
Reader (Graph n) a -> m a
readOnly Reader (Graph n) a
r = forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (forall r a. Reader r a -> r -> a
runReader Reader (Graph n) a
r) forall r (m :: * -> *). MonadReader r m => m r
ask

existNode ∷ MonadReader (Graph n) m ⇒ Node → m Bool
existNode :: forall n (m :: * -> *). MonadReader (Graph n) m => Node -> m Bool
existNode (Node Int
n) = forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (forall a. Int -> IntMap a -> Bool
Map.member Int
n) (forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks forall n. Graph n -> IntMap n
nodeMap)

readNode ∷ (MonadReader (Graph n) m, MonadFail m) ⇒ Node → m n
readNode :: forall n (m :: * -> *).
(MonadReader (Graph n) m, MonadFail m) =>
Node -> m n
readNode (Node Int
n) = 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
"readNode: node with ID " forall α. [α] -> [α] -> [α]
⧺ forall a. Show a => a -> String
show Int
n 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
n 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 n
nodeMap

-- | a wrapper to 'inspect' the given node
inspectNode ∷ (View v n, MonadReader (Graph n) m, MonadFail m) ⇒ Node → m v
inspectNode :: forall v n (m :: * -> *).
(View v n, MonadReader (Graph n) m, MonadFail m) =>
Node -> m v
inspectNode = forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall v n. View v n => n -> v
inspect forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n (m :: * -> *).
(MonadReader (Graph n) m, MonadFail m) =>
Node -> m n
readNode

-- | a wrapper to 'examine' the given node
examineNode ∷ (View v n, MonadReader (Graph n) m, MonadFail m) ⇒ (v → a) → Node → m a
examineNode :: forall v n (m :: * -> *) a.
(View v n, MonadReader (Graph n) m, MonadFail m) =>
(v -> a) -> Node -> m a
examineNode v -> a
f = forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (forall v n field. View v n => (v -> field) -> n -> field
examine v -> a
f) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n (m :: * -> *).
(MonadReader (Graph n) m, MonadFail m) =>
Node -> m n
readNode

-- | all of the graph's nodes
readNodeList ∷ MonadReader (Graph n) m ⇒ m [Node]
readNodeList :: forall n (m :: * -> *). MonadReader (Graph n) m => m [Node]
readNodeList = forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (forall a b. (a -> b) -> [a] -> [b]
map Int -> Node
Node forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IntMap a -> [Int]
Map.keys) (forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks forall n. Graph n -> IntMap n
nodeMap)

-- | all of the graph's edges
readEdgeList ∷ MonadReader (Graph n) m ⇒ m [Edge]
readEdgeList :: forall n (m :: * -> *). MonadReader (Graph n) m => m [Edge]
readEdgeList = forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (forall a b. (a -> b) -> [a] -> [b]
map Int -> Edge
Edge forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IntMap a -> [Int]
Map.keys) (forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks forall n. Graph n -> IntMap IntSet
edgeMap)

-- | edges attached to the given node
attachedEdges ∷ (View [Port] n, MonadReader (Graph n) m, MonadFail m) ⇒ Node → m [Edge]
attachedEdges :: forall n (m :: * -> *).
(View [Edge] n, MonadReader (Graph n) m, MonadFail m) =>
Node -> m [Edge]
attachedEdges = forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall a. Eq a => [a] -> [a]
nub forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v n (m :: * -> *).
(View v n, MonadReader (Graph n) m, MonadFail m) =>
Node -> m v
inspectNode

-- | non-empty set of nodes attached to the given edge
attachedNodes ∷ (MonadReader (Graph n) m, MonadFail m) ⇒ Edge → m [Node]
attachedNodes :: forall n (m :: * -> *).
(MonadReader (Graph n) m, MonadFail m) =>
Edge -> m [Node]
attachedNodes = forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (forall a b. (a -> b) -> [a] -> [b]
map Int -> Node
Node forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntSet -> [Int]
Set.elems) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (r :: * -> *) n.
(MonadFail r, MonadReader (Graph n) r) =>
Edge -> r IntSet
readEdge

-- | amount of ports the given hyperedge is connected to
edgeCardinality ∷ (View [Port] n, MonadReader (Graph n) m, MonadFail m) ⇒ Edge → m Int
edgeCardinality :: forall n (m :: * -> *).
(View [Edge] n, MonadReader (Graph n) m, MonadFail m) =>
Edge -> m Int
edgeCardinality Edge
e = forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (forall (t :: * -> *) a. Foldable t => t a -> Int
length forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (Edge
e forall α. Eq α => α -> α -> Bool
≡) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat) (forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall v n (m :: * -> *).
(View v n, MonadReader (Graph n) m, MonadFail m) =>
Node -> m v
inspectNode forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall n (m :: * -> *).
(MonadReader (Graph n) m, MonadFail m) =>
Edge -> m [Node]
attachedNodes Edge
e)

-- | list of nodes that are connected to the given node, not including the node itself
neighbours ∷ (View [Port] n, MonadReader (Graph n) m, MonadFail m) ⇒ Node → m [Node]
neighbours :: forall n (m :: * -> *).
(View [Edge] n, MonadReader (Graph n) m, MonadFail m) =>
Node -> m [Node]
neighbours Node
n = do
	[Edge]
ports ∷ [Port] ← forall v n (m :: * -> *).
(View v n, MonadReader (Graph n) m, MonadFail m) =>
Node -> m v
inspectNode Node
n
	[IntSet]
edges ← forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (r :: * -> *) n.
(MonadFail r, MonadReader (Graph n) r) =>
Edge -> r IntSet
readEdge [Edge]
ports
	let is :: IntSet
is = forall (f :: * -> *). Foldable f => f IntSet -> IntSet
Set.unions [IntSet]
edges
	-- TODO: implement in terms of [relatives]
	forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Int -> Node
Node forall a b. (a -> b) -> a -> b
$ IntSet -> [Int]
Set.elems forall a b. (a -> b) -> a -> b
$ Int -> IntSet -> IntSet
Set.delete (Node -> Int
nKey Node
n) IntSet
is

-- | list of nodes that are connected to the given node, including the node itself
relatives ∷ (View [Port] n, MonadReader (Graph n) m, MonadFail m) ⇒ Node → m [Node]
relatives :: forall n (m :: * -> *).
(View [Edge] n, MonadReader (Graph n) m, MonadFail m) =>
Node -> m [Node]
relatives Node
n = do
	[Edge]
ports ∷ [Port] ← forall v n (m :: * -> *).
(View v n, MonadReader (Graph n) m, MonadFail m) =>
Node -> m v
inspectNode Node
n
	[IntSet]
edges ← forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (r :: * -> *) n.
(MonadFail r, MonadReader (Graph n) r) =>
Edge -> r IntSet
readEdge [Edge]
ports
	let is :: IntSet
is = forall (f :: * -> *). Foldable f => f IntSet -> IntSet
Set.unions [IntSet]
edges
	forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Int -> Node
Node forall a b. (a -> b) -> a -> b
$ IntSet -> [Int]
Set.elems IntSet
is

-- | nodes connected to given port of the specified node, not including the node itself
adverseNodes ∷ (MonadReader (Graph n) m, MonadFail m) ⇒ Node → Port → m [Node]
adverseNodes :: forall n (m :: * -> *).
(MonadReader (Graph n) m, MonadFail m) =>
Node -> Edge -> m [Node]
adverseNodes (Node Int
n) Edge
p = forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (forall a b. (a -> b) -> [a] -> [b]
map Int -> Node
Node forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntSet -> [Int]
Set.elems forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> IntSet -> IntSet
Set.delete Int
n) (forall (r :: * -> *) n.
(MonadFail r, MonadReader (Graph n) r) =>
Edge -> r IntSet
readEdge Edge
p)

-- | whether two nodes are connected
connected ∷ (View [Port] n, MonadReader (Graph n) m, MonadFail m) ⇒ Node → Node → m Bool
connected :: forall n (m :: * -> *).
(View [Edge] n, MonadReader (Graph n) m, MonadFail m) =>
Node -> Node -> m Bool
connected Node
n1 Node
n2 = forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Node
n2 forall α. Eq α => α -> [α] -> Bool
∈) (forall n (m :: * -> *).
(View [Edge] n, MonadReader (Graph n) m, MonadFail m) =>
Node -> m [Node]
relatives Node
n2)

-- | whether the given ports features a dangling edge
dangling ∷ (View [Port] n, MonadReader (Graph n) m, MonadFail m) ⇒ Port → m Bool
dangling :: forall n (m :: * -> *).
(View [Edge] n, MonadReader (Graph n) m, MonadFail m) =>
Edge -> m Bool
dangling = forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (forall α. Eq α => α -> α -> Bool
≡ Int
1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n (m :: * -> *).
(View [Edge] n, MonadReader (Graph n) m, MonadFail m) =>
Edge -> m Int
edgeCardinality

-- | Map node-relative enquiry over the nodes of the graph.
withNodes ∷ MonadReader (Graph n) m ⇒ (Node → m a) → m [a]
withNodes :: forall n (m :: * -> *) a.
MonadReader (Graph n) m =>
(Node -> m a) -> m [a]
withNodes Node -> m a
p = forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Node -> m a
p forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall n (m :: * -> *). MonadReader (Graph n) m => m [Node]
readNodeList