{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE TypeFamilies #-}
module Data.Chain (
    -- * Synopsis
    -- | 'Chain'@ node edge@ is a linear chain of nodes with directed
    -- edges.

    -- * Chain
      Chain
    , member, ChainContext, lookup
    --, singleton
    , fromEdge, fromEdges
    , edges, nodes, toEdges, summary

    -- * DeltaChain
    , DeltaChain (..)
    , appendTip, collapseNode, rollbackTo
    , chainIntoTable
    , ErrMalformedChainTable (..)

    -- * Edge
    , Edge (..), flattenEdge

    -- * Testing
    , testChain
    ) where

import Prelude hiding
    ( lookup )

import Control.Exception
    ( Exception, toException )
import Control.Monad
    ( guard, join, (<=<) )
import Data.Bifunctor
    ( first )
import Data.Delta
    ( Delta (..), Embedding, Embedding' (..), liftUpdates, mkEmbedding )
import Data.List
    ( unfoldr )
import Data.Map.Strict
    ( Map )
import Data.Semigroupoid
    ( o )
import Data.Table
    ( DeltaTable (..), Pile (..), Table )

import qualified Data.Map.Strict as Map
import qualified Data.Table as Table

{-------------------------------------------------------------------------------
    Chain
-------------------------------------------------------------------------------}
-- | A linear chain of nodes.
-- Edges between nodes are labeled by a 'Monoid' @edge@.
--
-- @
--   n_tip  <--e_tip-- … <--e1-- n1 <--e0-- n0
-- @
data Chain node edge = Chain
    { Chain node edge -> Map node (edge, node)
next :: Map node (edge, node)
    , Chain node edge -> Map node (Maybe node)
prev :: Map node (Maybe node)
    , Chain node edge -> node
tip  :: node
    } deriving (Chain node edge -> Chain node edge -> Bool
(Chain node edge -> Chain node edge -> Bool)
-> (Chain node edge -> Chain node edge -> Bool)
-> Eq (Chain node edge)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall node edge.
(Eq node, Eq edge) =>
Chain node edge -> Chain node edge -> Bool
/= :: Chain node edge -> Chain node edge -> Bool
$c/= :: forall node edge.
(Eq node, Eq edge) =>
Chain node edge -> Chain node edge -> Bool
== :: Chain node edge -> Chain node edge -> Bool
$c== :: forall node edge.
(Eq node, Eq edge) =>
Chain node edge -> Chain node edge -> Bool
Eq, Int -> Chain node edge -> ShowS
[Chain node edge] -> ShowS
Chain node edge -> String
(Int -> Chain node edge -> ShowS)
-> (Chain node edge -> String)
-> ([Chain node edge] -> ShowS)
-> Show (Chain node edge)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall node edge.
(Show node, Show edge) =>
Int -> Chain node edge -> ShowS
forall node edge.
(Show node, Show edge) =>
[Chain node edge] -> ShowS
forall node edge.
(Show node, Show edge) =>
Chain node edge -> String
showList :: [Chain node edge] -> ShowS
$cshowList :: forall node edge.
(Show node, Show edge) =>
[Chain node edge] -> ShowS
show :: Chain node edge -> String
$cshow :: forall node edge.
(Show node, Show edge) =>
Chain node edge -> String
showsPrec :: Int -> Chain node edge -> ShowS
$cshowsPrec :: forall node edge.
(Show node, Show edge) =>
Int -> Chain node edge -> ShowS
Show)

instance Functor (Chain node) where
    fmap :: (a -> b) -> Chain node a -> Chain node b
fmap a -> b
f Chain node a
chain = Chain node a
chain{ next :: Map node (b, node)
next = ((a, node) -> (b, node))
-> Map node (a, node) -> Map node (b, node)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> (a, node) -> (b, node)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first a -> b
f) (Chain node a -> Map node (a, node)
forall node edge. Chain node edge -> Map node (edge, node)
next Chain node a
chain) }

-- | Test whether a node is contained in the chain.
member :: Ord node => node -> Chain node edge -> Bool
member :: node -> Chain node edge -> Bool
member node
node Chain{Map node (Maybe node)
prev :: Map node (Maybe node)
prev :: forall node edge. Chain node edge -> Map node (Maybe node)
prev} = node
node node -> Map node (Maybe node) -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`Map.member` Map node (Maybe node)
prev

-- | Context (incoming and outgoing edges) for a @node@ in a 'Chain'.
type ChainContext node edge = Edge (Maybe (edge,node)) node

-- | Look up the 'Context' of a node in a 'Chain'.
lookup :: Ord node => node -> Chain node edge -> Maybe (ChainContext node edge)
lookup :: node -> Chain node edge -> Maybe (ChainContext node edge)
lookup node
node Chain{Map node (edge, node)
next :: Map node (edge, node)
next :: forall node edge. Chain node edge -> Map node (edge, node)
next,Map node (Maybe node)
prev :: Map node (Maybe node)
prev :: forall node edge. Chain node edge -> Map node (Maybe node)
prev} =
    case (node -> Map node (edge, node) -> Maybe (edge, node)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup node
node Map node (edge, node)
next, node -> Map node (Maybe node) -> Maybe (Maybe node)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup node
node Map node (Maybe node)
prev) of
        (Maybe (edge, node)
_, Maybe (Maybe node)
Nothing) ->
            Maybe (ChainContext node edge)
forall a. Maybe a
Nothing
        (Maybe (edge, node)
after, Just Maybe node
Nothing) ->
            ChainContext node edge -> Maybe (ChainContext node edge)
forall a. a -> Maybe a
Just Edge :: forall node edge. node -> node -> edge -> Edge node edge
Edge{ via :: node
via=node
node, to :: Maybe (edge, node)
to=Maybe (edge, node)
after, from :: Maybe (edge, node)
from=Maybe (edge, node)
forall a. Maybe a
Nothing }
        (Maybe (edge, node)
after, Just (Just node
before)) -> let adjust :: (edge, node) -> (edge, node)
adjust (edge
e,node
_) = (edge
e,node
before) in
            ChainContext node edge -> Maybe (ChainContext node edge)
forall a. a -> Maybe a
Just Edge :: forall node edge. node -> node -> edge -> Edge node edge
Edge{ via :: node
via=node
node, to :: Maybe (edge, node)
to=Maybe (edge, node)
after, from :: Maybe (edge, node)
from=(edge, node) -> (edge, node)
adjust ((edge, node) -> (edge, node))
-> Maybe (edge, node) -> Maybe (edge, node)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> node -> Map node (edge, node) -> Maybe (edge, node)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup node
before Map node (edge, node)
next }

{-
-- | Chain with a single node and no edges.
--
-- FIXME: This cannot be represented in a database that only stores edges.
singleton :: Ord node => node -> Chain node edge
singleton node = Chain
    { next = Map.empty
    , prev = Map.fromList [(node, Nothing)]
    , tip  = node
    }
-}

-- | Construct a chain from a single 'Edge'.
fromEdge :: Ord node => Edge node edge -> Chain node edge
fromEdge :: Edge node edge -> Chain node edge
fromEdge Edge{node
from :: node
from :: forall node edge. Edge node edge -> node
from,node
to :: node
to :: forall node edge. Edge node edge -> node
to,edge
via :: edge
via :: forall node edge. Edge node edge -> edge
via} = Chain :: forall node edge.
Map node (edge, node)
-> Map node (Maybe node) -> node -> Chain node edge
Chain
    { next :: Map node (edge, node)
next = [(node, (edge, node))] -> Map node (edge, node)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(node
from, (edge
via,node
to))]
    , prev :: Map node (Maybe node)
prev = [(node, Maybe node)] -> Map node (Maybe node)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(node
to, node -> Maybe node
forall a. a -> Maybe a
Just node
from), (node
from, Maybe node
forall a. Maybe a
Nothing)]
    , tip :: node
