module Text.Dot.Build
  ( node
  , edge
  , (-->)
  , subgraphWith
  , subgraph
  , subgraphWith_
  , subgraph_
  , clusterWith
  , cluster
  , clusterWith_
  , cluster_
  ) where

import "this" Prelude

import Control.Lens
import Data.List.NonEmpty  qualified as NE

import Text.Dot.Attributes
import Text.Dot.Monad
import Text.Dot.Types


--------------------------------------------------------------------------------
-- Entity creation functions

-- | Creates a node in the graph, at the current t'Path', with the given label.
--
-- The newly created node will be assigned all of the default 'Node' attributes
-- (see 'defaults'). This returns a new t'Entity' that uniquely identifies this
-- node in the graph, with the attribute "label" set to the given argument.
--
-- This function updates the 'its' entity to this node.
node :: MonadDot m => Text -> m Entity
node :: forall (m :: * -> *). MonadDot m => Text -> m Entity
node Text
desc = do
  Entity
entity <- EntityType -> m Entity
forall (m :: * -> *). MonadDot m => EntityType -> m Entity
register EntityType
Node
  Lens' Attributes (Maybe Text) -> Lens' DotGraph (Maybe Text)
its (Maybe Text -> f (Maybe Text)) -> Attributes -> f Attributes
Lens' Attributes (Maybe Text)
label ((Maybe Text -> Identity (Maybe Text))
 -> DotGraph -> Identity DotGraph)
-> Text -> m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a (Maybe b) -> b -> m ()
?= Text
desc
  pure Entity
entity

-- | Creates an edge in the graph, at the current t'Path'.
--
-- The newly created edge will be assigned all of the default 'Edge' attributes
-- (see 'defaults'). This returns a new t'Entity' that uniquely identifies this
-- edge in the graph.
--
-- If an entity is a cluster, we set the graph's "compound" property to true,
-- and we attempt to locate any node within it. If there isn't any, we fail
-- silently by outputing a valid but unexpected edge.
--
-- This function updates the 'its' entity to this edge.
edge :: MonadDot m => Entity -> Entity -> m Entity
edge :: forall (m :: * -> *). MonadDot m => Entity -> Entity -> m Entity
edge Entity
a Entity
b = do
  Entity
na <- Entity -> m Entity
forall (m :: * -> *). MonadDot m => Entity -> m Entity
getTail Entity
a
  Entity
nb <- Entity -> m Entity
forall (m :: * -> *). MonadDot m => Entity -> m Entity
getHead Entity
b
  Entity
entity <- EntityType -> m Entity
forall (m :: * -> *). MonadDot m => EntityType -> m Entity
register EntityType
Edge
  (HashMap Entity EdgeInfo -> Identity (HashMap Entity EdgeInfo))
-> DotGraph -> Identity DotGraph
Lens' DotGraph (HashMap Entity EdgeInfo)
edgeInfo ((HashMap Entity EdgeInfo -> Identity (HashMap Entity EdgeInfo))
 -> DotGraph -> Identity DotGraph)
-> ((Maybe EdgeInfo -> Identity (Maybe EdgeInfo))
    -> HashMap Entity EdgeInfo -> Identity (HashMap Entity EdgeInfo))
