    {-# LANGUAGE CPP, MultiParamTypeClasses #-}

    -- (c) 2002 by Martin Erwig [see file COPYRIGHT]
    -- | Monadic Graphs
    module Data.Graph.Inductive.Monad(
        -- * Classes
        GraphM(..),
        -- * Operations
        -- ** Graph Folds and Maps
        ufoldM,
        -- ** Graph Projection
        nodesM,edgesM,newNodesM,
        -- ** Graph Construction and Destruction
        delNodeM,delNodesM,
        mkUGraphM,
        -- ** Graph Inspection
        contextM,labM
    ) where

    import Data.Graph.Inductive.Graph
    #if MIN_VERSION_base(4,12,0)
    import Control.Monad.Fail
    import Prelude hiding (fail)
    #endif

    {-# ANN module "HLint: ignore Redundant lambda" #-}

    ----------------------------------------------------------------------
    -- MONADIC GRAPH CLASS
    ----------------------------------------------------------------------

    --
    -- Currently, we define just one monadic graph class:
    --
    --   GraphM:    static, decomposable graphs
    --              static means that a graph itself cannot be changed
    --
    -- Later we might also define DynGraphM for dynamic, extensible graphs
    --

    -- Monadic Graph
    --
    class
    #if MIN_VERSION_base(4,12,0)
     (MonadFail m)
    #else
     (Monad m)
    #endif
      => GraphM m gr where
      {-# MINIMAL emptyM, isEmptyM, matchM, mkGraphM, labNodesM #-}

      emptyM     :: m (gr a b)

      isEmptyM   :: m (gr a b) -> m Bool

      matchM     :: Node -> m (gr a b) -> m (Decomp gr a b)

      mkGraphM   :: [LNode a] -> [LEdge b] -> m (gr a b)

      labNodesM  :: m (gr a b) -> m [LNode a]

      matchAnyM  :: m (gr a b) -> m (GDecomp gr a b)
      matchAnyM g :: m (gr a b)
    g = do [LNode a]
    vs <- m (gr a b) -> m [LNode a]
    forall (m :: * -> *) (gr :: * -> * -> *) a b.
    GraphM m gr =>
    m (gr a b) -> m [LNode a]
    labNodesM m (gr a b)
    g
                       case [LNode a]
    vs of
                         []      -> String -> m (GDecomp gr a b)
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail "Match Exception, Empty Graph"
                         (v :: Node
    v,_):_ -> do (Just c :: Context a b
    c,g' :: gr a b
    g') <- Node -> m (gr a b) -> m (MContext a b, gr a b)
    forall (m :: * -> *) (gr :: * -> * -> *) a b.
    GraphM m gr =>
    Node -> m (gr a b) -> m (Decomp gr a b)
    matchM Node
    v m (gr a b)
    g
                                       GDecomp gr a b -> m (GDecomp gr a b)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Context a b
    c,gr a b
    g')

      noNodesM   :: m (gr a b) -> m Int
      noNodesM = m (gr a b) -> m [LNode a]
    forall (m :: * -> *) (gr :: * -> * -> *) a b.
    GraphM m gr =>
    m (gr a b) -> m [LNode a]
    labNodesM (m (gr a b) -> m [LNode a])
    -> ([LNode a] -> Node) -> m (gr a b) -> m Node
    forall (m :: * -> *) a b c.
    Monad m =>
    (m a -> m b) -> (b -> c) -> m a -> m c
    >>. [LNode a] -> Node
    forall (t :: * -> *) a. Foldable t => t a -> Node
    length

      nodeRangeM :: m (gr a b) -> m (Node,Node)
      nodeRangeM g :: m (gr a b)
    g = do Bool
    isE <- m (gr a b) -> m Bool
    forall (m :: * -> *) (gr :: * -> * -> *) a b.
    GraphM m gr =>
    m (gr a b) -> m Bool
    isEmptyM m (gr a b)
    g
                        if Bool
    isE
                           then String -> m (Node, Node)
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail "nodeRangeM of empty graph"
                           else do [Node]
    vs <- m (gr a b) -> m [Node]
    forall (m :: * -> *) (gr :: * -> * -> *) a b.
    GraphM m gr =>
    m (gr a b) -> m [Node]
    nodesM m (gr a b)
    g
                                   (Node, Node) -> m (Node, Node)
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([Node] -> Node
    forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
    minimum [Node]
    vs,[Node] -> Node
    forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
    maximum [Node]
    vs)

      labEdgesM  :: m (gr a b) -> m [LEdge b]
      labEdgesM = (Context a b -> [LEdge b] -> [LEdge b])
    -> [LEdge b] -> m (gr a b) -> m [LEdge b]
    forall (m :: * -> *) (gr :: * -> * -> *) a b c.
    GraphM m gr =>
    (Context a b -> c -> c) -> c -> m (gr a b) -> m c
    ufoldM (\(p :: Adj b
    p,v :: Node
    v,_,s :: Adj b
    s)->((((b, Node) -> LEdge b) -> Adj b -> [LEdge b]
    forall a b. (a -> b) -> [a] -> [b]
    map (Node -> (b, Node) -> LEdge b
    forall b c a. b -> (c, a) -> (a, b, c)
    i Node
    v) Adj b
    p [LEdge b] -> [LEdge b] -> [LEdge b]
    forall a. [a] -> [a] -> [a]
    ++ ((b, Node) -> LEdge b) -> Adj b -> [LEdge b]
    forall a b. (a -> b) -> [a] -> [b]
    map (Node -> (b, Node) -> LEdge b
    forall a c b. a -> (c, b) -> (a, b, c)
    o Node
    v) Adj b
    s)[LEdge b] -> [LEdge b] -> [LEdge b]
    forall a. [a] -> [a] -> [a]
    ++)) []
        where
          o :: a -> (c, b) -> (a, b, c)
    o v :: a
    v = \(l :: c
    l,w :: b
    w)->(a
    v,b
    w,c
    l)
          i :: b -> (c, a) -> (a, b, c)
    i v :: b
    v = \(l :: c
    l,w :: a
    w)->(a
    w,b
    v,c
    l)

    -- composing a monadic function with a non-monadic one
    --
    (>>.) :: (Monad m) => (m a -> m b) -> (b -> c) -> m a -> m c
    f :: m a -> m b
    f >>. :: (m a -> m b) -> (b -> c) -> m a -> m c
    >>. g :: b -> c
    g = (m b -> (b -> m c) -> m c
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= c -> m c
    forall (m :: * -> *) a. Monad m => a -> m a
    return (c -> m c) -> (b -> c) -> b -> m c
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . b -> c
    g) (m b -> m c) -> (m a -> m b) -> m a -> m c
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . m a -> m b
    f

    ----------------------------------------------------------------------
    -- DERIVED GRAPH OPERATIONS
    ----------------------------------------------------------------------

    -- graph folds and maps
    --

    -- | graph fold
    ufoldM :: (GraphM m gr) => (Context a b -> c -> c) -> c -> m (gr a b) -> m c
    ufoldM :: (Context a b -> c -> c) -> c -> m (gr a b) -> m c
    ufoldM f :: Context a b -> c -> c
    f u :: c
    u g :: m (gr a b)
    g = do Bool
    b <- m (gr a b) -> m Bool
    forall (m :: * -> *) (gr :: * -> * -> *) a b.
    GraphM m gr =>
    m (gr a b) -> m Bool
    isEmptyM m (gr a b)
    g
                      if Bool
    b then c -> m c
    forall (m :: * -> *) a. Monad m => a -> m a
    return c
    u
                           else do (c :: Context a b
    c,g' :: gr a b
    g') <- m (gr a b) -> m (Context a b, gr a b)
    forall (m :: * -> *) (gr :: * -> * -> *) a b.
    GraphM m gr =>
    m (gr a b) -> m (GDecomp gr a b)
    matchAnyM m (gr a b)
    g
                                   c
    x <- (Context a b -> c -> c) -> c -> m (gr a b) -> m c
    forall (m :: * -> *) (gr :: * -> * -> *) a b c.
    GraphM m gr =>
    (Context a b -> c -> c) -> c -> m (gr a b) -> m c
    ufoldM Context a b -> c -> c
    f c
    u (gr a b -> m (gr a b)
    forall (m :: * -> *) a. Monad m => a -> m a
    return gr a b
    g')
                                   c -> m c
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Context a b -> c -> c
    f Context a b
    c c
    x)

    -- (additional) graph projection
    -- [noNodes, nodeRange, labNodes, labEdges are defined in class Graph]
    --
    nodesM :: (GraphM m gr) => m (gr a b) -> m [Node]
    nodesM :: m (gr a b) -> m [Node]
    nodesM = m (gr a b) -> m [LNode a]
    forall (m :: * -> *) (gr :: * -> * -> *) a b.
    GraphM m gr =>
    m (gr a b) -> m [LNode a]
    labNodesM (m (gr a b) -> m [LNode a])
    -> ([LNode a] -> [Node]) -> m (gr a b) -> m [Node]
    forall (m :: * -> *) a b c.
    Monad m =>
    (m a -> m b) -> (b -> c) -> m a -> m c
    >>. (LNode a -> Node) -> [LNode a] -> [Node]
    forall a b. (a -> b) -> [a] -> [b]
    map LNode a -> Node
    forall a b. (a, b) -> a
    fst

    edgesM :: (GraphM m gr) => m (gr a b) -> m [Edge]
    edgesM :: m (gr a b) -> m [(Node, Node)]
    edgesM =  m (gr a b) -> m [LEdge b]
    forall (m :: * -> *) (gr :: * -> * -> *) a b.
    GraphM m gr =>
    m (gr a b) -> m [LEdge b]
    labEdgesM (m (gr a b) -> m [LEdge b])
    -> ([LEdge b] -> [(Node, Node)]) -> m (gr a b) -> m [(Node, Node)]
    forall (m :: * -> *) a b c.
    Monad m =>
    (m a -> m b) -> (b -> c) -> m a -> m c
    >>. (LEdge b -> (Node, Node)) -> [LEdge b] -> [(Node, Node)]
    forall a b. (a -> b) -> [a] -> [b]
    map (\(v :: Node
    v,w :: Node
    w,_)->(Node
    v,Node
    w))

    newNodesM :: (GraphM m gr) => Int -> m (gr a b) -> m [Node]
    newNodesM :: Node -> m (gr a b) -> m [Node]
    newNodesM i :: Node
    i g :: m (gr a b)
    g = do Bool
    isE <- m (gr a b) -> m Bool
    forall (m :: * -> *) (gr :: * -> * -> *) a b.
    GraphM m gr =>
    m (gr a b) -> m Bool
    isEmptyM m (gr a b)
    g
                       if Bool
    isE
                          then [Node] -> m [Node]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [0..Node
    iNode -> Node -> Node
    forall a. Num a => a -> a -> a
    -1]
                          else do (_,n :: Node
    n) <- m (gr a b) -> m (Node, Node)
    forall (m :: * -> *) (gr :: * -> * -> *) a b.
    GraphM m gr =>
    m (gr a b) -> m (Node, Node)
    nodeRangeM m (gr a b)
    g
                                  [Node] -> m [Node]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [Node
    nNode -> Node -> Node
    forall a. Num a => a -> a -> a
    +1..Node
    nNode -> Node -> Node
    forall a. Num a => a -> a -> a
    +Node
    i]

    -- graph construction & destruction
    --
    delNodeM :: (GraphM m gr) => Node -> m (gr a b) -> m (gr a b)
    delNodeM :: Node -> m (gr a b) -> m (gr a b)
    delNodeM v :: Node
    v = [Node] -> m (gr a b) -> m (gr a b)
    forall (m :: * -> *) (gr :: * -> * -> *) a b.
    GraphM m gr =>
    [Node] -> m (gr a b) -> m (gr a b)
    delNodesM [Node
    v]

    delNodesM :: (GraphM m gr) => [Node] -> m (gr a b) -> m (gr a b)
    delNodesM :: [Node] -> m (gr a b) -> m (gr a b)
    delNodesM []     g :: m (gr a b)
    g = m (gr a b)
    g
    delNodesM (v :: Node
    v:vs :: [Node]
    vs) g :: m (gr a b)
    g = do (_,g' :: gr a b
    g') <- Node -> m (gr a b) -> m (MContext a b, gr a b)
    forall (m :: * -> *) (gr :: * -> * -> *) a b.
    GraphM m gr =>
    Node -> m (gr a b) -> m (Decomp gr a b)
    matchM Node
    v m (gr a b)
    g
                            [Node] -> m (gr a b) -> m (gr a b)
    forall (m :: * -> *) (gr :: * -> * -> *) a b.
    GraphM m gr =>
    [Node] -> m (gr a b) -> m (gr a b)
    delNodesM [Node]
    vs (gr a b -> m (gr a b)
    forall (m :: * -> *) a. Monad m => a -> m a
    return gr a b
    g')

    mkUGraphM :: (GraphM m gr) => [Node] -> [Edge] -> m (gr () ())
    mkUGraphM :: [Node] -> [(Node, Node)] -> m (gr () ())
    mkUGraphM vs :: [Node]
    vs es :: [(Node, Node)]
    es = [LNode ()] -> [LEdge ()] -> m (gr () ())
    forall (m :: * -> *) (gr :: * -> * -> *) a b.
    GraphM m gr =>
    [LNode a] -> [LEdge b] -> m (gr a b)
    mkGraphM ([Node] -> [LNode ()]
    labUNodes [Node]
    vs) ([(Node, Node)] -> [LEdge ()]
    labUEdges [(Node, Node)]
    es)

    labUEdges :: [Edge] -> [LEdge ()]
    labUEdges :: [(Node, Node)] -> [LEdge ()]
    labUEdges = ((Node, Node) -> LEdge ()) -> [(Node, Node)] -> [LEdge ()]
    forall a b. (a -> b) -> [a] -> [b]
    map ((Node, Node) -> () -> LEdge ()
    forall b. (Node, Node) -> b -> LEdge b
    `toLEdge` ())

    labUNodes :: [Node] -> [LNode ()]
    labUNodes :: [Node] -> [LNode ()]
    labUNodes = (Node -> LNode ()) -> [Node] -> [LNode ()]
    forall a b. (a -> b) -> [a] -> [b]
    map (\v :: Node
    v->(Node
    v,()))

    -- graph inspection (for a particular node)
    --
    onMatch :: (GraphM m gr) => (Context a b -> c) -> c -> m (gr a b) -> Node -> m c
    onMatch :: (Context a b -> c) -> c -> m (gr a b) -> Node -> m c
    onMatch f :: Context a b -> c
    f u :: c
    u g :: m (gr a b)
    g v :: Node
    v = do (x :: MContext a b
    x,_) <- Node -> m (gr a b) -> m (MContext a b, gr a b)
    forall (m :: * -> *) (gr :: * -> * -> *) a b.
    GraphM m gr =>
    Node -> m (gr a b) -> m (Decomp gr a b)
    matchM Node
    v m (gr a b)
    g
                         c -> m c
    forall (m :: * -> *) a. Monad m => a -> m a
    return (case MContext a b
    x of {Nothing -> c
    u; Just c :: Context a b
    c -> Context a b -> c
    f Context a b
    c})

    contextM :: (GraphM m gr) => m (gr a b) -> Node -> m (Context a b)
    contextM :: m (gr a b) -> Node -> m (Context a b)
    contextM g :: m (gr a b)
    g v :: Node
    v = (Context a b -> Context a b)
    -> Context a b -> m (gr a b) -> Node -> m (Context a b)
    forall (m :: * -> *) (gr :: * -> * -> *) a b c.
    GraphM m gr =>
    (Context a b -> c) -> c -> m (gr a b) -> Node -> m c
    onMatch Context a b -> Context a b
    forall a. a -> a
    id (String -> Context a b
    forall a. HasCallStack => String -> a
    error ("Match Exception, Node: "String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++Node -> String
    forall a. Show a => a -> String
    show Node
    v)) m (gr a b)
    g Node
    v

    labM :: (GraphM m gr) => m (gr a b) -> Node -> m (Maybe a)
    labM :: m (gr a b) -> Node -> m (Maybe a)
    labM = (Context a b -> Maybe a)
    -> Maybe a -> m (gr a b) -> Node -> m (Maybe a)
    forall (m :: * -> *) (gr :: * -> * -> *) a b c.
    GraphM m gr =>
    (Context a b -> c) -> c -> m (gr a b) -> Node -> m c
    onMatch (a -> Maybe a
    forall a. a -> Maybe a
    Just (a -> Maybe a) -> (Context a b -> a) -> Context a b -> Maybe a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Context a b -> a
    forall a b. Context a b -> a
    lab') Maybe a
    forall a. Maybe a
    Nothing

    {-
    neighbors :: (GraphM m gr) => m (gr a b) -> Node -> [Node]
    neighbors = (\(p,_,_,s) -> map snd (p++s)) .: context

    suc :: (GraphM m gr) => m (gr a b) -> Node -> [Node]
    suc = map snd .: context4

    pre :: (GraphM m gr) => m (gr a b) -> Node -> [Node]
    pre = map snd .: context1

    lsuc :: (GraphM m gr) => m (gr a b) -> Node -> [(Node,b)]
    lsuc = map flip2 .: context4

    lpre :: (GraphM m gr) => m (gr a b) -> Node -> [(Node,b)]
    lpre = map flip2 .: context1

    out :: (GraphM m gr) => m (gr a b) -> Node -> [LEdge b]
    out g v = map (\(l,w)->(v,w,l)) (context4 g v)

    inn :: (GraphM m gr) => m (gr a b) -> Node -> [LEdge b]
    inn g v = map (\(l,w)->(w,v,l)) (context1 g v)

    outdeg :: (GraphM m gr) => m (gr a b) -> Node -> Int
    outdeg = length .: context4

    indeg :: (GraphM m gr) => m (gr a b) -> Node -> Int
    indeg  = length .: context1

    deg :: (GraphM m gr) => m (gr a b) -> Node -> Int
    deg = (\(p,_,_,s) -> length p+length s) .: context
    --

    -- -- context inspection
    -- --
    -- node' :: Context a b -> Node
    -- node' (_,v,_,_) = v
    --
    -- lab' :: Context a b -> a
    -- lab' (_,_,l,_) = l
    --
    -- labNode' :: Context a b -> LNode a
    -- labNode' (_,v,l,_) = (v,l)
    --
    -- neighbors' :: Context a b -> [Node]
    -- neighbors' (p,_,_,s) = map snd p++map snd s
    --
    -- suc' :: Context a b -> [Node]
    -- suc' (_,_,_,s) = map snd s
    --
    -- pre' :: Context a b -> [Node]
    -- pre' (p,_,_,_) = map snd p
    --
    -- lpre' :: Context a b -> [(Node,b)]
    -- lpre' (p,_,_,_) = map flip2 p
    --
    -- lsuc' :: Context a b -> [(Node,b)]
    -- lsuc' (_,_,_,s) = map flip2 s
    --
    -- out' :: Context a b -> [LEdge b]
    -- out' (_,v,_,s) = map (\(l,w)->(v,w,l)) s
    --
    -- inn' :: Context a b -> [LEdge b]
    -- inn' (p,v,_,_) = map (\(l,w)->(w,v,l)) p
    --
    -- outdeg' :: Context a b -> Int
    -- outdeg' (_,_,_,s) = length s
    --
    -- indeg' :: Context a b -> Int
    -- indeg' (p,_,_,_) = length p
    --
    -- deg' :: Context a b -> Int
    -- deg' (p,_,_,s) = length p+length s

    -- graph equality
    --
    nodeComp :: (Eq b) => LNode b -> LNode b -> Ordering
    nodeComp n@(v,a) n'@(w,b) | n == n'   = EQ
                              | v<w       = LT
                              | otherwise = GT

    slabNodes :: (Eq a,Graph gr) => m (gr a b) -> [LNode a]
    slabNodes = sortBy nodeComp . labNodes

    edgeComp :: (Eq b) => LEdge b -> LEdge b -> Ordering
    edgeComp e@(v,w,a) e'@(x,y,b) | e == e'              = EQ
                                  | v<x || (v==x && w<y) = LT
                                  | otherwise            = GT

    slabEdges :: (Eq b,Graph gr) => m (gr a b) -> [LEdge b]
    slabEdges = sortBy edgeComp . labEdges

    instance (Eq a,Eq b,Graph gr) => Eq (m (gr a b)) where
      g == g' = slabNodes g == slabNodes g' && slabEdges g == slabEdges g'

    -}