tip  = node
to
    }

{- HLINT ignore fromEdges "Fuse foldr/map" -}
-- | Construct a chain from a collection of edges.
-- Fails if the edges do not fit together.
--
-- The ordering of edge labels of a single edge in the chain will
-- be the same as the ordering of the edge labels as they
-- appear in the list.
fromEdges :: Ord node => [Edge node edge] -> Maybe (Chain node [edge])
fromEdges :: [Edge node edge] -> Maybe (Chain node [edge])
fromEdges []     = Maybe (Chain node [edge])
forall a. Maybe a
Nothing
fromEdges (Edge node edge
e:[Edge node edge]
es) = ((Chain node [edge] -> Maybe (Chain node [edge]))
-> Chain node [edge] -> Maybe (Chain node [edge])
forall a b. (a -> b) -> a -> b
$ Edge node edge -> Chain node [edge]
forall a. Edge node a -> Chain node [a]
fromEdge' Edge node edge
e) ((Chain node [edge] -> Maybe (Chain node [edge]))
 -> Maybe (Chain node [edge]))
-> ([Chain node [edge] -> Maybe (Chain node [edge])]
    -> Chain node [edge] -> Maybe (Chain node [edge]))
-> [Chain node [edge] -> Maybe (Chain node [edge])]
-> Maybe (Chain node [edge])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Chain node [edge] -> Maybe (Chain node [edge]))
 -> (Chain node [edge] -> Maybe (Chain node [edge]))
 -> Chain node [edge]
 -> Maybe (Chain node [edge]))
-> (Chain node [edge] -> Maybe (Chain node [edge]))
-> [Chain node [edge] -> Maybe (Chain node [edge])]
-> Chain node [edge]
-> Maybe (Chain node [edge])
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Chain node [edge] -> Maybe (Chain node [edge]))
-> (Chain node [edge] -> Maybe (Chain node [edge]))
-> Chain node [edge]
-> Maybe (Chain node [edge])
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
(<=<) Chain node [edge] -> Maybe (Chain node [edge])
forall a. a -> Maybe a
Just ([Chain node [edge] -> Maybe (Chain node [edge])]
 -> Maybe (Chain node [edge]))
-> [Chain node [edge] -> Maybe (Chain node [edge])]
-> Maybe (Chain node [edge])
forall a b. (a -> b) -> a -> b
$ (Edge node edge -> Chain node [edge] -> Maybe (Chain node [edge]))
-> [Edge node edge]
-> [Chain node [edge] -> Maybe (Chain node [edge])]
forall a b. (a -> b) -> [a] -> [b]
map Edge node edge -> Chain node [edge] -> Maybe (Chain node [edge])
forall node edge.
Ord node =>
Edge node edge -> Chain node [edge] -> Maybe (Chain node [edge])
addEdge [Edge node edge]
es
  where fromEdge' :: Edge node a -> Chain node [a]