-> (Maybe EdgeInfo -> Identity (Maybe EdgeInfo))
-> DotGraph
-> Identity DotGraph
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (HashMap Entity EdgeInfo)
-> Lens'
     (HashMap Entity EdgeInfo)
     (Maybe (IxValue (HashMap Entity EdgeInfo)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (HashMap Entity EdgeInfo)
Entity
entity ((Maybe EdgeInfo -> Identity (Maybe EdgeInfo))
 -> DotGraph -> Identity DotGraph)
-> EdgeInfo -> m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a (Maybe b) -> b -> m ()
?= Entity -> Entity -> Entity -> Entity -> EdgeInfo
EdgeInfo Entity
a Entity
b Entity
na Entity
nb
  pure Entity
entity

-- | Alias for 'edge'.
--
-- This can be used in both directed and undirected graphs: the rendering
-- process will tke care of using the correct symbol in the generated DOT file.
--
-- > graph do
-- >   x <- node "x"
-- >   y <- node "y"
-- >   z <- node "z"
-- >   x --> y
-- >   x --> z
--
-- This function updates the 'its' entity to this edge.
(-->) :: MonadDot m => Entity -> Entity -> m Entity
--> :: forall (m :: * -> *). MonadDot m => Entity -> Entity -> m Entity
(-->) = Entity -> Entity -> m Entity
forall (m :: * -> *). MonadDot m => Entity -> Entity -> m Entity
edge

-- | Creates a subgraph in the given context.
--
-- The newly created subgraph will be assigned all of the default 'Subgraph'
-- attributes (see 'defaults'). The argument to this function is a callback that
-- takes the newly minted t'Entity' and creates the corresponding subgraph.
--
-- This function updates the 'its' entity to this node *twice*: before executing
-- the callback, and before returning.
--
-- > graph do
-- >   (subgraphID, nodeID) <- subgraphWith \subgraphID -> do
-- >     its fontcolor ?= "green" -- points to the subgraph
-- >     x <- node "x"
-- >     its fontcolor ?= "red"   -- points to node "x"
-- >     pure x
-- >   use (its fontcolor)        -- points to the subgraph, returns green
--
-- This returns a pair containing the subgraph's t'Entity' and the result of the
-- subexpression.
subgraphWith :: MonadDot m => (Entity -> m a) -> m (Entity, a)
subgraphWith :: forall (m :: * -> *) a.
MonadDot m =>
(Entity -> m a) -> m (Entity, a)
subgraphWith = EntityType -> (Entity -> m a) -> m (Entity, a)
forall (m :: * -> *) a.
MonadDot m =>
EntityType -> (Entity -> m a) -> m (Entity, a)
recurse EntityType
Subgraph

-- | Like 'subgraphWith', but the subexpression doesn't take the t'Entity' as
-- argument.
subgraph :: MonadDot m => m a -> m (Entity, a)
subgraph :: forall (m :: * -> *) a. MonadDot m => m a -> m (Entity, a)
subgraph = EntityType -> (Entity -> m a) -> m (Entity, a)
forall (m :: * -> *) a.
MonadDot m =>
EntityType -> (Entity -> m a) -> m (Entity, a)
recurse EntityType
Subgraph ((Entity -> m a) -> m (Entity, a))
-> (m a -> Entity -> m a) -> m a -> m (Entity, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> Entity -> m a
forall a b. a -> b -> a
const

-- | Like 'subgraphWith', but does not return the subgraph's t'Entity'.
subgraphWith_ :: MonadDot m => (Entity -> m a) -> m a
subgraphWith_ :: forall (m :: * -> *) a. MonadDot m => (Entity -> m a) -> m a
subgraphWith_ = ((Entity, a) -> a) -> m (Entity, a) -> m a
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Entity, a) -> a
forall a b. (a, b) -> b
snd (m (Entity, a) -> m a)
-> ((Entity -> m a) -> m (Entity, a)) -> (Entity -> m a) -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EntityType -> (Entity -> m a) -> m (Entity, a)
forall (m :: * -> *) a.
MonadDot m =>
EntityType -> (Entity -> m a) -> m (Entity, a)
recurse EntityType
Subgraph

-- | Like 'subgraphWith', but the subexpression doesn't take the t'Entity' as
-- argument, and it does not return the subgraph's t'Entity'.
subgraph_ :: MonadDot m => m a -> m a
subgraph_ :: forall (m :: * -> *) a. MonadDot m => m a -> m a
subgraph_ = ((Entity, a) -> a) -> m (Entity, a) -> m a
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Entity, a) -> a
forall a b. (a, b) -> b
snd (m (Entity, a) -> m a) -> (m a -> m (Entity, a)) -> m a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EntityType -> (Entity -> m a) -> m (Entity, a)
forall (m :: * -> *) a.
MonadDot m =>
EntityType -> (Entity -> m a) -> m (Entity, a)
recurse EntityType
Subgraph ((Entity -> m a) -> m (Entity, a))
-> (m a -> Entity -> m a) -> m a -> m (Entity, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> Entity -> m a
forall a b. a -> b -> a
const

-- | Like 'subgraphWith', but creates a cluster instead.
--
-- The created entity will use the default 'Cluster' attributes.
clusterWith :: MonadDot m => (Entity -> m a) -> m (Entity, a)
clusterWith :: forall (m :: * -> *) a.
MonadDot m =>
(Entity -> m a) -> m (Entity, a)
clusterWith = EntityType -> (Entity -> m a) -> m (Entity, a)
forall (m :: * -> *) a.
MonadDot m =>
EntityType -> (Entity -> m a) -> m (Entity, a)
recurse EntityType
Cluster

-- | Like 'clusterWith', but the subexpression doesn't take the t'Entity' as
-- argument.
cluster :: MonadDot m => m a -> m (Entity, a)
cluster :: forall (m :: * -> *) a. MonadDot m => m a -> m (Entity, a)
cluster = EntityType -> (Entity -> m a) -> m (Entity, a)
forall (m :: * -> *) a.
MonadDot m =>
EntityType -> (Entity -> m a) -> m (Entity, a)
recurse EntityType
Cluster ((Entity -> m a) -> m (Entity, a))
-> (m a -> Entity -> m a) -> m a -> m (Entity, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> Entity -> m a
forall a b. a -> b -> a
const

-- | Like 'clusterWith', but does not return the cluster's t'Entity'.
clusterWith_ :: MonadDot m => (Entity -> m a) -> m a
clusterWith_ :: forall (m :: * -> *) a. MonadDot m => (Entity -> m a) -> m a
clusterWith_ = ((Entity, a) -> a) -> m (Entity, a) -> m a
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Entity, a) -> a
forall a b. (a, b) -> b
snd (m (Entity, a) -> m a)
-> ((Entity -> m a) -> m (Entity, a)) -> (Entity -> m a) -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EntityType -> (Entity -> m a) -> m (Entity, a)
forall (m :: * -> *) a.
MonadDot m =>
EntityType -> (Entity -> m a) -> m (Entity, a)
recurse EntityType
Cluster

-- | Like 'clusterWith', but the subexpression doesn't take the t'Entity' as
-- argument, and it does not return the cluster's t'Entity'.
cluster_ :: MonadDot m => m a -> m a
cluster_ :: forall (m :: * -> *) a. MonadDot m => m a -> m a
cluster_ = ((Entity, a) -> a) -> m (Entity, a) -> m a
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Entity, a) -> a
forall a b. (a, b) -> b
snd (m (Entity, a) -> m a) -> (m a -> m (Entity, a)) -> m a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EntityType -> (Entity -> m a) -> m (Entity, a)
forall (m :: * -> *) a.
MonadDot m =>
EntityType -> (Entity -> m a) -> m (Entity, a)
recurse EntityType
Cluster ((Entity -> m a) -> m (Entity, a))
-> (m a -> Entity -> m a) -> m a -> m (Entity, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> Entity -> m a
forall a b. a -> b -> a
const


--------------------------------------------------------------------------------
-- Internal helpers

recurse :: MonadDot m => EntityType -> (Entity -> m a) -> m (Entity, a)
recurse :: forall (m :: * -> *) a.
MonadDot m =>
EntityType -> (Entity -> m a) -> m (Entity, a)
recurse EntityType
etype Entity -> m a
callback = do
  Entity
entity <- EntityType -> m Entity
forall (m :: * -> *). MonadDot m => EntityType -> m Entity
register EntityType
etype
  (NonEmpty DotContext -> Identity (NonEmpty DotContext))
-> DotGraph -> Identity DotGraph
Lens' DotGraph (NonEmpty DotContext)
contextStack ((NonEmpty DotContext -> Identity (NonEmpty DotContext))
 -> DotGraph -> Identity DotGraph)
-> (NonEmpty DotContext -> NonEmpty DotContext) -> m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= DotContext -> NonEmpty DotContext -> NonEmpty DotContext
forall a. a -> NonEmpty a -> NonEmpty a
NE.cons DotContext
forall a. Monoid a => a
mempty
  a
result <- Entity -> m a -> m a
forall (m :: * -> *) a. MonadDot m => Entity -> m a -> m a
withPath Entity
entity (m a -> m a) -> m a -> m a
forall a b. (a -> b) -> a -> b
$ Entity -> m a
callback Entity
entity
  DotContext
sub <- m DotContext
forall (m :: * -> *). MonadDot m => m DotContext
popContext
  (HashMap Entity DotContext -> Identity (HashMap Entity DotContext))
-> DotGraph -> Identity DotGraph
Lens' DotGraph (HashMap Entity DotContext)
subgraphInfo ((HashMap Entity DotContext
  -> Identity (HashMap Entity DotContext))
 -> DotGraph -> Identity DotGraph)
-> ((Maybe DotContext -> Identity (Maybe DotContext))
    -> HashMap Entity DotContext
    -> Identity (HashMap Entity DotContext))
-> (Maybe DotContext -> Identity (Maybe DotContext))
-> DotGraph
-> Identity DotGraph
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (HashMap Entity DotContext)
-> Lens'
     (HashMap Entity DotContext)
     (Maybe (IxValue (HashMap Entity DotContext)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (HashMap Entity DotContext)
Entity
entity ((Maybe DotContext -> Identity (Maybe DotContext))
 -> DotGraph -> Identity DotGraph)
-> DotContext -> m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a (Maybe b) -> b -> m ()
?= DotContext
sub
  (Entity -> Identity Entity) -> DotGraph -> Identity DotGraph
Lens' DotGraph Entity
latest ((Entity -> Identity Entity) -> DotGraph -> Identity DotGraph)
-> Entity -> m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Entity
entity
  pure (Entity
entity, a
result)

register :: MonadDot m => EntityType -> m Entity
register :: forall (m :: * -> *). MonadDot m => EntityType -> m Entity
register EntityType
etype = do
  Int
suffix <- Getting Int DotGraph Int -> m Int
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Int DotGraph Int
Lens' DotGraph Int
entityIndex
  let entity :: Entity
entity = EntityType -> Int -> Entity
Entity EntityType
etype Int
suffix
  Attributes
defAttrs <- Getting Attributes DotGraph Attributes -> m Attributes
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting Attributes DotGraph Attributes -> m Attributes)
-> Getting Attributes DotGraph Attributes -> m Attributes
forall a b. (a -> b) -> a -> b
$ (HashMap EntityType Attributes
 -> Const Attributes (HashMap EntityType Attributes))
-> DotGraph -> Const Attributes DotGraph
Lens' DotGraph (HashMap EntityType Attributes)
defaultAttributes ((HashMap EntityType Attributes
  -> Const Attributes (HashMap EntityType Attributes))
 -> DotGraph -> Const Attributes DotGraph)
-> ((Attributes -> Const Attributes Attributes)
    -> HashMap EntityType Attributes
    -> Const Attributes (HashMap EntityType Attributes))
-> Getting Attributes DotGraph Attributes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (HashMap EntityType Attributes)
-> Lens'
     (HashMap EntityType Attributes)
     (Maybe (IxValue (HashMap EntityType Attributes)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (HashMap EntityType Attributes)
EntityType
etype ((Maybe Attributes -> Const Attributes (Maybe Attributes))
 -> HashMap EntityType Attributes
 -> Const Attributes (HashMap EntityType Attributes))
-> ((Attributes -> Const Attributes Attributes)
    -> Maybe Attributes -> Const Attributes (Maybe Attributes))
-> (Attributes -> Const Attributes Attributes)
-> HashMap EntityType Attributes
-> Const Attributes (HashMap EntityType Attributes)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Attributes -> Iso' (Maybe Attributes) Attributes
forall a. Eq a => a -> Iso' (Maybe a) a
non Attributes
forall a. Monoid a => a
mempty
  (DotContext -> Identity DotContext)
-> DotGraph -> Identity DotGraph
Lens' DotGraph DotContext
context ((DotContext -> Identity DotContext)
 -> DotGraph -> Identity DotGraph)
-> DotContext -> m ()
forall s (m :: * -> *) a.
(MonadState s m, Semigroup a) =>
ASetter' s a -> a -> m ()
<>:= [Entity
entity]
  (Int -> Identity Int) -> DotGraph -> Identity DotGraph
Lens' DotGraph Int
entityIndex ((Int -> Identity Int) -> DotGraph -> Identity DotGraph)
-> Int -> m ()
forall s (m :: * -> *) a.
(MonadState s m, Num a) =>
ASetter' s a -> a -> m ()
+= Int
1
  Entity -> Lens' DotGraph Attributes
attributes Entity
entity ((Attributes -> Identity Attributes)
 -> DotGraph -> Identity DotGraph)
-> Attributes -> m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Attributes
defAttrs
  (Entity -> Identity Entity) -> DotGraph -> Identity DotGraph
Lens' DotGraph Entity
latest ((Entity -> Identity Entity) -> DotGraph -> Identity DotGraph)
-> Entity -> m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Entity
entity
  pure Entity
entity

getTail, getHead :: MonadDot m => Entity -> m Entity
getTail :: forall (m :: * -> *). MonadDot m => Entity -> m Entity
getTail Entity
eid =
  case Entity -> EntityType
getType Entity
eid of
    EntityType
Cluster -> do
      Entity
g <- m Entity
forall (m :: * -> *). MonadDot m => m Entity
rootGraph
      Entity -> Lens' DotGraph Attributes
attributes Entity
g ((Attributes -> Identity Attributes)
 -> DotGraph -> Identity DotGraph)
-> ((Maybe Text -> Identity (Maybe Text))
    -> Attributes -> Identity Attributes)
-> (Maybe Text -> Identity (Maybe Text))
-> DotGraph
-> Identity DotGraph
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Text -> Identity (Maybe Text))
-> Attributes -> Identity Attributes
Lens' Attributes (Maybe Text)
compound ((Maybe Text -> Identity (Maybe Text))
 -> DotGraph -> Identity DotGraph)
-> Text -> m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a (Maybe b) -> b -> m ()
?= Text
"true"
      Entity -> Maybe Entity -> Entity
forall a. a -> Maybe a -> a
fromMaybe Entity
eid (Maybe Entity -> Entity) -> m (Maybe Entity) -> m Entity
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Entity -> m (Maybe Entity)
forall (m :: * -> *). MonadDot m => Entity -> m (Maybe Entity)
locateNode Entity
eid
    EntityType
_ -> Entity -> m Entity
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Entity
eid
getHead :: forall (m :: * -> *). MonadDot m => Entity -> m Entity
getHead Entity
eid =
  case Entity -> EntityType
getType Entity
eid of
    EntityType
Cluster -> do
      Entity
g <- m Entity
forall (m :: * -> *). MonadDot m => m Entity
rootGraph
      Entity -> Lens' DotGraph Attributes
attributes Entity
g ((Attributes -> Identity Attributes)
 -> DotGraph -> Identity DotGraph)
-> ((Maybe Text -> Identity (Maybe Text))
    -> Attributes -> Identity Attributes)
-> (Maybe Text -> Identity (Maybe Text))
-> DotGraph
-> Identity DotGraph
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Text -> Identity (Maybe Text))
-> Attributes -> Identity Attributes
Lens' Attributes (Maybe Text)
compound ((Maybe Text -> Identity (Maybe Text))
 -> DotGraph -> Identity DotGraph)
-> Text -> m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a (Maybe b) -> b -> m ()
?= Text
"true"
      Entity -> Maybe Entity -> Entity
forall a. a -> Maybe a -> a
fromMaybe Entity
eid (Maybe Entity -> Entity) -> m (Maybe Entity) -> m Entity
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Entity -> m (Maybe Entity)
forall (m :: * -> *). MonadDot m => Entity -> m (Maybe Entity)
locateNode Entity
eid
    EntityType
_ -> Entity -> m Entity
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Entity
eid

locateNode :: MonadDot m => Entity -> m (Maybe Entity)
locateNode :: forall (m :: * -> *). MonadDot m => Entity -> m (Maybe Entity)
locateNode Entity
e = do
  DotGraph
dg <- m DotGraph
forall s (m :: * -> *). MonadState s m => m s
get
  pure $ Entity
e Entity -> Getting (First Entity) Entity Entity -> Maybe Entity
forall s a. s -> Getting (First a) s a -> Maybe a
^? DotGraph -> Getting (First Entity) Entity Entity
forall {r}. Monoid r => DotGraph -> (Entity -> r) -> Entity -> r
go DotGraph
dg
  where
    go :: DotGraph -> (Entity -> r) -> Entity -> r
go DotGraph
dg Entity -> r
f Entity
eid =
      case Entity -> EntityType
getType Entity
eid of
        EntityType
Cluster  -> Getting r DotGraph Entity -> (Entity -> r) -> DotGraph -> r
forall r s a. Getting r s a -> (a -> r) -> s -> r
foldMapOf ((HashMap Entity DotContext -> Const r (HashMap Entity DotContext))
-> DotGraph -> Const r DotGraph
Lens' DotGraph (HashMap Entity DotContext)
subgraphInfo ((HashMap Entity DotContext -> Const r (HashMap Entity DotContext))
 -> DotGraph -> Const r DotGraph)
-> ((Entity -> Const r Entity)
    -> HashMap Entity DotContext
    -> Const r (HashMap Entity DotContext))
-> Getting r DotGraph Entity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (HashMap Entity DotContext)
-> Lens'
     (HashMap Entity DotContext)
     (Maybe (IxValue (HashMap Entity DotContext)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (HashMap Entity DotContext)
Entity
eid ((Maybe DotContext -> Const r (Maybe DotContext))
 -> HashMap Entity DotContext
 -> Const r (HashMap Entity DotContext))
-> ((Entity -> Const r Entity)
    -> Maybe DotContext -> Const r (Maybe DotContext))
-> (Entity -> Const r Entity)
-> HashMap Entity DotContext
-> Const r (HashMap Entity DotContext)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DotContext -> Const r DotContext)
-> Maybe DotContext -> Const r (Maybe DotContext)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse ((DotContext -> Const r DotContext)
 -> Maybe DotContext -> Const r (Maybe DotContext))
-> ((Entity -> Const r Entity) -> DotContext -> Const r DotContext)
-> (Entity -> Const r Entity)
-> Maybe DotContext
-> Const r (Maybe DotContext)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Entity -> Const r Entity) -> DotContext -> Const r DotContext
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse) (DotGraph -> (Entity -> r) -> Entity -> r
go DotGraph
dg Entity -> r
f) DotGraph
dg
        EntityType
Subgraph -> Getting r DotGraph Entity -> (Entity -> r) -> DotGraph -> r
forall r s a. Getting r s a -> (a -> r) -> s -> r
foldMapOf ((HashMap Entity DotContext -> Const r (HashMap Entity DotContext))
-> DotGraph -> Const r DotGraph
Lens' DotGraph (HashMap Entity DotContext)
subgraphInfo ((HashMap Entity DotContext -> Const r (HashMap Entity DotContext))
 -> DotGraph -> Const r DotGraph)
-> ((Entity -> Const r Entity)
    -> HashMap Entity DotContext
    -> Const r (HashMap Entity DotContext))
-> Getting r DotGraph Entity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (HashMap Entity DotContext)
-> Lens'
     (HashMap Entity DotContext)
     (Maybe (IxValue (HashMap Entity DotContext)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (HashMap Entity DotContext)
Entity
eid ((Maybe DotContext -> Const r (Maybe DotContext))
 -> HashMap Entity DotContext
 -> Const r (HashMap Entity DotContext))
-> ((Entity -> Const r Entity)
    -> Maybe DotContext -> Const r (Maybe DotContext))
-> (Entity -> Const r Entity)
-> HashMap Entity DotContext
-> Const r (HashMap Entity DotContext)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DotContext -> Const r DotContext)
-> Maybe DotContext -> Const r (Maybe DotContext)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse ((DotContext -> Const r DotContext)
 -> Maybe DotContext -> Const r (Maybe DotContext))
-> ((Entity -> Const r Entity) -> DotContext -> Const r DotContext)
-> (Entity -> Const r Entity)
-> Maybe DotContext
-> Const r (Maybe DotContext)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Entity -> Const r Entity) -> DotContext -> Const r DotContext
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse) (DotGraph -> (Entity -> r) -> Entity -> r
go DotGraph
dg Entity -> r
f) DotGraph
dg
        EntityType
Node     -> Entity -> r
f Entity
eid
        EntityType
Edge     -> r
forall a. Monoid a => a
mempty