{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}

{- |
   Module      : Data.GraphViz.Types.Generalised.
   Description : Alternate definition of the Graphviz types.
   Copyright   : (c) Ivan Lazar Miljenovic
   License     : 3-Clause BSD-style
   Maintainer  : Ivan.Miljenovic@gmail.com

   The generalised Dot representation most closely matches the
   implementation of actual Dot code, as it places no restrictions on
   ordering of elements, etc.  As such it should be able to parse any
   existing Dot code (taking into account the parsing
   limitations/assumptions).

   The sample graph could be implemented (this is actually a prettied
   version of parsing in the Dot code) as:

   > DotGraph { strictGraph = False
   >          , directedGraph = True
   >          , graphID = Just (Str "G")
   >          , graphStatements = Seq.fromList [ SG $ DotSG { isCluster = True
   >                                                        , subGraphID = Just (Int 0)
   >                                                        , subGraphStmts = Seq.fromList [ GA $ GraphAttrs [style filled]
   >                                                                                       , GA $ GraphAttrs [color LightGray]
   >                                                                                       , GA $ NodeAttrs [style filled, color White]
   >                                                                                       , DE $ DotEdge "a0" "a1" []
   >                                                                                       , DE $ DotEdge "a1" "a2" []
   >                                                                                       , DE $ DotEdge "a2" "a3" []
   >                                                                                       , GA $ GraphAttrs [textLabel "process #1"]]}
   >                                           , SG $ DotSG { isCluster = True
   >                                                        , subGraphID = Just (Int 1)
   >                                                        , subGraphStmts = fromList [ GA $ NodeAttrs [style filled]
   >                                                                                   , DE $ DotEdge "b0" "b1" []
   >                                                                                   , DE $ DotEdge "b1" "b2" []
   >                                                                                   , DE $ DotEdge "b2" "b3" []
   >                                                                                   , GA $ GraphAttrs [textLabel "process #2"]
   >                                                                                   , GA $ GraphAttrs [color Blue]]}
   >                                           , DE $ DotEdge "start" "a0" []
   >                                           , DE $ DotEdge "start" "b0" []
   >                                           , DE $ DotEdge "a1" "b3" []
   >                                           , DE $ DotEdge "b2" "a3" []
   >                                           , DE $ DotEdge "a3" "a0" []
   >                                           , DE $ DotEdge "a3" "end" []
   >                                           , DE $ DotEdge "b3" "end" []
   >                                           , DN $ DotNode "start" [shape MDiamond]
   >                                           , DN $ DotNode "end" [shape MSquare]]}

 -}
module Data.GraphViz.Types.Generalised
       ( DotGraph(..)
       , FromGeneralisedDot (..)
         -- * Sub-components of a @DotGraph@.
       , DotStatements
       , DotStatement(..)
       , DotSubGraph(..)
         -- * Re-exported from @Data.GraphViz.Types@.
       , GraphID(..)
       , GlobalAttributes(..)
       , DotNode(..)
       , DotEdge(..)
       ) where

import           Data.GraphViz.Algorithms            (canonicalise)
import           Data.GraphViz.Internal.State        (AttributeType(..))
import           Data.GraphViz.Internal.Util         (bool)
import           Data.GraphViz.Parsing
import           Data.GraphViz.Printing
import           Data.GraphViz.Types
import qualified Data.GraphViz.Types.Canonical       as C
import           Data.GraphViz.Types.Internal.Common
import           Data.GraphViz.Types.State

import           Control.Arrow       ((&&&))
import           Control.Monad.State (evalState, execState, get, modify, put)
import qualified Data.Foldable       as F
import           Data.Sequence       (Seq, (><))
import qualified Data.Sequence       as Seq
import qualified Data.Traversable    as T

-- -----------------------------------------------------------------------------

-- | The internal representation of a generalised graph in Dot form.
data DotGraph n = DotGraph { -- | If 'True', no multiple edges are drawn.
                             forall n. DotGraph n -> Bool
strictGraph     :: Bool
                           , forall n. DotGraph n -> Bool
directedGraph   :: Bool
                           , forall n. DotGraph n -> Maybe GraphID
graphID         :: Maybe GraphID
                           , forall n. DotGraph n -> DotStatements n
graphStatements :: DotStatements n
                           }
                deriving (DotGraph n -> DotGraph n -> Bool
(DotGraph n -> DotGraph n -> Bool)
-> (DotGraph n -> DotGraph n -> Bool) -> Eq (DotGraph n)
forall n. Eq n => DotGraph n -> DotGraph n -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall n. Eq n => DotGraph n -> DotGraph n -> Bool
== :: DotGraph n -> DotGraph n -> Bool
$c/= :: forall n. Eq n => DotGraph n -> DotGraph n -> Bool
/= :: DotGraph n -> DotGraph n -> Bool
Eq, Eq (DotGraph n)
Eq (DotGraph n) =>
(DotGraph n -> DotGraph n -> Ordering)
-> (DotGraph n -> DotGraph n -> Bool)
-> (DotGraph n -> DotGraph n -> Bool)
-> (DotGraph n -> DotGraph n -> Bool)
-> (DotGraph n -> DotGraph n -> Bool)
-> (DotGraph n -> DotGraph n -> DotGraph n)
-> (DotGraph n -> DotGraph n -> DotGraph n)
-> Ord (DotGraph n)
DotGraph n -> DotGraph n -> Bool
DotGraph n -> DotGraph n -> Ordering
DotGraph n -> DotGraph n -> DotGraph n
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 n. Ord n => Eq (DotGraph n)
forall n. Ord n => DotGraph n -> DotGraph n -> Bool
forall n. Ord n => DotGraph n -> DotGraph n -> Ordering
forall n. Ord n => DotGraph n -> DotGraph n -> DotGraph n
$ccompare :: forall n. Ord n => DotGraph n -> DotGraph n -> Ordering
compare :: DotGraph n -> DotGraph n -> Ordering
$c< :: forall n. Ord n => DotGraph n -> DotGraph n -> Bool
< :: DotGraph n -> DotGraph n -> Bool
$c<= :: forall n. Ord n => DotGraph n -> DotGraph n -> Bool
<= :: DotGraph n -> DotGraph n -> Bool
$c> :: forall n. Ord n => DotGraph n -> DotGraph n -> Bool
> :: DotGraph n -> DotGraph n -> Bool
$c>= :: forall n. Ord n => DotGraph n -> DotGraph n -> Bool
>= :: DotGraph n -> DotGraph n -> Bool
$cmax :: forall n. Ord n => DotGraph n -> DotGraph n -> DotGraph n
max :: DotGraph n -> DotGraph n -> DotGraph n
$cmin :: forall n. Ord n => DotGraph n -> DotGraph n -> DotGraph n
min :: DotGraph n -> DotGraph n -> DotGraph n
Ord, Int -> DotGraph n -> ShowS
[DotGraph n] -> ShowS
DotGraph n -> String
(Int -> DotGraph n -> ShowS)
-> (DotGraph n -> String)
-> ([DotGraph n] -> ShowS)
-> Show (DotGraph n)
forall n. Show n => Int -> DotGraph n -> ShowS
forall n. Show n => [DotGraph n] -> ShowS
forall n. Show n => DotGraph n -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall n. Show n => Int -> DotGraph n -> ShowS
showsPrec :: Int -> DotGraph n -> ShowS
$cshow :: forall n. Show n => DotGraph n -> String
show :: DotGraph n -> String
$cshowList :: forall n. Show n => [DotGraph n] -> ShowS
showList :: [DotGraph n] -> ShowS
Show, ReadPrec [DotGraph n]
ReadPrec (DotGraph n)
Int -> ReadS (DotGraph n)
ReadS [DotGraph n]
(Int -> ReadS (DotGraph n))
-> ReadS [DotGraph n]
-> ReadPrec (DotGraph n)
-> ReadPrec [DotGraph n]
-> Read (DotGraph n)
forall n. Read n => ReadPrec [DotGraph n]
forall n. Read n => ReadPrec (DotGraph n)
forall n. Read n => Int -> ReadS (DotGraph n)
forall n. Read n => ReadS [DotGraph n]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: forall n. Read n => Int -> ReadS (DotGraph n)
readsPrec :: Int -> ReadS (DotGraph n)
$creadList :: forall n. Read n => ReadS [DotGraph n]
readList :: ReadS [DotGraph n]
$creadPrec :: forall n. Read n => ReadPrec (DotGraph n)
readPrec :: ReadPrec (DotGraph n)
$creadListPrec :: forall n. Read n => ReadPrec [DotGraph n]
readListPrec :: ReadPrec [DotGraph n]
Read)