fromEdge' = (a -> [a]) -> Chain node a -> Chain node [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> [a] -> [a]
forall a. a -> [a] -> [a]
:[]) (Chain node a -> Chain node [a])
-> (Edge node a -> Chain node a) -> Edge node a -> Chain node [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Edge node a -> Chain node a
forall node edge. Ord node => Edge node edge -> Chain node edge
fromEdge

-- | List all edges in the 'Chain'.
--
-- The edge that points to the tip is listed /first/,
-- and the edge that starts at the beginning is listed /last/.
edges :: Ord node => Chain node edge -> [edge]
edges :: Chain node edge -> [edge]
edges Chain{Map node (Maybe node)
prev :: Map node (Maybe node)
prev :: forall node edge. Chain node edge -> Map node (Maybe node)
prev,Map node (edge, node)
next :: Map node (edge, node)
next :: forall node edge. Chain node edge -> Map node (edge, node)
next,node
tip :: node
tip :: forall node edge. Chain node edge -> node
tip} = (node -> Maybe (edge, node)) -> node -> [edge]
forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr node -> Maybe (edge, node)
backwards node
tip
  where
    backwards :: node -> Maybe (edge, node)
backwards node
now = do
        node
before <- Maybe (Maybe node) -> Maybe node
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Maybe (Maybe node) -> Maybe node)
-> Maybe (Maybe node) -> Maybe node
forall a b. (a -> b) -> a -> b
$ node -> Map node (Maybe node) -> Maybe (Maybe node)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup node
now Map node (Maybe node)
prev
        (edge
e,node
_)  <- node -> Map node (edge, node) -> Maybe (edge, node)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup node
before Map node (edge, node)
next
        (edge, node) -> Maybe (edge, node)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (edge
e,node
before)

-- | List all nodes in the 'Chain'.
-- The tip is listed /first/.
nodes :: Ord node => Chain node edge -> [node]
nodes :: Chain node edge -> [node]
nodes Chain{Map node (Maybe node)
prev :: Map node (Maybe node)
prev :: forall node edge. Chain node edge -> Map node (Maybe node)
prev,Map node (edge, node)
next :: Map node (edge, node)
next :: forall node edge. Chain node edge -> Map node (edge, node)
next,node
tip :: node
tip :: forall node edge. Chain node edge -> node
tip} = node
tip node -> [node] -> [node]
forall a. a -> [a] -> [a]
: (node -> Maybe (node, node)) -> node -> [node]
forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr node -> Maybe (node, node)
backwards node
tip
  where
    backwards :: node -> Maybe (node, node)
backwards node
now = do
        node
before <- Maybe (Maybe node) -> Maybe node
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Maybe (Maybe node) -> Maybe node)
-> Maybe (Maybe node) -> Maybe node
forall a b. (a -> b) -> a -> b
$ node -> Map node (Maybe node) -> Maybe (Maybe node)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup node
now Map node (Maybe node)
prev
        (edge
_,node
_)  <- node -> Map node (edge, node) -> Maybe (edge, node)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup node
before Map node (edge, node)
next
        (node, node) -> Maybe (node, node)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (node
before,node
before)

-- | Convert a 'Chain' into a list of 'Edge'.
toEdges :: Chain node edge -> [Edge node edge]
toEdges :: Chain node edge -> [Edge node edge]
toEdges Chain{Map node (edge, node)
next :: Map node (edge, node)
next :: forall node edge. Chain node edge -> Map node (edge, node)
next} =
    [ Edge :: forall node edge. node -> node -> edge -> Edge node edge
Edge{node
from :: node
from :: node
from,node
to :: node
to :: node
to,edge
via :: edge
via :: edge
via} | (node
from, (edge
via,node
to)) <- Map node (edge, node) -> [(node, (edge, node))]
forall k a. Map k a -> [(k, a)]
Map.toList Map node (edge, node)
next ]

-- | Combine all the edges in the 'Chain'.
-- The summary is invariant under 'collapseNode'.
--
-- > summary = mconcat . edges
summary :: (Ord node, Monoid edge) => Chain node edge -> edge
summary :: Chain node edge -> edge
summary = [edge] -> edge
forall a. Monoid a => [a] -> a
mconcat ([edge] -> edge)
-> (Chain node edge -> [edge]) -> Chain node edge -> edge
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Chain node edge -> [edge]
forall node edge. Ord node => Chain node edge -> [edge]
edges
-- FIXME: If a Chain without edges does not exist, then
-- we can go to Semigroup here.

{-------------------------------------------------------------------------------
    DeltaChain
-------------------------------------------------------------------------------}
-- | Changes to a 'Chain'.
data DeltaChain node edge
    = AppendTip node edge
    -- ^ See 'appendTip'.
    | CollapseNode node
    -- ^ See 'collapseNode'.
    | RollbackTo node
    -- ^ See 'rollbackTo'.

instance (Ord node, Semigroup edge) => Delta (DeltaChain node edge) where
    type Base (DeltaChain node edge) = Chain node edge
    apply :: DeltaChain node edge
-> Base (DeltaChain node edge) -> Base (DeltaChain node edge)
apply (AppendTip node
n edge
e) = node -> edge -> Chain node edge -> Chain node edge
forall node edge.
Ord node =>
node -> edge -> Chain node edge -> Chain node edge
appendTip node
n edge
e
    apply (CollapseNode node
n) = node -> Chain node edge -> Chain node edge
forall node edge.
(Ord node, Semigroup edge) =>
node -> Chain node edge -> Chain node edge
collapseNode node
n
    apply (RollbackTo node
n ) = node -> Chain node edge -> Chain node edge
forall node edge.
Ord node =>
node -> Chain node edge -> Chain node edge
rollbackTo node
n

-- | Append a new tip to the chain.
appendTip :: Ord node => node -> edge -> Chain node edge -> Chain node edge
appendTip :: node -> edge -> Chain node edge -> Chain node edge
appendTip node
new edge
edge Chain{Map node (edge, node)
next :: Map node (edge, node)
next :: forall node edge. Chain node edge -> Map node (edge, node)
next,Map node (Maybe node)
prev :: Map node (Maybe node)
prev :: forall node edge. Chain node edge -> Map node (Maybe node)
prev,tip :: forall node edge. Chain node edge -> node
tip=node
old} = Chain :: forall node edge.
Map node (edge, node)
-> Map node (Maybe node) -> node -> Chain node edge
Chain
    { next :: Map node (edge, node)
next = node
-> (edge, node) -> Map node (edge, node) -> Map node (edge, node)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert node
old (edge
edge, node
new) Map node (edge, node)
next
    , prev :: Map node (Maybe node)
prev = node
-> Maybe node -> Map node (Maybe node) -> Map node (Maybe node)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert node
new (node -> Maybe node
forall a. a -> Maybe a
Just node
old) Map node (Maybe node)
prev
    , tip :: node
tip  = node
new
    }

