// (c) 1999-2005 by Martin Erwig [see file COPYRIGHT]
// | Static and Dynamic Inductive Graphs
implementation module Data.Graph.Inductive.Graph

import Control.Arrow
import qualified Data.IntSet
import qualified Data.List
import StdList, StdBool, StdTuple, StdFunc, StdMisc, StdEnum, StdString, StdOverloaded, StdClass
import Data.List
import Data.Maybe
import Data.Functor
import Data.GenLexOrd
from Data.Foldable import minimum, maximum

unLPath :: (LPath a) -> [LNode a]
unLPath (LP xs) = xs

//TODO
//instance toString (LPath a) | toString a where
  //toString (LP xs) = foldr (\x xs -> toString x +++ " " +++ xs) "" xs

instance == (LPath a) | == a
where
	(==) (LP [])        (LP [])        = True
	(==) (LP [(_,x):_]) (LP [(_,y):_]) = x==y
	(==) (LP _)         (LP _)         = False

instance < (LPath a) | gLexOrd{|*|} a
where
	(<) (LP [(_,x):_]) (LP [(_,y):_]) = (x =?= y)=:LT
	(<) _ _ = False

// | Decompose a graph into the 'Context' for an arbitrarily-chosen 'Node'
// and the remaining 'Graph'.
defMatchAny  :: (gr a b) -> GDecomp gr a b | Graph gr
defMatchAny g = case labNodes g of
	[] = abort "Match Exception, Empty Graph"
	[(v,_):_] = case match v g of
		(?Just c,g`) = (c, g`)
		_ = abort "Shouldn't happen"

// | The number of 'Node's in a 'Graph'.
defNoNodes   :: (gr a b) -> Int | Graph gr
defNoNodes g = length (labNodes g)

// | The minimum and maximum 'Node' in a 'Graph'.
defNodeRange :: (gr a b) -> (Node,Node) | Graph gr
defNodeRange g
  | isEmptyGraph g = abort "nodeRange of empty graph"
  | otherwise = (minimum vs, maximum vs)
  where
    vs = nodes g

// | A list of all 'LEdge's in the 'Graph'.
defLabEdges  :: (gr a b) -> [LEdge b] | Graph gr
defLabEdges g = ufold (\(_,v,_,s) xs -> map (\(l,w)->(v,w,l)) s ++ xs) [] g

// | The number of nodes in the graph.  An alias for 'noNodes'.
order :: (gr a b) -> Int | Graph gr
order g = noNodes g

// | The number of edges in the graph.
//
//   Note that this counts every edge found, so if you are
//   representing an unordered graph by having each edge mirrored this
//   will be incorrect.
//
//   If you created an unordered graph by either mirroring every edge
//   (including loops!) or using the @undir@ function in
//   "Data.Graph.Inductive.Basic" then you can safely halve the value
//   returned by this.
size :: (gr a b) -> Int | Graph gr
size g = length (labEdges g)

// | Fold a function over the graph.
ufold :: ((Context a b) c -> c) c (gr a b) -> c | Graph gr
ufold f u g
  | isEmptyGraph g = u
  | otherwise = f c (ufold f u g`)
  where
    (c,g`) = matchAny g

// | Map a function over the graph.
gmap :: ((Context a b) -> Context c d) (gr a b) -> gr c d | DynGraph gr
gmap f g = ufold (\c x -> f c <&> x) emptyGraph g

// | Map a function over the 'Node' labels in a graph.
nmap :: (a -> c) (gr a b) -> gr c b | DynGraph gr
nmap f g = gmap (\(p,v,l,s)->(p,v,f l,s)) g

// | Map a function over the 'Edge' labels in a graph.
emap :: (b -> c) (gr a b) -> gr a c | DynGraph gr
emap f g = gmap (\(p,v,l,s)->(map1 f p,v,l,map1 f s)) g
  where
    map1 g = map (first g)