instance (Ord n) => DotRepr DotGraph n where
  fromCanonical :: DotGraph n -> DotGraph n
fromCanonical = DotGraph n -> DotGraph n
forall n. DotGraph n -> DotGraph n
generaliseDotGraph

  getID :: DotGraph n -> Maybe GraphID
getID = DotGraph n -> Maybe GraphID
forall n. DotGraph n -> Maybe GraphID
graphID

  setID :: GraphID -> DotGraph n -> DotGraph n
setID GraphID
i DotGraph n
g = DotGraph n
g { graphID = Just i }

  graphIsDirected :: DotGraph n -> Bool
graphIsDirected = DotGraph n -> Bool
forall n. DotGraph n -> Bool
directedGraph

  setIsDirected :: Bool -> DotGraph n -> DotGraph n
setIsDirected Bool
d DotGraph n
g = DotGraph n
g { directedGraph = d }

  graphIsStrict :: DotGraph n -> Bool
graphIsStrict = DotGraph n -> Bool
forall n. DotGraph n -> Bool
strictGraph

  setStrictness :: Bool -> DotGraph n -> DotGraph n
setStrictness Bool
s DotGraph n
g = DotGraph n
g { strictGraph = s }

  mapDotGraph :: forall n'.
DotRepr DotGraph n' =>
(n -> n') -> DotGraph n -> DotGraph n'
mapDotGraph = (n -> n') -> DotGraph n -> DotGraph n'
forall a b. (a -> b) -> DotGraph a -> DotGraph b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap

  graphStructureInformation :: DotGraph n -> (GlobalAttributes, ClusterLookup)
graphStructureInformation = GraphState () -> (GlobalAttributes, ClusterLookup)
forall a. GraphState a -> (GlobalAttributes, ClusterLookup)
getGraphInfo
                              (GraphState () -> (GlobalAttributes, ClusterLookup))
-> (DotGraph n -> GraphState ())
-> DotGraph n
-> (GlobalAttributes, ClusterLookup)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DotStatements n -> GraphState ()
forall n. DotStatements n -> GraphState ()
statementStructure (DotStatements n -> GraphState ())
-> (DotGraph n -> DotStatements n) -> DotGraph n -> GraphState ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DotGraph n -> DotStatements n
forall n. DotGraph n -> DotStatements n
graphStatements

  nodeInformation :: Bool -> DotGraph n -> NodeLookup n
nodeInformation Bool
wGlobal = Bool -> NodeState n () -> NodeLookup n
forall n a. Bool -> NodeState n a -> NodeLookup n
getNodeLookup Bool
wGlobal
                            (NodeState n () -> NodeLookup n)
-> (DotGraph n -> NodeState n ()) -> DotGraph n -> NodeLookup n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DotStatements n -> NodeState n ()
forall n. Ord n => DotStatements n -> NodeState n ()
statementNodes (DotStatements n -> NodeState n ())
-> (DotGraph n -> DotStatements n) -> DotGraph n -> NodeState n ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DotGraph n -> DotStatements n
forall n. DotGraph n -> DotStatements n
graphStatements

  edgeInformation :: Bool -> DotGraph n -> [DotEdge n]
edgeInformation Bool
wGlobal = Bool -> EdgeState n () -> [DotEdge n]
forall n a. Bool -> EdgeState n a -> [DotEdge n]
getDotEdges Bool
wGlobal
                            (EdgeState n () -> [DotEdge n])
-> (DotGraph n -> EdgeState n ()) -> DotGraph n -> [DotEdge n]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DotStatements n -> EdgeState n ()
forall n. DotStatements n -> EdgeState n ()
statementEdges (DotStatements n -> EdgeState n ())
-> (DotGraph n -> DotStatements n) -> DotGraph n -> EdgeState n ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DotGraph n -> DotStatements n
forall n. DotGraph n -> DotStatements n
graphStatements

  unAnonymise :: DotGraph n -> DotGraph n
unAnonymise = DotGraph n -> DotGraph n
forall n. DotGraph n -> DotGraph n
renumber

instance (Ord n, PrintDot n) => PrintDotRepr DotGraph n
instance (Ord n, ParseDot n) => ParseDotRepr DotGraph n
instance (Ord n, PrintDot n, ParseDot n) => PPDotRepr DotGraph n

instance (PrintDot n) => PrintDot (DotGraph n) where
  unqtDot :: DotGraph n -> DotCode
unqtDot = (DotGraph n -> DotCode)
-> (DotGraph n -> AttributeType)
-> (DotGraph n -> DotStatements n)
-> (DotStatements n -> DotCode)
-> DotGraph n
-> DotCode
forall a stmts.
(a -> DotCode)
-> (a -> AttributeType)
-> (a -> stmts)
-> (stmts -> DotCode)
-> a
-> DotCode
printStmtBased DotGraph n -> DotCode
forall {n}. DotGraph n -> DotCode
printGraphID' (AttributeType -> DotGraph n -> AttributeType
forall a b. a -> b -> a
const AttributeType
GraphAttribute)
                           DotGraph n -> DotStatements n
forall n. DotGraph n -> DotStatements n
graphStatements DotStatements n -> DotCode
forall n. PrintDot n => DotStatements n -> DotCode
printGStmts
    where
      printGraphID' :: DotGraph n -> DotCode
printGraphID' = (DotGraph n -> Bool)
-> (DotGraph n -> Bool)
-> (DotGraph n -> Maybe GraphID)
-> DotGraph n
-> DotCode
forall a.
(a -> Bool) -> (a -> Bool) -> (a -> Maybe GraphID) -> a -> DotCode
printGraphID DotGraph n -> Bool
forall n. DotGraph n -> Bool
strictGraph DotGraph n -> Bool
forall n. DotGraph n -> Bool
directedGraph DotGraph n -> Maybe GraphID
forall n. DotGraph n -> Maybe GraphID
graphID

instance (ParseDot n) => ParseDot (DotGraph n) where
  parseUnqt :: Parse (DotGraph n)
parseUnqt = (Bool -> Bool -> Maybe GraphID -> DotStatements n -> DotGraph n)
-> Parse (DotStatements n -> DotGraph n)
forall a. (Bool -> Bool -> Maybe GraphID -> a) -> Parse a
parseGraphID Bool -> Bool -> Maybe GraphID -> DotStatements n -> DotGraph n
forall n.
Bool -> Bool -> Maybe GraphID -> DotStatements n -> DotGraph n
DotGraph
              Parse (DotStatements n -> DotGraph n)
-> Parser GraphvizState (DotStatements n) -> Parse (DotGraph n)
forall a b.
Parser GraphvizState (a -> b)
-> Parser GraphvizState a -> Parser GraphvizState b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AttributeType
-> Parser GraphvizState (DotStatements n)
-> Parser GraphvizState (DotStatements n)
forall a. AttributeType -> Parse a -> Parse a
parseBracesBased AttributeType
GraphAttribute Parser GraphvizState (DotStatements n)
forall n. ParseDot n => Parse (DotStatements n)
parseGStmts

  parse :: Parse (DotGraph n)
parse = Parse (DotGraph n)
forall a. ParseDot a => Parse a
parseUnqt -- Don't want the option of quoting
          Parse (DotGraph n) -> ShowS -> Parse (DotGraph n)
forall a. Parser GraphvizState a -> ShowS -> Parser GraphvizState a
forall (p :: * -> *) a. Commitment p => p a -> ShowS -> p a
`adjustErr`
          (String
"Not a valid generalised DotGraph\n\t"String -> ShowS
forall a. [a] -> [a] -> [a]
++)

-- | Assumed to be an injective mapping function.
instance Functor DotGraph where
  fmap :: forall a b. (a -> b) -> DotGraph a -> DotGraph b
fmap a -> b
f DotGraph a
g = DotGraph a
g { graphStatements = (fmap . fmap) f $ graphStatements g }

-- | Convert a 'DotGraph' to a 'DotGraph', keeping the same order of
--   statements.
generaliseDotGraph    :: C.DotGraph n -> DotGraph n
generaliseDotGraph :: forall n. DotGraph n -> DotGraph n
generaliseDotGraph DotGraph n
dg = DotGraph { strictGraph :: Bool
strictGraph     = DotGraph n -> Bool
forall n. DotGraph n -> Bool
C.strictGraph DotGraph n
dg
                                 , directedGraph :: Bool
directedGraph   = DotGraph n -> Bool
forall n. DotGraph n -> Bool
C.directedGraph DotGraph n
dg
                                 , graphID :: Maybe GraphID
graphID         = DotGraph n -> Maybe GraphID
forall n. DotGraph n -> Maybe GraphID
C.graphID DotGraph n
dg
                                 , graphStatements :: DotStatements n
graphStatements = DotStatements n -> DotStatements n
forall n. DotStatements n -> DotStatements n
generaliseStatements
                                                     (DotStatements n -> DotStatements n)
-> DotStatements n -> DotStatements n
forall a b. (a -> b) -> a -> b
$ DotGraph n -> DotStatements n
forall n. DotGraph n -> DotStatements n
C.graphStatements DotGraph n
dg
                                 }

-- -----------------------------------------------------------------------------

-- | This class is useful for being able to parse in a dot graph as a
--   generalised one, and then convert it to your preferred
--   representation.
--
--   This can be seen as a semi-inverse of 'fromCanonical'.
class (DotRepr dg n) => FromGeneralisedDot dg n where
  fromGeneralised :: DotGraph n -> dg n

instance (Ord n) => FromGeneralisedDot C.DotGraph n where
  fromGeneralised :: DotGraph n -> DotGraph n
fromGeneralised = DotGraph n -> DotGraph n
forall (dg :: * -> *) n. DotRepr dg n => dg n -> DotGraph n
canonicalise

instance (Ord n) => FromGeneralisedDot DotGraph n where
  fromGeneralised :: DotGraph n -> DotGraph n
fromGeneralised = DotGraph n -> DotGraph n
forall a. a -> a
id

-- -----------------------------------------------------------------------------

type DotStatements n = Seq (DotStatement n)

printGStmts :: (PrintDot n) => DotStatements n -> DotCode
printGStmts :: forall n. PrintDot n => DotStatements n -> DotCode
printGStmts = [DotStatement n] -> DotCode
forall a. PrintDot a => a -> DotCode
toDot ([DotStatement n] -> DotCode)
-> (DotStatements n -> [DotStatement n])
-> DotStatements n
-> DotCode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DotStatements n -> [DotStatement n]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList

parseGStmts :: (ParseDot n) => Parse (DotStatements n)
parseGStmts :: forall n. ParseDot n => Parse (DotStatements n)
parseGStmts = ([DotStatement n] -> Seq (DotStatement n)
forall a. [a] -> Seq a
Seq.fromList ([DotStatement n] -> Seq (DotStatement n))
-> Parser GraphvizState [DotStatement n]
-> Parser GraphvizState (Seq (DotStatement n))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser GraphvizState [DotStatement n]
forall a. ParseDot a => Parse a
parse)
              Parser GraphvizState (Seq (DotStatement n))
-> ShowS -> Parser GraphvizState (Seq (DotStatement n))
forall a. Parser GraphvizState a -> ShowS -> Parser GraphvizState a
forall (p :: * -> *) a. Commitment p => p a -> ShowS -> p a
`adjustErr`
              (String
"Not a valid generalised DotStatements\n\t"String -> ShowS
forall a. [a] -> [a] -> [a]
++)

statementStructure :: DotStatements n -> GraphState ()
statementStructure :: forall n. DotStatements n -> GraphState ()
statementStructure = (DotStatement n -> GraphState ())
-> Seq (DotStatement n) -> GraphState ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
F.mapM_ DotStatement n -> GraphState ()
forall n. DotStatement n -> GraphState ()
stmtStructure

statementNodes :: (Ord n) => DotStatements n -> NodeState n ()
statementNodes :: forall n. Ord n => DotStatements n -> NodeState n ()
statementNodes = (DotStatement n -> StateT (StateValue (NodeLookup' n)) Identity ())
-> Seq (DotStatement n)
-> StateT (StateValue (NodeLookup' n)) Identity ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
F.mapM_ DotStatement n -> StateT (StateValue (NodeLookup' n)) Identity ()
forall n. Ord n => DotStatement n -> NodeState n ()
stmtNodes

statementEdges :: DotStatements n -> EdgeState n ()
statementEdges :: forall n. DotStatements n -> EdgeState n ()
statementEdges = (DotStatement n
 -> StateT (StateValue (DList (DotEdge n))) Identity ())
-> Seq (DotStatement n)
-> StateT (StateValue (DList (DotEdge n))) Identity ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
F.mapM_ DotStatement n
-> StateT (StateValue (DList (DotEdge n))) Identity ()
forall n. DotStatement n -> EdgeState n ()
stmtEdges

generaliseStatements       :: C.DotStatements n -> DotStatements n
generaliseStatements :: forall n. DotStatements n -> DotStatements n
generaliseStatements DotStatements n
stmts = Seq (DotStatement n)
forall {n}. Seq (DotStatement n)
atts Seq (DotStatement n)
-> Seq (DotStatement n) -> Seq (DotStatement n)
forall a. Seq a -> Seq a -> Seq a
>< Seq (DotStatement n)
sgs Seq (DotStatement n)
-> Seq (DotStatement n) -> Seq (DotStatement n)
forall a. Seq a -> Seq a -> Seq a
>< Seq (DotStatement n)
ns Seq (DotStatement n)
-> Seq (DotStatement n) -> Seq (DotStatement n)
forall a. Seq a -> Seq a -> Seq a
>< Seq (DotStatement n)
es
  where
    atts :: Seq (DotStatement n)
atts = [DotStatement n] -> Seq (DotStatement n)
forall a. [a] -> Seq a
Seq.fromList ([DotStatement n] -> Seq (DotStatement n))
-> ([GlobalAttributes] -> [DotStatement n])
-> [GlobalAttributes]
-> Seq (DotStatement n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GlobalAttributes -> DotStatement n)
-> [GlobalAttributes] -> [DotStatement n]
forall a b. (a -> b) -> [a] -> [b]
map GlobalAttributes -> DotStatement n
forall n. GlobalAttributes -> DotStatement n
GA ([GlobalAttributes] -> Seq (DotStatement n))
-> [GlobalAttributes] -> Seq (DotStatement n)
forall a b. (a -> b) -> a -> b
$ DotStatements n -> [GlobalAttributes]
forall n. DotStatements n -> [GlobalAttributes]
C.attrStmts DotStatements n
stmts
    sgs :: Seq (DotStatement n)
sgs  = [DotStatement n] -> Seq (DotStatement n)
forall a. [a] -> Seq a
Seq.fromList ([DotStatement n] -> Seq (DotStatement n))
-> ([DotSubGraph n] -> [DotStatement n])
-> [DotSubGraph n]
-> Seq (DotStatement n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DotSubGraph n -> DotStatement n)
-> [DotSubGraph n] -> [DotStatement n]
forall a b. (a -> b) -> [a] -> [b]
map (DotSubGraph n -> DotStatement n
forall n. DotSubGraph n -> DotStatement n
SG (DotSubGraph n -> DotStatement n)
-> (DotSubGraph n -> DotSubGraph n)
-> DotSubGraph n
-> DotStatement n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DotSubGraph n -> DotSubGraph n
forall n. DotSubGraph n -> DotSubGraph n
generaliseSubGraph) ([DotSubGraph n] -> Seq (DotStatement n))
-> [DotSubGraph n] -> Seq (DotStatement n)
forall a b. (a -> b) -> a -> b
$ DotStatements n -> [DotSubGraph n]
forall n. DotStatements n -> [DotSubGraph n]
C.subGraphs DotStatements n
stmts
    ns :: Seq (DotStatement n)
ns   = [DotStatement n] -> Seq (DotStatement n)
forall a. [a] -> Seq a
Seq.fromList ([DotStatement n] -> Seq (DotStatement n))
-> ([DotNode n] -> [DotStatement n])
-> [DotNode n]
-> Seq (DotStatement n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DotNode n -> DotStatement n) -> [DotNode n] -> [DotStatement n]
forall a b. (a -> b) -> [a] -> [b]
map DotNode n -> DotStatement n
forall n. DotNode n -> DotStatement n
DN ([DotNode n] -> Seq (DotStatement n))
-> [DotNode n] -> Seq (DotStatement n)
forall a b. (a -> b) -> a -> b
$ DotStatements n -> [DotNode n]
forall n. DotStatements n -> [DotNode n]
C.nodeStmts DotStatements n
stmts
    es :: Seq (DotStatement n)
es   = [DotStatement n] -> Seq (DotStatement n)
forall a. [a] -> Seq a
Seq.fromList ([DotStatement n] -> Seq (DotStatement n))
-> ([DotEdge n] -> [DotStatement n])
-> [DotEdge n]
-> Seq (DotStatement n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DotEdge n -> DotStatement n) -> [DotEdge n] -> [DotStatement n]
forall a b. (a -> b) -> [a] -> [b]
map DotEdge n -> DotStatement n
forall n. DotEdge n -> DotStatement n
DE ([DotEdge n] -> Seq (DotStatement n))
-> [DotEdge n] -> Seq (DotStatement n)
forall a b. (a -> b) -> a -> b
$ DotStatements n -> [DotEdge n]
forall n. DotStatements n -> [DotEdge n]
C.edgeStmts DotStatements n
stmts


data DotStatement n = GA GlobalAttributes
                    | SG (DotSubGraph n)
                    | DN (DotNode n)
                    | DE (DotEdge n)
                    deriving (DotStatement n -> DotStatement n -> Bool
(DotStatement n -> DotStatement n -> Bool)
-> (DotStatement n -> DotStatement n -> Bool)
-> Eq (DotStatement n)
forall n. Eq n => DotStatement n -> DotStatement n -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall n. Eq n => DotStatement n -> DotStatement n -> Bool
== :: DotStatement n -> DotStatement n -> Bool
$c/= :: forall n. Eq n => DotStatement n -> DotStatement n -> Bool
/= :: DotStatement n -> DotStatement n -> Bool
Eq, Eq (DotStatement n)
Eq (DotStatement n) =>
(DotStatement n -> DotStatement n -> Ordering)
-> (DotStatement n -> DotStatement n -> Bool)
-> (DotStatement n -> DotStatement n -> Bool)
-> (DotStatement n -> DotStatement n -> Bool)
-> (DotStatement n -> DotStatement n -> Bool)
-> (DotStatement n -> DotStatement n -> DotStatement n)
-> (DotStatement n -> DotStatement n -> DotStatement n)
-> Ord (DotStatement n)
DotStatement n -> DotStatement n -> Bool
DotStatement n -> DotStatement n -> Ordering
DotStatement n -> DotStatement n -> DotStatement n
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 n. Ord n => Eq (DotStatement n)
forall n. Ord n => DotStatement n -> DotStatement n -> Bool
forall n. Ord n => DotStatement n -> DotStatement n -> Ordering
forall n.
Ord n =>
DotStatement n -> DotStatement n -> DotStatement n
$ccompare :: forall n. Ord n => DotStatement n -> DotStatement n -> Ordering
compare :: DotStatement n -> DotStatement n -> Ordering
$c< :: forall n. Ord n => DotStatement n -> DotStatement n -> Bool
< :: DotStatement n -> DotStatement n -> Bool
$c<= :: forall n. Ord n => DotStatement n -> DotStatement n -> Bool
<= :: DotStatement n -> DotStatement n -> Bool
$c> :: forall n. Ord n => DotStatement n -> DotStatement n -> Bool
> :: DotStatement n -> DotStatement n -> Bool
$c>= :: forall n. Ord n => DotStatement n -> DotStatement n -> Bool
>= :: DotStatement n -> DotStatement n -> Bool
$cmax :: forall n.
Ord n =>
DotStatement n -> DotStatement n -> DotStatement n
max :: DotStatement n -> DotStatement n -> DotStatement n
$cmin :: forall n.
Ord n =>
DotStatement n -> DotStatement n -> DotStatement n
min :: DotStatement n -> DotStatement n -> DotStatement n
Ord, Int -> DotStatement n -> ShowS
[DotStatement n] -> ShowS
DotStatement n -> String
(Int -> DotStatement n -> ShowS)
-> (DotStatement n -> String)
-> ([DotStatement n] -> ShowS)
-> Show (DotStatement n)
forall n. Show n => Int -> DotStatement n -> ShowS
forall n. Show n => [DotStatement n] -> ShowS
forall n. Show n => DotStatement n -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall n. Show n => Int -> DotStatement n -> ShowS
showsPrec :: Int -> DotStatement n -> ShowS
$cshow :: forall n. Show n => DotStatement n -> String
show :: DotStatement n -> String
$cshowList :: forall n. Show n => [DotStatement n] -> ShowS
showList :: [DotStatement n] -> ShowS
Show, ReadPrec [DotStatement n]
ReadPrec (DotStatement n)
Int -> ReadS (DotStatement n)
ReadS [DotStatement n]
(Int -> ReadS (DotStatement n))
-> ReadS [DotStatement n]
-> ReadPrec (DotStatement n)
-> ReadPrec [DotStatement n]
-> Read (DotStatement n)
forall n. Read n => ReadPrec [DotStatement n]
forall n. Read n => ReadPrec (DotStatement n)
forall n. Read n => Int -> ReadS (DotStatement n)
forall n. Read n => ReadS [DotStatement n]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: forall n. Read n => Int -> ReadS (DotStatement n)
readsPrec :: Int -> ReadS (DotStatement n)
$creadList :: forall n. Read n => ReadS [DotStatement n]
readList :: ReadS [DotStatement n]
$creadPrec :: forall n. Read n => ReadPrec (DotStatement n)
readPrec :: ReadPrec (DotStatement n)
$creadListPrec :: forall n. Read n => ReadPrec [DotStatement n]
readListPrec :: ReadPrec [DotStatement n]
Read)

instance (PrintDot n) => PrintDot (DotStatement n) where
  unqtDot :: DotStatement n -> DotCode
unqtDot (GA GlobalAttributes
ga) = GlobalAttributes -> DotCode
forall a. PrintDot a => a -> DotCode
unqtDot GlobalAttributes
ga
  unqtDot (SG DotSubGraph n
sg) = DotSubGraph n -> DotCode
forall a. PrintDot a => a -> DotCode
unqtDot DotSubGraph n
sg
  unqtDot (DN DotNode n
dn) = DotNode n -> DotCode
forall a. PrintDot a => a -> DotCode
unqtDot DotNode n
dn
  unqtDot (DE DotEdge n
de) = DotEdge n -> DotCode
forall a. PrintDot a => a -> DotCode
unqtDot DotEdge n
de

  unqtListToDot :: [DotStatement n] -> DotCode
unqtListToDot = DotCodeM [Doc] -> DotCode
forall (m :: * -> *). Functor m => m [Doc] -> m Doc
vcat (DotCodeM [Doc] -> DotCode)
-> ([DotStatement n] -> DotCodeM [Doc])
-> [DotStatement n]
-> DotCode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DotStatement n -> DotCode) -> [DotStatement n] -> DotCodeM [Doc]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM DotStatement n -> DotCode
forall a. PrintDot a => a -> DotCode
unqtDot

  listToDot :: [DotStatement n] -> DotCode
listToDot = [DotStatement n] -> DotCode
forall a. PrintDot a => [a] -> DotCode
unqtListToDot

instance (ParseDot n) => ParseDot (DotStatement n) where
  parseUnqt :: Parse (DotStatement n)
parseUnqt = [Parse (DotStatement n)] -> Parse (DotStatement n)
forall (p :: * -> *) a. PolyParse p => [p a] -> p a
oneOf [ GlobalAttributes -> DotStatement n
forall n. GlobalAttributes -> DotStatement n
GA (GlobalAttributes -> DotStatement n)
-> Parser GraphvizState GlobalAttributes -> Parse (DotStatement n)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser GraphvizState GlobalAttributes
forall a. ParseDot a => Parse a
parseUnqt
                    , DotSubGraph n -> DotStatement n
forall n. DotSubGraph n -> DotStatement n
SG (DotSubGraph n -> DotStatement n)
-> Parser GraphvizState (DotSubGraph n) -> Parse (DotStatement n)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser GraphvizState (DotSubGraph n)
forall a. ParseDot a => Parse a
parseUnqt
                    , DotNode n -> DotStatement n
forall n. DotNode n -> DotStatement n
DN (DotNode n -> DotStatement n)
-> Parser GraphvizState (DotNode n) -> Parse (DotStatement n)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser GraphvizState (DotNode n)
forall a. ParseDot a => Parse a
parseUnqt
                    , DotEdge n -> DotStatement n
forall n. DotEdge n -> DotStatement n
DE (DotEdge n -> DotStatement n)
-> Parser GraphvizState (DotEdge n) -> Parse (DotStatement n)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser GraphvizState (DotEdge n)
forall a. ParseDot a => Parse a
parseUnqt
                    ]

  parse :: Parse (DotStatement n)
parse = Parse (DotStatement n)
forall a. ParseDot a => Parse a
parseUnqt -- Don't want the option of quoting
          Parse (DotStatement n) -> ShowS -> Parse (DotStatement n)
forall a. Parser GraphvizState a -> ShowS -> Parser GraphvizState a
forall (p :: * -> *) a. Commitment p => p a -> ShowS -> p a
`adjustErr`
          (String
"Not a valid statement\n\t"String -> ShowS
forall a. [a] -> [a] -> [a]
++)

  parseUnqtList :: Parse [DotStatement n]
parseUnqtList = ([[DotStatement n]] -> [DotStatement n])
-> Parser GraphvizState [[DotStatement n]]
-> Parse [DotStatement n]
forall a b.
(a -> b) -> Parser GraphvizState a -> Parser GraphvizState b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[DotStatement n]] -> [DotStatement n]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (Parser GraphvizState [[DotStatement n]] -> Parse [DotStatement n])
-> (Parser GraphvizState [[DotStatement n]]
    -> Parser GraphvizState [[DotStatement n]])
-> Parser GraphvizState [[DotStatement n]]
-> Parse [DotStatement n]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser GraphvizState [[DotStatement n]]
-> Parser GraphvizState [[DotStatement n]]
forall a. Parse a -> Parse a
wrapWhitespace
                  (Parser GraphvizState [[DotStatement n]] -> Parse [DotStatement n])
-> Parser GraphvizState [[DotStatement n]]
-> Parse [DotStatement n]
forall a b. (a -> b) -> a -> b
$ Parse [DotStatement n] -> Parser GraphvizState [[DotStatement n]]
forall a. Parse a -> Parse [a]
parseStatements Parse [DotStatement n]
p
    where
      -- Have to do something special here because of "a -> b -> c"
      -- syntax for edges.
      p :: Parse [DotStatement n]
p = ([DotEdge n] -> [DotStatement n])
-> Parser GraphvizState [DotEdge n] -> Parse [DotStatement n]
forall a b.
(a -> b) -> Parser GraphvizState a -> Parser GraphvizState b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((DotEdge n -> DotStatement n) -> [DotEdge n] -> [DotStatement n]
forall a b. (a -> b) -> [a] -> [b]
map DotEdge n -> DotStatement n
forall n. DotEdge n -> DotStatement n
DE) Parser GraphvizState [DotEdge n]
forall n. ParseDot n => Parse [DotEdge n]
parseEdgeLine
          Parse [DotStatement n]
-> Parse [DotStatement n] -> Parse [DotStatement n]
forall s a. Parser s a -> Parser s a -> Parser s a
`onFail`
          (DotStatement n -> [DotStatement n])
-> Parse (DotStatement n) -> Parse [DotStatement n]
forall a b.
(a -> b) -> Parser GraphvizState a -> Parser GraphvizState b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (DotStatement n -> [DotStatement n] -> [DotStatement n]
forall a. a -> [a] -> [a]
:[]) Parse (DotStatement n)
forall a. ParseDot a => Parse a
parse

  parseList :: Parse [DotStatement n]
parseList = Parse [DotStatement n]
forall a. ParseDot a => Parse [a]
parseUnqtList

instance Functor DotStatement where
  fmap :: forall a b. (a -> b) -> DotStatement a -> DotStatement b
fmap a -> b
_ (GA GlobalAttributes
ga) = GlobalAttributes -> DotStatement b
forall n. GlobalAttributes -> DotStatement n
GA GlobalAttributes
ga -- Have to re-make this to make the type checker happy.
  fmap a -> b
f (SG DotSubGraph a
sg) = DotSubGraph b -> DotStatement b
forall n. DotSubGraph n -> DotStatement n
SG (DotSubGraph b -> DotStatement b)
-> DotSubGraph b -> DotStatement b
forall a b. (a -> b) -> a -> b
$ (a -> b) -> DotSubGraph a -> DotSubGraph b
forall a b. (a -> b) -> DotSubGraph a -> DotSubGraph b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f DotSubGraph a
sg
  fmap a -> b
f (DN DotNode a
dn) = DotNode b -> DotStatement b
forall n. DotNode n -> DotStatement n
DN (DotNode b -> DotStatement b) -> DotNode b -> DotStatement b
forall a b. (a -> b) -> a -> b
$ (a -> b) -> DotNode a -> DotNode b
forall a b. (a -> b) -> DotNode a -> DotNode b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f DotNode a
dn
  fmap a -> b
f (DE DotEdge a
de) = DotEdge b -> DotStatement b
forall n. DotEdge n -> DotStatement n
DE (DotEdge b -> DotStatement b) -> DotEdge b -> DotStatement b
forall a b. (a -> b) -> a -> b
$ (a -> b) -> DotEdge a -> DotEdge b
forall a b. (a -> b) -> DotEdge a -> DotEdge b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f DotEdge a
de

stmtStructure         :: DotStatement n -> GraphState ()
stmtStructure :: forall n. DotStatement n -> GraphState ()
stmtStructure (GA GlobalAttributes
ga) = GlobalAttributes -> GraphState ()
addGraphGlobals GlobalAttributes
ga
stmtStructure (SG DotSubGraph n
sg) = (Maybe (Maybe GraphID) -> GraphState () -> GraphState ())
-> (DotStatements n -> GraphState ())
-> DotSubGraph n
-> GraphState ()
forall b a n.
(Maybe (Maybe GraphID) -> b -> a)
-> (DotStatements n -> b) -> DotSubGraph n -> a
withSubGraphID Maybe (Maybe GraphID) -> GraphState () -> GraphState ()
forall a. Maybe (Maybe GraphID) -> GraphState a -> GraphState ()
addSubGraph DotStatements n -> GraphState ()
forall n. DotStatements n -> GraphState ()
statementStructure DotSubGraph n
sg
stmtStructure DotStatement n
_       = () -> GraphState ()
forall a. a -> StateT (StateValue ClusterLookup') Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

stmtNodes         :: (Ord n) => DotStatement n -> NodeState n ()
stmtNodes :: forall n. Ord n => DotStatement n -> NodeState n ()
stmtNodes (GA GlobalAttributes
ga) = GlobalAttributes -> NodeState n ()
forall n. GlobalAttributes -> NodeState n ()
addNodeGlobals GlobalAttributes
ga
stmtNodes (SG DotSubGraph n
sg) = (Maybe (Maybe GraphID) -> NodeState n () -> NodeState n ())
-> (DotStatements n -> NodeState n ())
-> DotSubGraph n
-> NodeState n ()
forall b a n.
(Maybe (Maybe GraphID) -> b -> a)
-> (DotStatements n -> b) -> DotSubGraph n -> a
withSubGraphID Maybe (Maybe GraphID) -> NodeState n () -> NodeState n ()
forall s. Maybe (Maybe GraphID) -> GVState s () -> GVState s ()
recursiveCall DotStatements n -> NodeState n ()
forall n. Ord n => DotStatements n -> NodeState n ()
statementNodes DotSubGraph n
sg
stmtNodes (DN DotNode n
dn) = DotNode n -> NodeState n ()
forall n. Ord n => DotNode n -> NodeState n ()
addNode DotNode n
dn
stmtNodes (DE DotEdge n
de) = DotEdge n -> NodeState n ()
forall n. Ord n => DotEdge n -> NodeState n ()
addEdgeNodes DotEdge n
de

stmtEdges         :: DotStatement n -> EdgeState n ()
stmtEdges :: forall n. DotStatement n -> EdgeState n ()
stmtEdges (GA GlobalAttributes
ga) = GlobalAttributes -> EdgeState n ()
forall n. GlobalAttributes -> EdgeState n ()
addEdgeGlobals GlobalAttributes
ga
stmtEdges (SG DotSubGraph n
sg) = (Maybe (Maybe GraphID) -> EdgeState n () -> EdgeState n ())
-> (DotStatements n -> EdgeState n ())
-> DotSubGraph n
-> EdgeState n ()
forall b a n.
(Maybe (Maybe GraphID) -> b -> a)
-> (DotStatements n -> b) -> DotSubGraph n -> a
withSubGraphID Maybe (Maybe GraphID) -> EdgeState n () -> EdgeState n ()
forall s. Maybe (Maybe GraphID) -> GVState s () -> GVState s ()
recursiveCall DotStatements n -> EdgeState n ()
forall n. DotStatements n -> EdgeState n ()
statementEdges DotSubGraph n
sg
stmtEdges (DE DotEdge n
de) = DotEdge n -> EdgeState n ()
forall n. DotEdge n -> EdgeState n ()
addEdge DotEdge n
de
stmtEdges DotStatement n
_       = () -> EdgeState n ()
forall a. a -> StateT (StateValue (DList (DotEdge n))) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- -----------------------------------------------------------------------------

data DotSubGraph n = DotSG { forall n. DotSubGraph n -> Bool
isCluster     :: Bool
                           , forall n. DotSubGraph n -> Maybe GraphID
subGraphID    :: Maybe GraphID
                           , forall n. DotSubGraph n -> DotStatements n
subGraphStmts :: DotStatements n
                           }
                   deriving (DotSubGraph n -> DotSubGraph n -> Bool
(DotSubGraph n -> DotSubGraph n -> Bool)
-> (DotSubGraph n -> DotSubGraph n -> Bool) -> Eq (DotSubGraph n)
forall n. Eq n => DotSubGraph n -> DotSubGraph n -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall n. Eq n => DotSubGraph n -> DotSubGraph n -> Bool
== :: DotSubGraph n -> DotSubGraph n -> Bool
$c/= :: forall n. Eq n => DotSubGraph n -> DotSubGraph n -> Bool
/= :: DotSubGraph n -> DotSubGraph n -> Bool
Eq, Eq (DotSubGraph n)
Eq (DotSubGraph n) =>
(DotSubGraph n -> DotSubGraph n -> Ordering)
-> (DotSubGraph n -> DotSubGraph n -> Bool)
-> (DotSubGraph n -> DotSubGraph n -> Bool)
-> (DotSubGraph n -> DotSubGraph n -> Bool)
-> (DotSubGraph n -> DotSubGraph n -> Bool)
-> (DotSubGraph n -> DotSubGraph n -> DotSubGraph n)
-> (DotSubGraph n -> DotSubGraph n -> DotSubGraph n)
-> Ord (DotSubGraph n)
DotSubGraph n -> DotSubGraph n -> Bool
DotSubGraph n -> DotSubGraph n -> Ordering
DotSubGraph n -> DotSubGraph n -> DotSubGraph n
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 n. Ord n => Eq (DotSubGraph n)
forall n. Ord n => DotSubGraph n -> DotSubGraph n -> Bool
forall n. Ord n => DotSubGraph n -> DotSubGraph n -> Ordering
forall n. Ord n => DotSubGraph n -> DotSubGraph n -> DotSubGraph n
$ccompare :: forall n. Ord n => DotSubGraph n -> DotSubGraph n -> Ordering
compare :: DotSubGraph n -> DotSubGraph n -> Ordering
$c< :: forall n. Ord n => DotSubGraph n -> DotSubGraph n -> Bool
< :: DotSubGraph n -> DotSubGraph n -> Bool
$c<= :: forall n. Ord n => DotSubGraph n -> DotSubGraph n -> Bool
<= :: DotSubGraph n -> DotSubGraph n -> Bool
$c> :: forall n. Ord n => DotSubGraph n -> DotSubGraph n -> Bool
> :: DotSubGraph n -> DotSubGraph n -> Bool
$c>= :: forall n. Ord n => DotSubGraph n -> DotSubGraph n -> Bool
>= :: DotSubGraph n -> DotSubGraph n -> Bool
$cmax :: forall n. Ord n => DotSubGraph n -> DotSubGraph n -> DotSubGraph n
max :: DotSubGraph n -> DotSubGraph n -> DotSubGraph n
$cmin :: forall n. Ord n => DotSubGraph n -> DotSubGraph n -> DotSubGraph n
min :: DotSubGraph n -> DotSubGraph n -> DotSubGraph n
Ord, Int -> DotSubGraph n -> ShowS
[DotSubGraph n] -> ShowS
DotSubGraph n -> String
(Int -> DotSubGraph n -> ShowS)
-> (DotSubGraph n -> String)
-> ([DotSubGraph n] -> ShowS)
-> Show (DotSubGraph n)
forall n. Show n => Int -> DotSubGraph n -> ShowS
forall n. Show n => [DotSubGraph n] -> ShowS
forall n. Show n => DotSubGraph n -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall n. Show n => Int -> DotSubGraph n -> ShowS
showsPrec :: Int -> DotSubGraph n -> ShowS
$cshow :: forall n. Show n => DotSubGraph n -> String
show :: DotSubGraph n -> String
$cshowList :: forall n. Show n => [DotSubGraph n] -> ShowS
showList :: [DotSubGraph n] -> ShowS
Show, ReadPrec [DotSubGraph n]
ReadPrec (DotSubGraph n)
Int -> ReadS (DotSubGraph n)
ReadS [DotSubGraph n]
(Int -> ReadS (DotSubGraph n))
-> ReadS [DotSubGraph n]
-> ReadPrec (DotSubGraph n)
-> ReadPrec [DotSubGraph n]
-> Read (DotSubGraph n)
forall n. Read n => ReadPrec [DotSubGraph n]
forall n. Read n => ReadPrec (DotSubGraph n)
forall n. Read n => Int -> ReadS (DotSubGraph n)
forall n. Read n => ReadS [DotSubGraph n]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: forall n. Read n => Int -> ReadS (DotSubGraph n)
readsPrec :: Int -> ReadS (DotSubGraph n)
$creadList :: forall n. Read n => ReadS [DotSubGraph n]
readList :: ReadS [DotSubGraph n]
$creadPrec :: forall n. Read n => ReadPrec (DotSubGraph n)
readPrec :: ReadPrec (DotSubGraph n)
$creadListPrec :: forall n. Read n => ReadPrec [DotSubGraph n]
readListPrec :: ReadPrec [DotSubGraph n]
Read)

instance (PrintDot n) => PrintDot (DotSubGraph n) where
  unqtDot :: DotSubGraph n -> DotCode
unqtDot = (DotSubGraph n -> DotCode)
-> (DotSubGraph n -> AttributeType)
-> (DotSubGraph n -> DotStatements n)
-> (DotStatements n -> DotCode)
-> DotSubGraph n
-> DotCode
forall a stmts.
(a -> DotCode)
-> (a -> AttributeType)
-> (a -> stmts)
-> (stmts -> DotCode)
-> a
-> DotCode
printStmtBased DotSubGraph n -> DotCode
forall n. DotSubGraph n -> DotCode
printSubGraphID' DotSubGraph n -> AttributeType
forall n. DotSubGraph n -> AttributeType
subGraphAttrType
                           DotSubGraph n -> DotStatements n
forall n. DotSubGraph n -> DotStatements n
subGraphStmts DotStatements n -> DotCode
forall n. PrintDot n => DotStatements n -> DotCode
printGStmts

  unqtListToDot :: [DotSubGraph n] -> DotCode
unqtListToDot = (DotSubGraph n -> DotCode)
-> (DotSubGraph n -> AttributeType)
-> (DotSubGraph n -> DotStatements n)
-> (DotStatements n -> DotCode)
-> [DotSubGraph n]
-> DotCode
forall a stmts.
(a -> DotCode)
-> (a -> AttributeType)
-> (a -> stmts)
-> (stmts -> DotCode)
-> [a]
-> DotCode
printStmtBasedList DotSubGraph n -> DotCode
forall n. DotSubGraph n -> DotCode
printSubGraphID' DotSubGraph n -> AttributeType
forall n. DotSubGraph n -> AttributeType
subGraphAttrType
                                     DotSubGraph n -> DotStatements n
forall n. DotSubGraph n -> DotStatements n
subGraphStmts DotStatements n -> DotCode
forall n. PrintDot n => DotStatements n -> DotCode
printGStmts

  listToDot :: [DotSubGraph n] -> DotCode
listToDot = [DotSubGraph n] -> DotCode
forall a. PrintDot a => [a] -> DotCode
unqtListToDot

subGraphAttrType :: DotSubGraph n -> AttributeType
subGraphAttrType :: forall n. DotSubGraph n -> AttributeType
subGraphAttrType = AttributeType -> AttributeType -> Bool -> AttributeType
forall a. a -> a -> Bool -> a
bool AttributeType
SubGraphAttribute AttributeType
ClusterAttribute (Bool -> AttributeType)
-> (DotSubGraph n -> Bool) -> DotSubGraph n -> AttributeType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DotSubGraph n -> Bool
forall n. DotSubGraph n -> Bool
isCluster

printSubGraphID' :: DotSubGraph n -> DotCode
printSubGraphID' :: forall n. DotSubGraph n -> DotCode
printSubGraphID' = (DotSubGraph n -> (Bool, Maybe GraphID))
-> DotSubGraph n -> DotCode
forall a. (a -> (Bool, Maybe GraphID)) -> a -> DotCode
printSubGraphID (DotSubGraph n -> Bool
forall n. DotSubGraph n -> Bool
isCluster (DotSubGraph n -> Bool)
-> (DotSubGraph n -> Maybe GraphID)
-> DotSubGraph n
-> (Bool, Maybe GraphID)
forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& DotSubGraph n -> Maybe GraphID
forall n. DotSubGraph n -> Maybe GraphID
subGraphID)

instance (ParseDot n) => ParseDot (DotSubGraph n) where
  parseUnqt :: Parse (DotSubGraph n)
parseUnqt = (Bool -> Maybe GraphID -> DotStatements n -> DotSubGraph n)
-> Parse (DotStatements n) -> Parse (DotSubGraph n)
forall stmt c.
(Bool -> Maybe GraphID -> stmt -> c) -> Parse stmt -> Parse c
parseSubGraph Bool -> Maybe GraphID -> DotStatements n -> DotSubGraph n
forall n. Bool -> Maybe GraphID -> DotStatements n -> DotSubGraph n
DotSG Parse (DotStatements n)
forall n. ParseDot n => Parse (DotStatements n)
parseGStmts
              Parse (DotSubGraph n)
-> Parse (DotSubGraph n) -> Parse (DotSubGraph n)
forall s a. Parser s a -> Parser s a -> Parser s a
`onFail`
              -- Take anonymous DotSubGraphs into account
              (DotStatements n -> DotSubGraph n)
-> Parse (DotStatements n) -> Parse (DotSubGraph n)
forall a b.
(a -> b) -> Parser GraphvizState a -> Parser GraphvizState b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Bool -> Maybe GraphID -> DotStatements n -> DotSubGraph n
forall n. Bool -> Maybe GraphID -> DotStatements n -> DotSubGraph n
DotSG Bool
False Maybe GraphID
forall a. Maybe a
Nothing)
                   (AttributeType -> Parse (DotStatements n) -> Parse (DotStatements n)
forall a. AttributeType -> Parse a -> Parse a
parseBracesBased AttributeType
SubGraphAttribute Parse (DotStatements n)
forall n. ParseDot n => Parse (DotStatements n)
parseGStmts)

  parse :: Parse (DotSubGraph n)
parse = Parse (DotSubGraph n)
forall a. ParseDot a => Parse a
parseUnqt -- Don't want the option of quoting
          Parse (DotSubGraph n) -> ShowS -> Parse (DotSubGraph n)
forall a. Parser GraphvizState a -> ShowS -> Parser GraphvizState a
forall (p :: * -> *) a. Commitment p => p a -> ShowS -> p a
`adjustErr`
          (String
"Not a valid Sub Graph\n\t"String -> ShowS
forall a. [a] -> [a] -> [a]
++)

  parseUnqtList :: Parse [DotSubGraph n]
parseUnqtList = Parse (DotSubGraph n)
-> Parser GraphvizState () -> Parse [DotSubGraph n]
forall (p :: * -> *) a sep. PolyParse p => p a -> p sep -> p [a]
sepBy (Parser GraphvizState ()
whitespace Parser GraphvizState ()
-> Parse (DotSubGraph n) -> Parse (DotSubGraph n)
forall a b.
Parser GraphvizState a
-> Parser GraphvizState b -> Parser GraphvizState b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parse (DotSubGraph n)
forall a. ParseDot a => Parse a
parseUnqt) Parser GraphvizState ()
newline'

  parseList :: Parse [DotSubGraph n]
parseList = Parse [DotSubGraph n]
forall a. ParseDot a => Parse [a]
parseUnqtList

instance Functor DotSubGraph where
  fmap :: forall a b. (a -> b) -> DotSubGraph a -> DotSubGraph b
fmap a -> b
f DotSubGraph a
sg = DotSubGraph a
sg { subGraphStmts = (fmap . fmap) f $ subGraphStmts sg }

generaliseSubGraph :: C.DotSubGraph n -> DotSubGraph n
generaliseSubGraph :: forall n. DotSubGraph n -> DotSubGraph n
generaliseSubGraph (C.DotSG Bool
isC Maybe GraphID
mID DotStatements n
stmts) = DotSG { isCluster :: Bool
isCluster     = Bool
isC
                                                   , subGraphID :: Maybe GraphID
subGraphID    = Maybe GraphID
mID
                                                   , subGraphStmts :: DotStatements n
subGraphStmts = DotStatements n
stmts'
                                                   }
  where
    stmts' :: DotStatements n
stmts' = DotStatements n -> DotStatements n
forall n. DotStatements n -> DotStatements n
generaliseStatements DotStatements n
stmts

withSubGraphID        :: (Maybe (Maybe GraphID) -> b -> a)
                         -> (DotStatements n -> b) -> DotSubGraph n -> a
withSubGraphID :: forall b a n.
(Maybe (Maybe GraphID) -> b -> a)
-> (DotStatements n -> b) -> DotSubGraph n -> a
withSubGraphID Maybe (Maybe GraphID) -> b -> a
f DotStatements n -> b
g DotSubGraph n
sg = Maybe (Maybe GraphID) -> b -> a
f Maybe (Maybe GraphID)
mid (b -> a) -> (DotStatements n -> b) -> DotStatements n -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DotStatements n -> b
g (DotStatements n -> a) -> DotStatements n -> a
forall a b. (a -> b) -> a -> b
$ DotSubGraph n -> DotStatements n
forall n. DotSubGraph n -> DotStatements n
subGraphStmts DotSubGraph n
sg
  where
    mid :: Maybe (Maybe GraphID)
mid = Maybe (Maybe GraphID)
-> Maybe (Maybe GraphID) -> Bool -> Maybe (Maybe GraphID)
forall a. a -> a -> Bool -> a
bool Maybe (Maybe GraphID)
forall a. Maybe a
Nothing (Maybe GraphID -> Maybe (Maybe GraphID)
forall a. a -> Maybe a
Just (Maybe GraphID -> Maybe (Maybe GraphID))
-> Maybe GraphID -> Maybe (Maybe GraphID)
forall a b. (a -> b) -> a -> b
$ DotSubGraph n -> Maybe GraphID
forall n. DotSubGraph n -> Maybe GraphID
subGraphID DotSubGraph n
sg) (Bool -> Maybe (Maybe GraphID)) -> Bool -> Maybe (Maybe GraphID)
forall a b. (a -> b) -> a -> b
$ DotSubGraph n -> Bool
forall n. DotSubGraph n -> Bool
isCluster DotSubGraph n
sg

renumber    :: DotGraph n -> DotGraph n
renumber :: forall n. DotGraph n -> DotGraph n
renumber DotGraph n
dg = DotGraph n
dg { graphStatements = newStmts }
  where
    startN :: Int
startN = Int -> Int
forall a. Enum a => a -> a
succ (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ DotGraph n -> Int
forall n. DotGraph n -> Int
maxSGInt DotGraph n
dg

    newStmts :: Seq (DotStatement n)
newStmts = State Int (Seq (DotStatement n)) -> Int -> Seq (DotStatement n)
forall s a. State s a -> s -> a
evalState (Seq (DotStatement n) -> State Int (Seq (DotStatement n))
forall {n}.
Seq (DotStatement n) -> StateT Int Identity (Seq (DotStatement n))
stsRe (Seq (DotStatement n) -> State Int (Seq (DotStatement n)))
-> Seq (DotStatement n) -> State Int (Seq (DotStatement n))
forall a b. (a -> b) -> a -> b
$ DotGraph n -> Seq (DotStatement n)
forall n. DotGraph n -> DotStatements n
graphStatements DotGraph n
dg) Int
startN

    stsRe :: Seq (DotStatement n) -> StateT Int Identity (Seq (DotStatement n))
stsRe = (DotStatement n -> StateT Int Identity (DotStatement n))
-> Seq (DotStatement n)
-> StateT Int Identity (Seq (DotStatement n))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Seq a -> m (Seq b)
T.mapM DotStatement n -> StateT Int Identity (DotStatement n)
stRe
    stRe :: DotStatement n -> StateT Int Identity (DotStatement n)
stRe (SG DotSubGraph n
sg) = DotSubGraph n -> DotStatement n
forall n. DotSubGraph n -> DotStatement n
SG (DotSubGraph n -> DotStatement n)
-> StateT Int Identity (DotSubGraph n)
-> StateT Int Identity (DotStatement n)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DotSubGraph n -> StateT Int Identity (DotSubGraph n)
sgRe DotSubGraph n
sg
    stRe DotStatement n
stmt    = DotStatement n -> StateT Int Identity (DotStatement n)
forall a. a -> StateT Int Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure DotStatement n
stmt
    sgRe :: DotSubGraph n -> StateT Int Identity (DotSubGraph n)
sgRe DotSubGraph n
sg = do Maybe GraphID
sgid' <- case DotSubGraph n -> Maybe GraphID
forall n. DotSubGraph n -> Maybe GraphID
subGraphID DotSubGraph n
sg of
                            Maybe GraphID
Nothing -> do Int
n <- StateT Int Identity Int
forall s (m :: * -> *). MonadState s m => m s
get
                                          Int -> StateT Int Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (Int -> StateT Int Identity ()) -> Int -> StateT Int Identity ()
forall a b. (a -> b) -> a -> b
$ Int -> Int
forall a. Enum a => a -> a
succ Int
n
                                          Maybe GraphID -> StateT Int Identity (Maybe GraphID)
forall a. a -> StateT Int Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe GraphID -> StateT Int Identity (Maybe GraphID))
-> (Number -> Maybe GraphID)
-> Number
-> StateT Int Identity (Maybe GraphID)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GraphID -> Maybe GraphID
forall a. a -> Maybe a
Just (GraphID -> Maybe GraphID)
-> (Number -> GraphID) -> Number -> Maybe GraphID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Number -> GraphID
Num (Number -> StateT Int Identity (Maybe GraphID))
-> Number -> StateT Int Identity (Maybe GraphID)
forall a b. (a -> b) -> a -> b
$ Int -> Number
Int Int
n
                            Maybe GraphID
sgid    -> Maybe GraphID -> StateT Int Identity (Maybe GraphID)
forall a. a -> StateT Int Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe GraphID
sgid
                 Seq (DotStatement n)
stmts' <- Seq (DotStatement n) -> StateT Int Identity (Seq (DotStatement n))
stsRe (Seq (DotStatement n)
 -> StateT Int Identity (Seq (DotStatement n)))
-> Seq (DotStatement n)
-> StateT Int Identity (Seq (DotStatement n))
forall a b. (a -> b) -> a -> b
$ DotSubGraph n -> Seq (DotStatement n)
forall n. DotSubGraph n -> DotStatements n
subGraphStmts DotSubGraph n
sg
                 DotSubGraph n -> StateT Int Identity (DotSubGraph n)
forall a. a -> StateT Int Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (DotSubGraph n -> StateT Int Identity (DotSubGraph n))
-> DotSubGraph n -> StateT Int Identity (DotSubGraph n)
forall a b. (a -> b) -> a -> b
$ DotSubGraph n
sg { subGraphID    = sgid'
                             , subGraphStmts = stmts'
                             }

maxSGInt    :: DotGraph n -> Int
maxSGInt :: forall n. DotGraph n -> Int
maxSGInt DotGraph n
dg = StateT Int Identity () -> Int -> Int
forall s a. State s a -> s -> s
execState (DotStatements n -> StateT Int Identity ()
forall {n}. DotStatements n -> StateT Int Identity ()
stsInt (DotStatements n -> StateT Int Identity ())
-> DotStatements n -> StateT Int Identity ()
forall a b. (a -> b) -> a -> b
$ DotGraph n -> DotStatements n
forall n. DotGraph n -> DotStatements n
graphStatements DotGraph n
dg)
              (Int -> Int) -> (Maybe GraphID -> Int) -> Maybe GraphID -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe GraphID -> Int -> Int
`check` Int
0)
              (Maybe GraphID -> Int) -> Maybe GraphID -> Int
forall a b. (a -> b) -> a -> b
$ DotGraph n -> Maybe GraphID
forall n. DotGraph n -> Maybe GraphID
graphID DotGraph n
dg
  where
    check :: Maybe GraphID -> Int -> Int
check = (Int -> Int) -> (Int -> Int -> Int) -> Maybe Int -> Int -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int -> Int
forall a. a -> a
id Int -> Int -> Int
forall a. Ord a => a -> a -> a
max (Maybe Int -> Int -> Int)
-> (Maybe GraphID -> Maybe Int) -> Maybe GraphID -> Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GraphID -> Maybe Int
numericValue (GraphID -> Maybe Int) -> Maybe GraphID -> Maybe Int
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<)

    stsInt :: DotStatements n -> StateT Int Identity ()
stsInt = (DotStatement n -> StateT Int Identity ())
-> DotStatements n -> StateT Int Identity ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
F.mapM_ DotStatement n -> StateT Int Identity ()
stInt
    stInt :: DotStatement n -> StateT Int Identity ()
stInt (SG DotSubGraph n
sg) = DotSubGraph n -> StateT Int Identity ()
sgInt DotSubGraph n
sg
    stInt DotStatement n
_       = () -> StateT Int Identity ()
forall a. a -> StateT Int Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    sgInt :: DotSubGraph n -> StateT Int Identity ()
sgInt DotSubGraph n
sg = do (Int -> Int) -> StateT Int Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (Maybe GraphID -> Int -> Int
check (Maybe GraphID -> Int -> Int) -> Maybe GraphID -> Int -> Int
forall a b. (a -> b) -> a -> b
$ DotSubGraph n -> Maybe GraphID
forall n. DotSubGraph n -> Maybe GraphID
subGraphID DotSubGraph n
sg)
                  DotStatements n -> StateT Int Identity ()
stsInt (DotStatements n -> StateT Int Identity ())
-> DotStatements n -> StateT Int Identity ()
forall a b. (a -> b) -> a -> b
$ DotSubGraph n -> DotStatements n
forall n. DotSubGraph n -> DotStatements n
subGraphStmts DotSubGraph n
sg