-- | Remove the given @node@ and combine the incoming and outgoing edges.
-- Do nothing if the node is at the tip, or at the bottom,
-- or not in the chain at all.
collapseNode
    :: (Ord node, Semigroup edge)
    => node -> Chain node edge -> Chain node edge
collapseNode :: node -> Chain node edge -> Chain node edge
collapseNode node
now chain :: Chain node edge
chain@Chain{Map node (edge, node)
next :: Map node (edge, node)
next :: forall node edge. Chain node edge -> Map node (edge, node)
next,Map node (Maybe node)
prev :: Map node (Maybe node)
prev :: forall node edge. Chain node edge -> Map node (Maybe node)
prev} =
    case node -> Chain node edge -> Maybe (ChainContext node edge)
forall node edge.
Ord node =>
node -> Chain node edge -> Maybe (ChainContext node edge)
lookup node
now Chain node edge
chain of
        -- Chain:   nto <--eto-- now <--efrom-- nfrom
        Just Edge{to :: forall node edge. Edge node edge -> node
to = Just (edge
eto,node
nto), from :: forall node edge. Edge node edge -> node
from = Just (edge
efrom,node
nfrom)} -> Chain node edge
chain
            { next :: Map node (edge, node)
next
                = node
-> (edge, node) -> Map node (edge, node) -> Map node (edge, node)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert node
nfrom (edge
eto edge -> edge -> edge
forall a. Semigroup a => a -> a -> a
<> edge
efrom, node
nto)
                (Map node (edge, node) -> Map node (edge, node))
-> Map node (edge, node) -> Map node (edge, node)
forall a b. (a -> b) -> a -> b
$ node -> Map node (edge, node) -> Map node (edge, node)
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete node
now Map node (edge, node)
next
            , prev :: Map node (Maybe node)
prev
                = node
-> Maybe node -> Map node (Maybe node) -> Map node (Maybe node)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert node
nto (node -> Maybe node
forall a. a -> Maybe a
Just node
nfrom)
                (Map node (Maybe node) -> Map node (Maybe node))
-> Map node (Maybe node) -> Map node (Maybe node)
forall a b. (a -> b) -> a -> b
$ node -> Map node (Maybe node) -> Map node (Maybe node)
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete node
now Map node (Maybe node)
prev
            }
        Maybe (ChainContext node edge)
_ -> Chain node edge
chain

-- | Remove the tip and more nodes from the chain until
-- the given node is the tip.
--
-- Do nothing if the node is not in the chain.
rollbackTo :: Ord node => node -> Chain node edge -> Chain node edge
rollbackTo :: node -> Chain node edge -> Chain node edge
rollbackTo node
new chain :: Chain node edge
chain@Chain{Map node (edge, node)
next :: Map node (edge, node)
next :: forall node edge. Chain node edge -> Map node (edge, node)
next,Map node (Maybe node)
prev :: Map node (Maybe node)
prev :: forall node edge. Chain node edge -> Map node (Maybe node)
prev,node
tip :: node
tip :: forall node edge. Chain node edge -> node
tip}
    | node
new node -> Chain node edge -> Bool
forall node edge. Ord node => node -> Chain node edge -> Bool
`member` Chain node edge
chain = Chain :: forall node edge.
Map node (edge, node)
-> Map node (Maybe node) -> node -> Chain node edge
Chain
        { next :: Map node (edge, node)
next = [node] -> Map node (edge, node) -> Map node (edge, node)
forall (t :: * -> *) k a.
(Foldable t, Ord k) =>
t k -> Map k a -> Map k a
deleteAll (node
newnode -> [node] -> [node]
forall a. a -> [a] -> [a]
:[node]
deletions) Map node (edge, node)
next
        , prev :: Map node (Maybe node)
prev = [node] -> Map node (Maybe node) -> Map node (Maybe node)
forall (t :: * -> *) k a.
(Foldable t, Ord k) =>
t k -> Map k a -> Map k a
deleteAll [node]
deletions Map node (Maybe node)
prev
        , tip :: node
tip  = node
new
        }
    | Bool
otherwise = Chain node edge
chain
  where
    deleteAll :: t k -> Map k a -> Map k a
deleteAll t k
dels Map k a
m = (k -> Map k a -> Map k a) -> Map k a -> t k -> Map k a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr k -> Map k a -> Map k a
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete Map k a
m t k
dels
    deletions :: [node]
deletions = (node -> Maybe (node, node)) -> node -> [node]
forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr node -> Maybe (node, node)
backwards node
tip
    backwards :: node -> Maybe (node, node)
backwards node
now = do
        Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ node
new node -> node -> Bool
forall a. Eq a => a -> a -> Bool
/= node
now
        node
x <- Maybe (Maybe node) -> Maybe node
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Maybe (Maybe node) -> Maybe node)
-> Maybe (Maybe node) -> Maybe node
forall a b. (a -> b) -> a -> b
$ node -> Map node (Maybe node) -> Maybe (Maybe node)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup node
now Map node (Maybe node)
prev
        (node, node) -> Maybe (node, node)
forall (m :: * -> *) a. Monad m => a -> m a
return (node
now,node
x)

-- | Helper: Add a single edge to a 'Chain' if possible.
-- The chain may contain gaps while adding edges.
addEdge
    :: Ord node
    => Edge node edge -> Chain node [edge] -> Maybe (Chain node [edge])