// | Map functions over both the 'Node' and 'Edge' labels in a graph.
nemap :: (a -> c) (b -> d) (gr a b) -> gr c d | DynGraph gr
nemap fn fe g = gmap (\(p,v,l,s) -> (fe` p,v,fn l,fe` s)) g
  where
    fe` = map (first fe)

// | List all 'Node's in the 'Graph'.
nodes :: (gr a b) -> [Node] | Graph gr
nodes g = map fst (labNodes g)

// | List all 'Edge's in the 'Graph'.
edges :: (gr a b) -> [Edge] | Graph gr
edges g = map toEdge (labEdges g)

// | Drop the label component of an edge.
toEdge :: (LEdge b) -> Edge
toEdge (v,w,_) = (v,w)

// | Add a label to an edge.
toLEdge :: Edge b -> LEdge b
toLEdge (v,w) l = (v,w,l)

// | The label in an edge.
edgeLabel :: (LEdge b) -> b
edgeLabel (_,_,l) = l

// | List N available 'Node's, i.e. 'Node's that are not used in the 'Graph'.
newNodes :: Int (gr a b) -> [Node] | Graph gr
newNodes i g
  | isEmptyGraph g = [0..i-1]
  | otherwise = [n+1..n+i]
  where
    (_,n) = nodeRange g

// | 'True' if the 'Node' is present in the 'Graph'.
gelem :: Node (gr a b) -> Bool | Graph gr
gelem v g = isJust (fst (match v g))

// | Insert a 'LNode' into the 'Graph'.
insNode :: (LNode a) (gr a b) -> gr a b | DynGraph gr
insNode (v,l) gr = ([],v,l,[]) <&> gr

// | Insert a 'LEdge' into the 'Graph'.
insEdge :: (LEdge b) (gr a b) -> gr a b | DynGraph gr
insEdge (v,w,l) g = (pr,v,la,[(l,w):su]) <&> g`
  where
    (mcxt,g`) = match v g
    (pr,_,la,su) = fromMaybe
                     (abort ("insEdge: cannot add edge from non-existent vertex" +++ toString v))
                     mcxt

// | Remove a 'Node' from the 'Graph'.
delNode :: Node (gr a b) -> gr a b | Graph gr
delNode v gr = delNodes [v] gr

// | Remove an 'Edge' from the 'Graph'.
//
//   NOTE: in the case of multiple edges, this will delete /all/ such
//   edges from the graph as there is no way to distinguish between
//   them.  If you need to delete only a single such edge, please use
//   'delLEdge'.
delEdge :: Edge (gr a b) -> gr a b | DynGraph gr
delEdge (v,w) g = case match v g of
	(?None,_)             -> g
	(?Just (p,v`,l,s),g`) -> (p,v`,l,filter ((\x -> x <> w) o snd) s) <&> g`

// | Remove an 'LEdge' from the 'Graph'.
//
//   NOTE: in the case of multiple edges with the same label, this
//   will only delete the /first/ such edge.  To delete all such
//   edges, please use 'delAllLedge'.
delLEdge :: (LEdge b) (gr a b) -> gr a b | DynGraph gr & Eq b
delLEdge e g = delLEdgeBy 'Data.List'.delete e g

// | Remove all edges equal to the one specified.
delAllLEdge :: (LEdge b) (gr a b) -> gr a b | DynGraph gr & Eq b
delAllLEdge e g = delLEdgeBy (filter o (<>)) e g

delLEdgeBy :: ((b,Node) (Adj b) -> Adj b) (LEdge b) (gr a b) -> gr a b | DynGraph gr
delLEdgeBy f (v,w,b) g = case match v g of
	(?None,_)             -> g
	(?Just (p,v`,l,s),g`) -> (p,v`,l,f (b,w) s) <&> g`

// | Insert multiple 'LNode's into the 'Graph'.
insNodes   :: [LNode a] (gr a b) -> gr a b | DynGraph gr
insNodes vs g = foldl (flip insNode) g vs

// | Insert multiple 'LEdge's into the 'Graph'.
insEdges :: [LEdge b] (gr a b) -> gr a b | DynGraph gr
insEdges es g = foldl (flip insEdge) g es

// | Remove multiple 'Node's from the 'Graph'.
delNodes :: [Node] (gr a b) -> gr a b | Graph gr
delNodes vs g = foldl (snd .: flip match) g vs

// | Remove multiple 'Edge's from the 'Graph'.
delEdges :: [Edge] (gr a b) -> gr a b | DynGraph gr
delEdges es g = foldl (flip delEdge) g es

// | Build a 'Graph' from a list of 'Context's.
//
//   The list should be in the order such that earlier 'Context's
//   depend upon later ones (i.e. as produced by @'ufold' (:) []@).
buildGr :: [Context a b] -> gr a b | DynGraph gr
buildGr cs = foldr (<&>) emptyGraph cs

// | Build a quasi-unlabeled 'Graph'.
mkUGraph :: [Node] [Edge] -> gr () () | Graph gr
mkUGraph vs es = mkGraph (labUNodes vs) (labUEdges es)
   where
     labUEdges = map (\x -> toLEdge x ())
     labUNodes = map ((\x y -> (y, x)) ()) // TODO Double check

// | Build a graph out of the contexts for which the predicate is
// true.
gfiltermap :: ((Context a b) -> MContext c d) (gr a b) -> gr c d | DynGraph gr
gfiltermap f gr = ufold (maybe id (<&>) o f) emptyGraph gr

// | Returns the subgraph only containing the labelled nodes which
// satisfy the given predicate.
labnfilter :: ((LNode a) -> Bool) (gr a b) -> gr a b | Graph gr
labnfilter p gr = delNodes (map fst (filter (not o p) (labNodes gr))) gr

// | Returns the subgraph only containing the nodes which satisfy the
// given predicate.
nfilter :: (Node -> Bool) (gr a b) -> gr a b | DynGraph gr
nfilter f gr = labnfilter (f o fst) gr

// | Returns the subgraph only containing the nodes whose labels
// satisfy the given predicate.
labfilter :: (a -> Bool) (gr a b) -> gr a b | DynGraph gr
labfilter f gr = labnfilter (f o snd) gr

// | Returns the subgraph induced by the supplied nodes.
subgraph :: [Node] (gr a b) -> gr a b | DynGraph gr
subgraph vs gr = let vs` = 'Data.IntSet'.fromList vs
              in nfilter (\x -> 'Data.IntSet'.member x vs`) gr

// | Find the context for the given 'Node'.  Causes an error if the 'Node' is
// not present in the 'Graph'.
context :: (gr a b) Node -> Context a b | Graph gr
context g v = fromMaybe (abort ("Match Exception, Node: " +++ toString v))
                        (fst (match v g))

// | Find the label for a 'Node'.
lab :: (gr a b) Node -> ?a | Graph gr
lab g v = lab` <$> (fst (match v g))

// | Find the neighbors for a 'Node'.
neighbors :: (gr a b) Node -> [Node] | Graph gr
neighbors gr n = (map snd .: lneighbors) gr n

// | Find the labelled links coming into or going from a 'Context'.
lneighbors :: (gr a b) Node -> Adj b | Graph gr
lneighbors gr n = (maybe [] lneighbors` .: mcontext) gr n

// | Find all 'Node's that have a link from the given 'Node'.
suc :: (gr a b) Node -> [Node] | Graph gr
suc gr n = (map snd .: context4l) gr n

// | Find all 'Node's that link to to the given 'Node'.
pre :: (gr a b) Node -> [Node] | Graph gr
pre gr n = (map snd .: context1l) gr n

// | Find all 'Node's that are linked from the given 'Node' and the label of
// each link.
lsuc :: (gr a b) Node -> [(Node,b)] | Graph gr
lsuc gr n = (map flip2 .: context4l) gr n

// | Find all 'Node's that link to the given 'Node' and the label of each link.
lpre :: (gr a b) Node -> [(Node,b)] | Graph gr
lpre gr n = (map flip2 .: context1l) gr n

// | Find all outward-bound 'LEdge's for the given 'Node'.
out :: (gr a b) Node -> [LEdge b] | Graph gr
out g v = map (\(l,w)->(v,w,l)) (context4l g v)

// | Find all inward-bound 'LEdge's for the given 'Node'.
inn :: (gr a b) Node -> [LEdge b] | Graph gr
inn g v = map (\(l,w)->(w,v,l)) (context1l g v)

// | The outward-bound degree of the 'Node'.
outdeg :: (gr a b) Node -> Int | Graph gr
outdeg gr n = (length .: context4l) gr n

// | The inward-bound degree of the 'Node'.
indeg :: (gr a b) Node -> Int | Graph gr
indeg gr n = (length .: context1l) gr n

// | The degree of the 'Node'.
deg :: (gr a b) Node -> Int | Graph gr
deg gr n = (deg` .: context) gr n

// | The 'Node' in a 'Context'.
node` :: (Context a b) -> Node
node` (_,v,_,_) = v

// | The label in a 'Context'.
lab` :: (Context a b) -> a
lab` (_,_,l,_) = l

// | The 'LNode' from a 'Context'.
labNode` :: (Context a b) -> LNode a
labNode` (_,v,l,_) = (v,l)

// | All 'Node's linked to or from in a 'Context'.
neighbors` :: (Context a b) -> [Node]
neighbors` (p,_,_,s) = map snd p++map snd s

// | All labelled links coming into or going from a 'Context'.
lneighbors` :: (Context a b) -> Adj b
lneighbors` (p,_,_,s) = p ++ s

// | All 'Node's linked to in a 'Context'.
suc` :: (Context a b) -> [Node]
suc` c = map snd (context4l` c)

// | All 'Node's linked from in a 'Context'.
pre` :: (Context a b) -> [Node]
pre` c = map snd (context1l` c)

// | All 'Node's linked from in a 'Context', and the label of the links.
lsuc` :: (Context a b) -> [(Node,b)]
lsuc` c = map flip2 (context4l` c)

// | All 'Node's linked from in a 'Context', and the label of the links.
lpre` :: (Context a b) -> [(Node,b)]
lpre` c = map flip2 (context1l` c)

// | All outward-directed 'LEdge's in a 'Context'.
out` :: (Context a b) -> [LEdge b]
out` c=:(_,v,_,_) = map (\(l,w)->(v,w,l)) (context4l` c)

// | All inward-directed 'LEdge's in a 'Context'.
inn` :: (Context a b) -> [LEdge b]
inn` c=:(_,v,_,_) = map (\(l,w)->(w,v,l)) (context1l` c)

// | The outward degree of a 'Context'.
outdeg` :: (Context a b) -> Int
outdeg` c = length (context4l` c)

// | The inward degree of a 'Context'.
indeg` :: (Context a b) -> Int
indeg` c = length (context1l` c)

// | The degree of a 'Context'.
deg` :: (Context a b) -> Int
deg` (p,_,_,s) = length p+length s

// | Checks if there is a directed edge between two nodes.
hasEdge :: (gr a b) Edge -> Bool | Graph gr
hasEdge gr (v,w) = 'Data.List'.elem w (suc gr v)

// | Checks if there is an undirected edge between two nodes.
hasNeighbor :: (gr a b) Node Node -> Bool | Graph gr
hasNeighbor gr v w = 'Data.List'.elem w (neighbors gr v)

// | Checks if there is a labelled edge between two nodes.
hasLEdge :: (gr a b) (LEdge b) -> Bool | Graph gr & Eq b
hasLEdge gr (v,w,l) = 'Data.List'.elem (w,l) (lsuc gr v)

// | Checks if there is an undirected labelled edge between two nodes.
hasNeighborAdj :: (gr a b) Node (b,Node) -> Bool | Graph gr & Eq b
hasNeighborAdj gr v a = 'Data.List'.elem a (lneighbors gr v)

//--------------------------------------------------------------------
// GRAPH EQUALITY
//--------------------------------------------------------------------

// TODO
//slabNodes :: (gr a b) -> [LNode a] | Graph gr
//slabNodes g = sortBy (compare `on` fst) (labNodes g)

//glabEdges :: (gr a b) -> [GroupEdges b] | Graph gr
//glabEdges g = (map (GEs o groupLabels)
            //o groupBy ((==) `on` toEdge)
            //o sortBy (compare `on` toEdge)
            //o labEdges) g
  //where
    //groupLabels les = toLEdge (toEdge (head les)) (map edgeLabel les)

//equal :: (gr a b) (gr a b) -> Bool | Graph gr & == a & == b
//equal g g` = slabNodes g == slabNodes g` && glabEdges g == glabEdges g`
// This assumes that nodes aren't repeated (which shouldn't happen for
// sane graph instances).  If node IDs are repeated, then the usage of
// slabNodes cannot guarantee stable ordering.

// Newtype wrapper just to test for equality of multiple edges.  This
// is needed because without an Ord constraint on `b' it is not
// possible to guarantee a stable ordering on edge labels.
:: GroupEdges b = GEs (LEdge [b])

instance == (GroupEdges b) | Eq b where
	(==) (GEs (v1,w1,bs1)) (GEs (v2,w2,bs2)) =
		v1 == v2 && w1 == w2 && eqLists bs1 bs2

eqLists :: [a] [a] -> Bool | Eq a
eqLists xs ys = False // TODO FIXME null (xs \\ ys) && null (ys \\ xs)
// OK to use \\ here as we want each value in xs to cancel a *single*
// value in ys.

//--------------------------------------------------------------------
// UTILITIES
//--------------------------------------------------------------------

// auxiliary functions used in the implementation of the
// derived class members
//
(.:) :: (c -> d) (a -> b -> c) a b -> d
// f .: g = \x y->f (g x y)
// f .: g = (f .) . g
// (.:) f = ((f .) .)
// (.:) = (.) (.) (.)
(.:) f g x y = ((o) o (o)) f g x y

flip2 :: (a,b) -> (b,a)
flip2 (x,y) = (y,x)

// projecting on context elements
//
context1l :: (gr a b) Node -> Adj b | Graph gr
context1l g n = (maybe [] context1l` .: mcontext) g n

context4l :: (gr a b) Node -> Adj b | Graph gr
context4l g n = (maybe [] context4l` .: mcontext) g n

mcontext :: (gr a b) Node -> MContext a b | Graph gr
mcontext g n = (fst .: flip match) g n

context1l` :: (Context a b) -> Adj b
context1l` (p,v,_,s) = p++filter ((\x -> x == v) o snd) s

context4l` :: (Context a b) -> Adj b
context4l` (p,v,_,s) = s++filter ((\x -> x == v) o snd) p

//--------------------------------------------------------------------
// PRETTY PRINTING
//--------------------------------------------------------------------

// | Pretty-print the graph.  Note that this loses a lot of
//   information, such as edge inverses, etc.
prettify :: (gr a b) -> String | DynGraph gr & toString a & toString b
prettify g = foldr (showsContext o context g) "" (nodes g)
  where
  showsContext (_,n,l,s) acc = toString n +++ " -> " +++ foldr (\(l, n) xs -> "(" +++ toString l +++ ", " +++ toString n +++ "); " +++ xs) "" s +++ "\n" +++ acc
//prettify g = "TODO Prettify" [> foldr (showsContext o context g) id (nodes g) ""
  //where
    //showsContext (_,n,l,s) sg = shows n o (\xs -> ":" +++ xs) o shows l
                                //o showString "->" o shows s
                                //o (\xs -> "\n" +++ xs) o sg */

//--------------------------------------------------------------------
// Ordered Graph
//--------------------------------------------------------------------

// | OrdGr comes equipped with an Ord instance, so that graphs can be
//   used as e.g. Map keys.
:: OrdGr gr a b = OrdGr (gr a b)

unOrdGr :: (OrdGr gr a b) -> gr a b
unOrdGr (OrdGr g) = g

// TODO
//instance (Graph gr, Ord a, Ord b) => == (OrdGr gr a b) where
  //g1 == g2 = compare g1 g2 == EQ

//instance (Graph gr, Ord a, Ord b) => Ord (OrdGr gr a b) where
  //compare (OrdGr g1) (OrdGr g2) =
    //(compare `on` sort . labNodes) g1 g2
    //`mappend` (compare `on` sort . labEdges) g1 g2