addEdge :: Edge node edge -> Chain node [edge] -> Maybe (Chain node [edge])
addEdge Edge{node
from :: node
from :: forall node edge. Edge node edge -> node
from,node
to :: node
to :: forall node edge. Edge node edge -> node
to,edge
via :: edge
via :: forall node edge. Edge node edge -> edge
via} chain :: Chain node [edge]
chain@Chain{Map node ([edge], node)
next :: Map node ([edge], node)
next :: forall node edge. Chain node edge -> Map node (edge, node)
next,Map node (Maybe node)
prev :: Map node (Maybe node)
prev :: forall node edge. Chain node edge -> Map node (Maybe node)
prev,node
tip :: node
tip :: forall node edge. Chain node edge -> node
tip} =
    case node -> Map node ([edge], node) -> Maybe ([edge], node)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup node
from Map node ([edge], node)
next of
        -- A connection from->to' already exists,
        -- add the edge if this has the same destination.
        Just ([edge]
es,node
to') -> do
            Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ node
to node -> node -> Bool
forall a. Eq a => a -> a -> Bool
== node
to'
            Chain node [edge] -> Maybe (Chain node [edge])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Chain node [edge] -> Maybe (Chain node [edge]))
-> Chain node [edge] -> Maybe (Chain node [edge])
forall a b. (a -> b) -> a -> b
$ Chain node [edge]
chain { next :: Map node ([edge], node)
next = node
-> ([edge], node)
-> Map node ([edge], node)
-> Map node ([edge], node)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert node
from (edge
viaedge -> [edge] -> [edge]
forall a. a -> [a] -> [a]
:[edge]
es,node
to) Map node ([edge], node)
next }
        -- No connection exists, create one.
        Maybe ([edge], node)
Nothing -> Chain node [edge] -> Maybe (Chain node [edge])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Chain node [edge] -> Maybe (Chain node [edge]))
-> Chain node [edge] -> Maybe (Chain node [edge])
forall a b. (a -> b) -> a -> b
$ Chain node [edge]
chain
            { next :: Map node ([edge], node)
next = node
-> ([edge], node)
-> Map node ([edge], node)
-> Map node ([edge], node)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert node
from ([edge
via], node
to) Map node ([edge], node)
next
            , prev :: Map node (Maybe node)
prev
                = node
-> Maybe node -> Map node (Maybe node) -> Map node (Maybe node)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert node
to (node -> Maybe node
forall a. a -> Maybe a
Just node
from)
                (Map node (Maybe node) -> Map node (Maybe node))
-> (Map node (Maybe node) -> Map node (Maybe node))
-> Map node (Maybe node)
-> Map node (Maybe node)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe node -> Maybe node -> Maybe node)
-> node
-> Maybe node
-> Map node (Maybe node)
-> Map node (Maybe node)
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith (\Maybe node
_new Maybe node
old -> Maybe node
old) node
from Maybe node
forall a. Maybe a
Nothing
                (Map node (Maybe node) -> Map node (Maybe node))
-> Map node (Maybe node) -> Map node (Maybe node)
forall a b. (a -> b) -> a -> b
$ Map node (Maybe node)
prev
            , tip :: node
tip = if node
from node -> node -> Bool
forall a. Eq a => a -> a -> Bool
== node
tip then node
to else node
tip
            }

-- | Embed a 'Chain' into a table of 'Edge'.
--
-- The first and second argument specify how the edge labels
-- are to be mapped to and from sets of table rows.
-- Importantly, we may not assume that the table stores
-- the rows in any particular order.
chainIntoTable
    :: (Ord node, Semigroup edge)
    => (edge -> Pile e) -> (Pile e -> edge)
    -> Embedding (DeltaChain node edge) [DeltaTable (Edge node e)]
chainIntoTable :: (edge -> Pile e)
-> (Pile e -> edge)
-> Embedding (DeltaChain node edge) [DeltaTable (Edge node e)]
chainIntoTable edge -> Pile e
toPile Pile e -> edge
fromPile = Embedding' (DeltaChain node edge) [DeltaTable (Edge node e)]
-> Embedding (DeltaChain node edge) [DeltaTable (Edge node e)]
forall da db. Embedding' da db -> Embedding da db
mkEmbedding Embedding' :: forall da db a b.
(Delta da, Delta db, a ~ Base da, b ~ Base db) =>
(b -> Either SomeException a)
-> (a -> b) -> (a -> b -> da -> db) -> Embedding' da db
Embedding'{Table (Edge node e) -> Either SomeException (Chain node edge)
load :: Table (Edge node e) -> Either SomeException (Chain node edge)
load :: Table (Edge node e) -> Either SomeException (Chain node edge)
load,Chain node edge -> Table (Edge node e)
write :: Chain node edge -> Table (Edge node e)
write :: Chain node edge -> Table (Edge node e)
write,Chain node edge
-> Table (Edge node e)
-> DeltaChain node edge
-> [DeltaTable (Edge node e)]
update :: Chain node edge
-> Table (Edge node e)
-> DeltaChain node edge
-> [DeltaTable (Edge node e)]
update :: Chain node edge
-> Table (Edge node e)
-> DeltaChain node edge
-> [DeltaTable (Edge node e)]
update}
  where
    load :: Table (Edge node e) -> Either SomeException (Chain node edge)
load = Maybe (Chain node edge) -> Either SomeException (Chain node edge)
forall b. Maybe b -> Either SomeException b
toEither (Maybe (Chain node edge) -> Either SomeException (Chain node edge))
-> (Table (Edge node e) -> Maybe (Chain node edge))
-> Table (Edge node e)
-> Either SomeException (Chain node edge)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Chain node [e] -> Chain node edge)
-> Maybe (Chain node [e]) -> Maybe (Chain node edge)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([e] -> edge) -> Chain node [e] -> Chain node edge
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([e] -> edge) -> Chain node [e] -> Chain node edge)
-> ([e] -> edge) -> Chain node [e] -> Chain node edge
forall a b. (a -> b) -> a -> b
$ Pile e -> edge
fromPile (Pile e -> edge) -> ([e] -> Pile e) -> [e] -> edge
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [e] -> Pile e
forall a. [a] -> Pile a
Pile)
        (Maybe (Chain node [e]) -> Maybe (Chain node edge))
-> (Table (Edge node e) -> Maybe (Chain node [e]))
-> Table (Edge node e)
-> Maybe (Chain node edge)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Edge node e] -> Maybe (Chain node [e])
forall node edge.
Ord node =>
[Edge node edge] -> Maybe (Chain node [edge])
fromEdges ([Edge node e] -> Maybe (Chain node [e]))
-> (Table (Edge node e) -> [Edge node e])
-> Table (Edge node e)
-> Maybe (Chain node [e])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pile (Edge node e) -> [Edge node e]
forall a. Pile a -> [a]
getPile (Pile (Edge node e) -> [Edge node e])
-> (Table (Edge node e) -> Pile (Edge node e))
-> Table (Edge node e)
-> [Edge node e]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Table (Edge node e) -> Pile (Edge node e)
forall row. Table row -> Pile row
Table.toPile
      where
        toEither :: Maybe b -> Either SomeException b
toEither = Either SomeException b
-> (b -> Either SomeException b)
-> Maybe b
-> Either SomeException b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (SomeException -> Either SomeException b
forall a b. a -> Either a b
Left (SomeException -> Either SomeException b)
-> SomeException -> Either SomeException b
forall a b. (a -> b) -> a -> b
$ ErrMalformedChainTable -> SomeException
forall e. Exception e => e -> SomeException
toException ErrMalformedChainTable
ErrMalformedChainTable) b -> Either SomeException b
forall a b. b -> Either a b
Right

    write :: Chain node edge -> Table (Edge node e)
write = [Edge node e] -> Table (Edge node e)
forall row. [row] -> Table row
Table.fromList
        ([Edge node e] -> Table (Edge node e))
-> (Chain node edge -> [Edge node e])
-> Chain node edge
-> Table (Edge node e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Edge node edge -> [Edge node e])
-> [Edge node edge] -> [Edge node e]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Edge node [e] -> [Edge node e]
forall node edge. Edge node [edge] -> [Edge node edge]
flattenEdge (Edge node [e] -> [Edge node e])
-> (Edge node edge -> Edge node [e])
-> Edge node edge
-> [Edge node e]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (edge -> [e]) -> Edge node edge -> Edge node [e]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Pile e -> [e]
forall a. Pile a -> [a]
getPile (Pile e -> [e]) -> (edge -> Pile e) -> edge -> [e]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. edge -> Pile e
toPile)) ([Edge node edge] -> [Edge node e])
-> (Chain node edge -> [Edge node edge])
-> Chain node edge
-> [Edge node e]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Chain node edge -> [Edge node edge]
forall node edge. Chain node edge -> [Edge node edge]
toEdges

    update :: Chain node edge
-> Table (Edge node e)
-> DeltaChain node edge
-> [DeltaTable (Edge node e)]
update Chain{tip :: forall node edge. Chain node edge -> node
tip=node
from} Table (Edge node e)
_ (AppendTip node
to edge
vias) =
        [[Edge node e] -> DeltaTable (Edge node e)
forall row. [row] -> DeltaTable row
InsertMany [Edge :: forall node edge. node -> node -> edge -> Edge node edge
Edge{node
from :: node
from :: node
from,node
to :: node
to :: node
to,e
via :: e
via :: e
via} | e
via <- Pile e -> [e]
forall a. Pile a -> [a]
getPile (Pile e -> [e]) -> Pile e -> [e]
forall a b. (a -> b) -> a -> b
$ edge -> Pile e
toPile edge
vias]]
    update Chain{node
tip :: node
tip :: forall node edge. Chain node edge -> node
tip,Map node (Maybe node)
prev :: Map node (Maybe node)
prev :: forall node edge. Chain node edge -> Map node (Maybe node)
prev} Table (Edge node e)
_ (RollbackTo node
node) =
        [(Edge node e -> Bool) -> DeltaTable (Edge node e)
forall row. (row -> Bool) -> DeltaTable row
DeleteWhere ((Edge node e -> Bool) -> DeltaTable (Edge node e))
-> (Edge node e -> Bool) -> DeltaTable (Edge node e)
forall a b. (a -> b) -> a -> b
$ \Edge{node
to :: node
to :: forall node edge. Edge node edge -> node
to} -> node
to node -> [node] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [node]
deletions]
      where
        deletions :: [node]
deletions = (node -> Maybe (node, node)) -> node -> [node]
forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr node -> Maybe (node, node)
backwards node
tip
        backwards :: node -> Maybe (node, node)
backwards node
now = do
            Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ node
node node -> node -> Bool
forall a. Eq a => a -> a -> Bool
/= node
now
            node
x <- Maybe (Maybe node) -> Maybe node
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Maybe (Maybe node) -> Maybe node)
-> Maybe (Maybe node) -> Maybe node
forall a b. (a -> b) -> a -> b
$ node -> Map node (Maybe node) -> Maybe (Maybe node)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup node
now Map node (Maybe node)
prev
            (node, node) -> Maybe (node, node)
forall (m :: * -> *) a. Monad m => a -> m a
return (node
now,node
x)
    update Chain node edge
chain Table (Edge node e)
_ (CollapseNode node
now) = case node -> Chain node edge -> Maybe (ChainContext node edge)
forall node edge.
Ord node =>
node -> Chain node edge -> Maybe (ChainContext node edge)
lookup node
now Chain node edge
chain of
        Just Edge{to :: forall node edge. Edge node edge -> node
to=Just (edge
eto,node
nto), from :: forall node edge. Edge node edge -> node
from=Just (edge
efrom,node
nfrom)} ->
            -- insert new edges
            [ [Edge node e] -> DeltaTable (Edge node e)
forall row. [row] -> DeltaTable row
InsertMany
                [ Edge :: forall node edge. node -> node -> edge -> Edge node edge
Edge{to :: node
to=node
nto,from :: node
from=node
nfrom,e
via :: e
via :: e
via}
                | e
via <- Pile e -> [e]
forall a. Pile a -> [a]
getPile (Pile e -> [e]) -> Pile e -> [e]
forall a b. (a -> b) -> a -> b
$ edge -> Pile e
toPile (edge
eto edge -> edge -> edge
forall a. Semigroup a => a -> a -> a
<> edge
efrom)
                ]
            -- delete old edges
            , (Edge node e -> Bool) -> DeltaTable (Edge node e)
forall row. (row -> Bool) -> DeltaTable row
DeleteWhere (\Edge{node
to :: node
to :: forall node edge. Edge node edge -> node
to,node
from :: node
from :: forall node edge. Edge node edge -> node
from} -> node
to node -> node -> Bool
forall a. Eq a => a -> a -> Bool
== node
now Bool -> Bool -> Bool
|| node
from node -> node -> Bool
forall a. Eq a => a -> a -> Bool
== node
now)
            ]
        Maybe (ChainContext node edge)
_ -> []

data ErrMalformedChainTable = ErrMalformedChainTable deriving (ErrMalformedChainTable -> ErrMalformedChainTable -> Bool
(ErrMalformedChainTable -> ErrMalformedChainTable -> Bool)
-> (ErrMalformedChainTable -> ErrMalformedChainTable -> Bool)
-> Eq ErrMalformedChainTable
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ErrMalformedChainTable -> ErrMalformedChainTable -> Bool
$c/= :: ErrMalformedChainTable -> ErrMalformedChainTable -> Bool
== :: ErrMalformedChainTable -> ErrMalformedChainTable -> Bool
$c== :: ErrMalformedChainTable -> ErrMalformedChainTable -> Bool
Eq, Int -> ErrMalformedChainTable -> ShowS
[ErrMalformedChainTable] -> ShowS
ErrMalformedChainTable -> String
(Int -> ErrMalformedChainTable -> ShowS)
-> (ErrMalformedChainTable -> String)
-> ([ErrMalformedChainTable] -> ShowS)
-> Show ErrMalformedChainTable
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ErrMalformedChainTable] -> ShowS
$cshowList :: [ErrMalformedChainTable] -> ShowS
show :: ErrMalformedChainTable -> String
$cshow :: ErrMalformedChainTable -> String
showsPrec :: Int -> ErrMalformedChainTable -> ShowS
$cshowsPrec :: Int -> ErrMalformedChainTable -> ShowS
Show)
instance Exception ErrMalformedChainTable

{-------------------------------------------------------------------------------
    Tests
-------------------------------------------------------------------------------}
testChain :: (Table (Edge Int Char), [[Table.DeltaDB Int (Edge Int Char)]])
testChain :: (Table (Edge Int Char), [[DeltaDB Int (Edge Int Char)]])
testChain = Embedding (DeltaChain Int String) [DeltaDB Int (Edge Int Char)]
-> [DeltaChain Int String]
-> Base (DeltaChain Int String)
-> (Base [DeltaDB Int (Edge Int Char)],
    [[DeltaDB Int (Edge Int Char)]])
forall da db.
Delta da =>
Embedding da db -> [da] -> Base da -> (Base db, [db])
liftUpdates (Embedding
  [DeltaTable (Edge Int Char)] [DeltaDB Int (Edge Int Char)]
forall row. Embedding [DeltaTable row] [DeltaDB Int row]
Table.tableIntoDatabase Embedding
  [DeltaTable (Edge Int Char)] [DeltaDB Int (Edge Int Char)]
-> Embedding (DeltaChain Int String) [DeltaTable (Edge Int Char)]
-> Embedding (DeltaChain Int String) [DeltaDB Int (Edge Int Char)]
forall k (c :: k -> k -> *) (j :: k) (k1 :: k) (i :: k).
Semigroupoid c =>
c j k1 -> c i j -> c i k1
`o` (String -> Pile Char)
-> (Pile Char -> String)
-> Embedding (DeltaChain Int String) [DeltaTable (Edge Int Char)]
forall node edge e.
(Ord node, Semigroup edge) =>
(edge -> Pile e)
-> (Pile e -> edge)
-> Embedding (DeltaChain node edge) [DeltaTable (Edge node e)]
chainIntoTable String -> Pile Char
forall a. [a] -> Pile a
Pile Pile Char -> String
forall a. Pile a -> [a]
getPile)
    [Int -> DeltaChain Int String
forall node edge. node -> DeltaChain node edge
CollapseNode Int
1, Int -> DeltaChain Int String
forall node edge. node -> DeltaChain node edge
CollapseNode Int
2, Int -> String -> DeltaChain Int String
forall node edge. node -> edge -> DeltaChain node edge
AppendTip Int
3 String
"c", Int -> String -> DeltaChain Int String
forall node edge. node -> edge -> DeltaChain node edge
AppendTip Int
2 String
"b"]
    (Base (DeltaChain Int String)
 -> (Base [DeltaDB Int (Edge Int Char)],
     [[DeltaDB Int (Edge Int Char)]]))
-> Base (DeltaChain Int String)
-> (Base [DeltaDB Int (Edge Int Char)],
    [[DeltaDB Int (Edge Int Char)]])
forall a b. (a -> b) -> a -> b
$ Edge Int String -> Chain Int String
forall node edge. Ord node => Edge node edge -> Chain node edge
fromEdge Edge :: forall node edge. node -> node -> edge -> Edge node edge
Edge{from :: Int
from=Int
0,to :: Int
to=Int
1,via :: String
via=String
"a"}

{-------------------------------------------------------------------------------
    Edge
-------------------------------------------------------------------------------}
-- | Utility type that represents an 'Edge' in a graph:
-- it connects two @node@ via an @edge@ label.
data Edge node edge = Edge
    { Edge node edge -> node
from :: node
    , Edge node edge -> node
to   :: node
    , Edge node edge -> edge
via  :: edge
    } deriving (Edge node edge -> Edge node edge -> Bool
(Edge node edge -> Edge node edge -> Bool)
-> (Edge node edge -> Edge node edge -> Bool)
-> Eq (Edge node edge)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall node edge.
(Eq node, Eq edge) =>
Edge node edge -> Edge node edge -> Bool
/= :: Edge node edge -> Edge node edge -> Bool
$c/= :: forall node edge.
(Eq node, Eq edge) =>
Edge node edge -> Edge node edge -> Bool
== :: Edge node edge -> Edge node edge -> Bool
$c== :: forall node edge.
(Eq node, Eq edge) =>
Edge node edge -> Edge node edge -> Bool
Eq, Eq (Edge node edge)
Eq (Edge node edge)
-> (Edge node edge -> Edge node edge -> Ordering)
-> (Edge node edge -> Edge node edge -> Bool)
-> (Edge node edge -> Edge node edge -> Bool)
-> (Edge node edge -> Edge node edge -> Bool)
-> (Edge node edge -> Edge node edge -> Bool)
-> (Edge node edge -> Edge node edge -> Edge node edge)
-> (Edge node edge -> Edge node edge -> Edge node edge)
-> Ord (Edge node edge)
Edge node edge -> Edge node edge -> Bool
Edge node edge -> Edge node edge -> Ordering
Edge node edge -> Edge node edge -> Edge node 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
forall node edge. (Ord node, Ord edge) => Eq (Edge node edge)
forall node edge.
(Ord node, Ord edge) =>
Edge node edge -> Edge node edge -> Bool
forall node edge.
(Ord node, Ord edge) =>
Edge node edge -> Edge node edge -> Ordering
forall node edge.
(Ord node, Ord edge) =>
Edge node edge -> Edge node edge -> Edge node edge
min :: Edge node edge -> Edge node edge -> Edge node edge
$cmin :: forall node edge.
(Ord node, Ord edge) =>
Edge node edge -> Edge node edge -> Edge node edge
max :: Edge node edge -> Edge node edge -> Edge node edge
$cmax :: forall node edge.
(Ord node, Ord edge) =>
Edge node edge -> Edge node edge -> Edge node edge
>= :: Edge node edge -> Edge node edge -> Bool
$c>= :: forall node edge.
(Ord node, Ord edge) =>
Edge node edge -> Edge node edge -> Bool
> :: Edge node edge -> Edge node edge -> Bool
$c> :: forall node edge.
(Ord node, Ord edge) =>
Edge node edge -> Edge node edge -> Bool
<= :: Edge node edge -> Edge node edge -> Bool
$c<= :: forall node edge.
(Ord node, Ord edge) =>
Edge node edge -> Edge node edge -> Bool
< :: Edge node edge -> Edge node edge -> Bool
$c< :: forall node edge.
(Ord node, Ord edge) =>
Edge node edge -> Edge node edge -> Bool
compare :: Edge node edge -> Edge node edge -> Ordering
$ccompare :: forall node edge.
(Ord node, Ord edge) =>
Edge node edge -> Edge node edge -> Ordering
$cp1Ord :: forall node edge. (Ord node, Ord edge) => Eq (Edge node edge)
Ord, Int -> Edge node edge -> ShowS
[Edge node edge] -> ShowS
Edge node edge -> String
(Int -> Edge node edge -> ShowS)
-> (Edge node edge -> String)
-> ([Edge node edge] -> ShowS)
-> Show (Edge node edge)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall node edge.
(Show node, Show edge) =>
Int -> Edge node edge -> ShowS
forall node edge.
(Show node, Show edge) =>
[Edge node edge] -> ShowS
forall node edge.
(Show node, Show edge) =>
Edge node edge -> String
showList :: [Edge node edge] -> ShowS
$cshowList :: forall node edge.
(Show node, Show edge) =>
[Edge node edge] -> ShowS
show :: Edge node edge -> String
$cshow :: forall node edge.
(Show node, Show edge) =>
Edge node edge -> String
showsPrec :: Int -> Edge node edge -> ShowS
$cshowsPrec :: forall node edge.
(Show node, Show edge) =>
Int -> Edge node edge -> ShowS
Show)

instance Functor (Edge node) where
    fmap :: (a -> b) -> Edge node a -> Edge node b
fmap a -> b
f e :: Edge node a
e@Edge{a
via :: a
via :: forall node edge. Edge node edge -> edge
via} = Edge node a
e{ via :: b
via = a -> b
f a
via }

-- | Flatten a list of edges
flattenEdge :: Edge node [edge] -> [Edge node edge]
flattenEdge :: Edge node [edge] -> [Edge node edge]
flattenEdge Edge{node
to :: node
to :: forall node edge. Edge node edge -> node
to,node
from :: node
from :: forall node edge. Edge node edge -> node
from,[edge]
via :: [edge]
via :: forall node edge. Edge node edge -> edge
via} = [ Edge :: forall node edge. node -> node -> edge -> Edge node edge
Edge{node
to :: node
to :: node
to,node
from :: node
from :: node
from,via :: edge
via=edge
v} | edge
v <- [edge]
via ]