{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
module Data.GraphViz.Types.Generalised
( DotGraph(..)
, FromGeneralisedDot (..)
, DotStatements
, DotStatement(..)
, DotSubGraph(..)
, 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
data DotGraph n = DotGraph {
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
forall n. Eq n => DotGraph n -> DotGraph n -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DotGraph n -> DotGraph n -> Bool
$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
Eq, DotGraph n -> DotGraph n -> Bool
DotGraph n -> DotGraph n -> Ordering
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
min :: DotGraph n -> DotGraph n -> DotGraph n
$cmin :: forall n. Ord n => DotGraph n -> DotGraph n -> DotGraph n
max :: DotGraph n -> DotGraph n -> DotGraph n
$cmax :: forall n. Ord n => DotGraph n -> DotGraph n -> DotGraph n
>= :: 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
$c< :: forall n. Ord n => DotGraph n -> DotGraph n -> Bool
compare :: DotGraph n -> DotGraph n -> Ordering
$ccompare :: forall n. Ord n => DotGraph n -> DotGraph n -> Ordering
Ord, Int -> DotGraph n -> ShowS
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
showList :: [DotGraph n] -> ShowS
$cshowList :: forall n. Show n => [DotGraph n] -> ShowS
show :: DotGraph n -> String
$cshow :: forall n. Show n => DotGraph n -> String
showsPrec :: Int -> DotGraph n -> ShowS
$cshowsPrec :: forall n. Show n => Int -> DotGraph n -> ShowS
Show, ReadPrec [DotGraph n]
ReadPrec (DotGraph n)
ReadS [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
readListPrec :: ReadPrec [DotGraph n]
$creadListPrec :: forall n. Read n => ReadPrec [DotGraph n]
readPrec :: ReadPrec (DotGraph n)
$creadPrec :: forall n. Read n => ReadPrec (DotGraph n)
readList :: ReadS [DotGraph n]
$creadList :: forall n. Read n => ReadS [DotGraph n]
readsPrec :: Int -> ReadS (DotGraph n)
$creadsPrec :: forall n. Read n => Int -> ReadS (DotGraph n)
Read)
instance (Ord n) => DotRepr DotGraph n where
fromCanonical :: DotGraph n -> DotGraph n
fromCanonical = forall n. DotGraph n -> DotGraph n
generaliseDotGraph
getID :: DotGraph n -> Maybe GraphID
getID = forall n. DotGraph n -> Maybe GraphID
graphID
setID :: GraphID -> DotGraph n -> DotGraph n
setID GraphID
i DotGraph n
g = DotGraph n
g { graphID :: Maybe GraphID
graphID = forall a. a -> Maybe a
Just GraphID
i }
graphIsDirected :: DotGraph n -> Bool
graphIsDirected = forall n. DotGraph n -> Bool
directedGraph
setIsDirected :: Bool -> DotGraph n -> DotGraph n
setIsDirected Bool
d DotGraph n
g = DotGraph n
g { directedGraph :: Bool
directedGraph = Bool
d }
graphIsStrict :: DotGraph n -> Bool
graphIsStrict = forall n. DotGraph n -> Bool
strictGraph
setStrictness :: Bool -> DotGraph n -> DotGraph n
setStrictness Bool
s DotGraph n
g = DotGraph n
g { strictGraph :: Bool
strictGraph = Bool
s }
mapDotGraph :: forall n'.
DotRepr DotGraph n' =>
(n -> n') -> DotGraph n -> DotGraph n'
mapDotGraph = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
graphStructureInformation :: DotGraph n -> (GlobalAttributes, ClusterLookup)
graphStructureInformation = forall a. GraphState a -> (GlobalAttributes, ClusterLookup)
getGraphInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. DotStatements n -> GraphState ()
statementStructure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. DotGraph n -> DotStatements n
graphStatements
nodeInformation :: Bool -> DotGraph n -> NodeLookup n
nodeInformation Bool
wGlobal = forall n a. Bool -> NodeState n a -> NodeLookup n
getNodeLookup Bool
wGlobal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Ord n => DotStatements n -> NodeState n ()
statementNodes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. DotGraph n -> DotStatements n
graphStatements
edgeInformation :: Bool -> DotGraph n -> [DotEdge n]
edgeInformation Bool
wGlobal = forall n a. Bool -> EdgeState n a -> [DotEdge n]
getDotEdges Bool
wGlobal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. DotStatements n -> EdgeState n ()
statementEdges forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. DotGraph n -> DotStatements n
graphStatements
unAnonymise :: DotGraph n -> DotGraph n
unAnonymise = 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 = forall a stmts.
(a -> DotCode)
-> (a -> AttributeType)
-> (a -> stmts)
-> (stmts -> DotCode)
-> a
-> DotCode
printStmtBased forall {n}. DotGraph n -> DotCode
printGraphID' (forall a b. a -> b -> a
const AttributeType
GraphAttribute)
forall n. DotGraph n -> DotStatements n
graphStatements forall n. PrintDot n => DotStatements n -> DotCode
printGStmts
where
printGraphID' :: DotGraph n -> DotCode
printGraphID' = forall a.
(a -> Bool) -> (a -> Bool) -> (a -> Maybe GraphID) -> a -> DotCode
printGraphID forall n. DotGraph n -> Bool
strictGraph forall n. DotGraph n -> Bool
directedGraph forall n. DotGraph n -> Maybe GraphID
graphID
instance (ParseDot n) => ParseDot (DotGraph n) where
parseUnqt :: Parse (DotGraph n)
parseUnqt = forall a. (Bool -> Bool -> Maybe GraphID -> a) -> Parse a
parseGraphID forall n.
Bool -> Bool -> Maybe GraphID -> DotStatements n -> DotGraph n
DotGraph
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. AttributeType -> Parse a -> Parse a
parseBracesBased AttributeType
GraphAttribute forall n. ParseDot n => Parse (DotStatements n)
parseGStmts
parse :: Parse (DotGraph n)
parse = forall a. ParseDot a => Parse a
parseUnqt
forall (p :: * -> *) a. Commitment p => p a -> ShowS -> p a
`adjustErr`
(String
"Not a valid generalised DotGraph\n\t"forall a. [a] -> [a] -> [a]
++)
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 :: DotStatements b
graphStatements = (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) a -> b
f forall a b. (a -> b) -> a -> b
$ forall n. DotGraph n -> DotStatements n
graphStatements DotGraph a
g }
generaliseDotGraph :: C.DotGraph n -> DotGraph n
generaliseDotGraph :: forall n. DotGraph n -> DotGraph n
generaliseDotGraph DotGraph n
dg = DotGraph { strictGraph :: Bool
strictGraph = forall n. DotGraph n -> Bool
C.strictGraph DotGraph n
dg
, directedGraph :: Bool
directedGraph = forall n. DotGraph n -> Bool
C.directedGraph DotGraph n
dg
, graphID :: Maybe GraphID
graphID = forall n. DotGraph n -> Maybe GraphID
C.graphID DotGraph n
dg
, graphStatements :: DotStatements n
graphStatements = forall n. DotStatements n -> DotStatements n
generaliseStatements
forall a b. (a -> b) -> a -> b
$ forall n. DotGraph n -> DotStatements n
C.graphStatements DotGraph n
dg
}
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 = forall (dg :: * -> *) n. DotRepr dg n => dg n -> DotGraph n
canonicalise
instance (Ord n) => FromGeneralisedDot DotGraph n where
fromGeneralised :: DotGraph n -> DotGraph n
fromGeneralised = 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 = forall a. PrintDot a => a -> DotCode
toDot forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = (forall a. [a] -> Seq a
Seq.fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. ParseDot a => Parse a
parse)
forall (p :: * -> *) a. Commitment p => p a -> ShowS -> p a
`adjustErr`
(String
"Not a valid generalised DotStatements\n\t"forall a. [a] -> [a] -> [a]
++)
statementStructure :: DotStatements n -> GraphState ()
statementStructure :: forall n. DotStatements n -> GraphState ()
statementStructure = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
F.mapM_ forall n. DotStatement n -> GraphState ()
stmtStructure
statementNodes :: (Ord n) => DotStatements n -> NodeState n ()
statementNodes :: forall n. Ord n => DotStatements n -> NodeState n ()
statementNodes = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
F.mapM_ forall n. Ord n => DotStatement n -> NodeState n ()
stmtNodes
statementEdges :: DotStatements n -> EdgeState n ()
statementEdges :: forall n. DotStatements n -> EdgeState n ()
statementEdges = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
F.mapM_ forall n. DotStatement n -> EdgeState n ()
stmtEdges
generaliseStatements :: C.DotStatements n -> DotStatements n
generaliseStatements :: forall n. DotStatements n -> DotStatements n
generaliseStatements DotStatements n
stmts = forall {n}. Seq (DotStatement n)
atts forall a. Seq a -> Seq a -> Seq a
>< Seq (DotStatement n)
sgs forall a. Seq a -> Seq a -> Seq a
>< Seq (DotStatement n)
ns forall a. Seq a -> Seq a -> Seq a
>< Seq (DotStatement n)
es
where
atts :: Seq (DotStatement n)
atts = forall a. [a] -> Seq a
Seq.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall n. GlobalAttributes -> DotStatement n
GA forall a b. (a -> b) -> a -> b
$ forall n. DotStatements n -> [GlobalAttributes]
C.attrStmts DotStatements n
stmts
sgs :: Seq (DotStatement n)
sgs = forall a. [a] -> Seq a
Seq.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall n. DotSubGraph n -> DotStatement n
SG forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. DotSubGraph n -> DotSubGraph n
generaliseSubGraph) forall a b. (a -> b) -> a -> b
$ forall n. DotStatements n -> [DotSubGraph n]
C.subGraphs DotStatements n
stmts
ns :: Seq (DotStatement n)
ns = forall a. [a] -> Seq a
Seq.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall n. DotNode n -> DotStatement n
DN forall a b. (a -> b) -> a -> b
$ forall n. DotStatements n -> [DotNode n]
C.nodeStmts DotStatements n
stmts
es :: Seq (DotStatement n)
es = forall a. [a] -> Seq a
Seq.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall n. DotEdge n -> DotStatement n
DE forall a b. (a -> b) -> a -> b
$ 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
forall n. Eq n => DotStatement n -> DotStatement n -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DotStatement n -> DotStatement n -> Bool
$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
Eq, DotStatement n -> DotStatement n -> Ordering
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
min :: DotStatement n -> DotStatement n -> DotStatement n
$cmin :: forall n.
Ord n =>
DotStatement n -> DotStatement n -> DotStatement n
max :: DotStatement n -> DotStatement n -> DotStatement n
$cmax :: forall n.
Ord n =>
DotStatement n -> DotStatement n -> DotStatement n
>= :: 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
$c< :: forall n. Ord n => DotStatement n -> DotStatement n -> Bool
compare :: DotStatement n -> DotStatement n -> Ordering
$ccompare :: forall n. Ord n => DotStatement n -> DotStatement n -> Ordering
Ord, Int -> DotStatement n -> ShowS
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
showList :: [DotStatement n] -> ShowS
$cshowList :: forall n. Show n => [DotStatement n] -> ShowS
show :: DotStatement n -> String
$cshow :: forall n. Show n => DotStatement n -> String
showsPrec :: Int -> DotStatement n -> ShowS
$cshowsPrec :: forall n. Show n => Int -> DotStatement n -> ShowS
Show, ReadPrec [DotStatement n]
ReadPrec (DotStatement n)
ReadS [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
readListPrec :: ReadPrec [DotStatement n]
$creadListPrec :: forall n. Read n => ReadPrec [DotStatement n]
readPrec :: ReadPrec (DotStatement n)
$creadPrec :: forall n. Read n => ReadPrec (DotStatement n)
readList :: ReadS [DotStatement n]
$creadList :: forall n. Read n => ReadS [DotStatement n]
readsPrec :: Int -> ReadS (DotStatement n)
$creadsPrec :: forall n. Read n => Int -> ReadS (DotStatement n)
Read)
instance (PrintDot n) => PrintDot (DotStatement n) where
unqtDot :: DotStatement n -> DotCode
unqtDot (GA GlobalAttributes
ga) = forall a. PrintDot a => a -> DotCode
unqtDot GlobalAttributes
ga
unqtDot (SG DotSubGraph n
sg) = forall a. PrintDot a => a -> DotCode
unqtDot DotSubGraph n
sg
unqtDot (DN DotNode n
dn) = forall a. PrintDot a => a -> DotCode
unqtDot DotNode n
dn
unqtDot (DE DotEdge n
de) = forall a. PrintDot a => a -> DotCode
unqtDot DotEdge n
de
unqtListToDot :: [DotStatement n] -> DotCode
unqtListToDot = forall (m :: * -> *). Functor m => m [Doc] -> m Doc
vcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall a. PrintDot a => a -> DotCode
unqtDot
listToDot :: [DotStatement n] -> DotCode
listToDot = forall a. PrintDot a => [a] -> DotCode
unqtListToDot
instance (ParseDot n) => ParseDot (DotStatement n) where
parseUnqt :: Parse (DotStatement n)
parseUnqt = forall (p :: * -> *) a. PolyParse p => [p a] -> p a
oneOf [ forall n. GlobalAttributes -> DotStatement n
GA forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. ParseDot a => Parse a
parseUnqt
, forall n. DotSubGraph n -> DotStatement n
SG forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. ParseDot a => Parse a
parseUnqt
, forall n. DotNode n -> DotStatement n
DN forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. ParseDot a => Parse a
parseUnqt
, forall n. DotEdge n -> DotStatement n
DE forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. ParseDot a => Parse a
parseUnqt
]
parse :: Parse (DotStatement n)
parse = forall a. ParseDot a => Parse a
parseUnqt
forall (p :: * -> *) a. Commitment p => p a -> ShowS -> p a
`adjustErr`
(String
"Not a valid statement\n\t"forall a. [a] -> [a] -> [a]
++)
parseUnqtList :: Parse [DotStatement n]
parseUnqtList = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Parse a -> Parse a
wrapWhitespace
forall a b. (a -> b) -> a -> b
$ forall a. Parse a -> Parse [a]
parseStatements Parse [DotStatement n]
p
where
p :: Parse [DotStatement n]
p = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (a -> b) -> [a] -> [b]
map forall n. DotEdge n -> DotStatement n
DE) forall n. ParseDot n => Parse [DotEdge n]
parseEdgeLine
forall s a. Parser s a -> Parser s a -> Parser s a
`onFail`
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. a -> [a] -> [a]
:[]) forall a. ParseDot a => Parse a
parse
parseList :: Parse [DotStatement n]
parseList = 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) = forall n. GlobalAttributes -> DotStatement n
GA GlobalAttributes
ga
fmap a -> b
f (SG DotSubGraph a
sg) = forall n. DotSubGraph n -> DotStatement n
SG forall a b. (a -> b) -> a -> 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) = forall n. DotNode n -> DotStatement n
DN forall a b. (a -> b) -> a -> 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) = forall n. DotEdge n -> DotStatement n
DE forall a b. (a -> b) -> a -> 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) = forall b a n.
(Maybe (Maybe GraphID) -> b -> a)
-> (DotStatements n -> b) -> DotSubGraph n -> a
withSubGraphID forall a. Maybe (Maybe GraphID) -> GraphState a -> GraphState ()
addSubGraph forall n. DotStatements n -> GraphState ()
statementStructure DotSubGraph n
sg
stmtStructure DotStatement n
_ = 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) = forall n. GlobalAttributes -> NodeState n ()
addNodeGlobals GlobalAttributes
ga
stmtNodes (SG DotSubGraph n
sg) = forall b a n.
(Maybe (Maybe GraphID) -> b -> a)
-> (DotStatements n -> b) -> DotSubGraph n -> a
withSubGraphID forall s. Maybe (Maybe GraphID) -> GVState s () -> GVState s ()
recursiveCall forall n. Ord n => DotStatements n -> NodeState n ()
statementNodes DotSubGraph n
sg
stmtNodes (DN DotNode n
dn) = forall n. Ord n => DotNode n -> NodeState n ()
addNode DotNode n
dn
stmtNodes (DE DotEdge n
de) = 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) = forall n. GlobalAttributes -> EdgeState n ()
addEdgeGlobals GlobalAttributes
ga
stmtEdges (SG DotSubGraph n
sg) = forall b a n.
(Maybe (Maybe GraphID) -> b -> a)
-> (DotStatements n -> b) -> DotSubGraph n -> a
withSubGraphID forall s. Maybe (Maybe GraphID) -> GVState s () -> GVState s ()
recursiveCall forall n. DotStatements n -> EdgeState n ()
statementEdges DotSubGraph n
sg
stmtEdges (DE DotEdge n
de) = forall n. DotEdge n -> EdgeState n ()
addEdge DotEdge n
de
stmtEdges DotStatement n
_ = 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
forall n. Eq n => DotSubGraph n -> DotSubGraph n -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DotSubGraph n -> DotSubGraph n -> Bool
$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
Eq, DotSubGraph n -> DotSubGraph n -> Bool
DotSubGraph n -> DotSubGraph n -> Ordering
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
min :: DotSubGraph n -> DotSubGraph n -> DotSubGraph n
$cmin :: forall n. Ord n => DotSubGraph n -> DotSubGraph n -> DotSubGraph n
max :: DotSubGraph n -> DotSubGraph n -> DotSubGraph n
$cmax :: forall n. Ord n => DotSubGraph n -> DotSubGraph n -> DotSubGraph n
>= :: 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
$c< :: forall n. Ord n => DotSubGraph n -> DotSubGraph n -> Bool
compare :: DotSubGraph n -> DotSubGraph n -> Ordering
$ccompare :: forall n. Ord n => DotSubGraph n -> DotSubGraph n -> Ordering
Ord, Int -> DotSubGraph n -> ShowS
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
showList :: [DotSubGraph n] -> ShowS
$cshowList :: forall n. Show n => [DotSubGraph n] -> ShowS
show :: DotSubGraph n -> String
$cshow :: forall n. Show n => DotSubGraph n -> String
showsPrec :: Int -> DotSubGraph n -> ShowS
$cshowsPrec :: forall n. Show n => Int -> DotSubGraph n -> ShowS
Show, ReadPrec [DotSubGraph n]
ReadPrec (DotSubGraph n)
ReadS [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
readListPrec :: ReadPrec [DotSubGraph n]
$creadListPrec :: forall n. Read n => ReadPrec [DotSubGraph n]
readPrec :: ReadPrec (DotSubGraph n)
$creadPrec :: forall n. Read n => ReadPrec (DotSubGraph n)
readList :: ReadS [DotSubGraph n]
$creadList :: forall n. Read n => ReadS [DotSubGraph n]
readsPrec :: Int -> ReadS (DotSubGraph n)
$creadsPrec :: forall n. Read n => Int -> ReadS (DotSubGraph n)
Read)
instance (PrintDot n) => PrintDot (DotSubGraph n) where
unqtDot :: DotSubGraph n -> DotCode
unqtDot = forall a stmts.
(a -> DotCode)
-> (a -> AttributeType)
-> (a -> stmts)
-> (stmts -> DotCode)
-> a
-> DotCode
printStmtBased forall n. DotSubGraph n -> DotCode
printSubGraphID' forall n. DotSubGraph n -> AttributeType
subGraphAttrType
forall n. DotSubGraph n -> DotStatements n
subGraphStmts forall n. PrintDot n => DotStatements n -> DotCode
printGStmts
unqtListToDot :: [DotSubGraph n] -> DotCode
unqtListToDot = forall a stmts.
(a -> DotCode)
-> (a -> AttributeType)
-> (a -> stmts)
-> (stmts -> DotCode)
-> [a]
-> DotCode
printStmtBasedList forall n. DotSubGraph n -> DotCode
printSubGraphID' forall n. DotSubGraph n -> AttributeType
subGraphAttrType
forall n. DotSubGraph n -> DotStatements n
subGraphStmts forall n. PrintDot n => DotStatements n -> DotCode
printGStmts
listToDot :: [DotSubGraph n] -> DotCode
listToDot = forall a. PrintDot a => [a] -> DotCode
unqtListToDot
subGraphAttrType :: DotSubGraph n -> AttributeType
subGraphAttrType :: forall n. DotSubGraph n -> AttributeType
subGraphAttrType = forall a. a -> a -> Bool -> a
bool AttributeType
SubGraphAttribute AttributeType
ClusterAttribute forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. DotSubGraph n -> Bool
isCluster
printSubGraphID' :: DotSubGraph n -> DotCode
printSubGraphID' :: forall n. DotSubGraph n -> DotCode
printSubGraphID' = forall a. (a -> (Bool, Maybe GraphID)) -> a -> DotCode
printSubGraphID (forall n. DotSubGraph n -> Bool
isCluster forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& forall n. DotSubGraph n -> Maybe GraphID
subGraphID)
instance (ParseDot n) => ParseDot (DotSubGraph n) where
parseUnqt :: Parse (DotSubGraph n)
parseUnqt = forall stmt c.
(Bool -> Maybe GraphID -> stmt -> c) -> Parse stmt -> Parse c
parseSubGraph forall n. Bool -> Maybe GraphID -> DotStatements n -> DotSubGraph n
DotSG forall n. ParseDot n => Parse (DotStatements n)
parseGStmts
forall s a. Parser s a -> Parser s a -> Parser s a
`onFail`
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall n. Bool -> Maybe GraphID -> DotStatements n -> DotSubGraph n
DotSG Bool
False forall a. Maybe a
Nothing)
(forall a. AttributeType -> Parse a -> Parse a
parseBracesBased AttributeType
SubGraphAttribute forall n. ParseDot n => Parse (DotStatements n)
parseGStmts)
parse :: Parse (DotSubGraph n)
parse = forall a. ParseDot a => Parse a
parseUnqt
forall (p :: * -> *) a. Commitment p => p a -> ShowS -> p a
`adjustErr`
(String
"Not a valid Sub Graph\n\t"forall a. [a] -> [a] -> [a]
++)
parseUnqtList :: Parse [DotSubGraph n]
parseUnqtList = forall (p :: * -> *) a sep. PolyParse p => p a -> p sep -> p [a]
sepBy (Parse ()
whitespace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a. ParseDot a => Parse a
parseUnqt) Parse ()
newline'
parseList :: Parse [DotSubGraph n]
parseList = 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 :: DotStatements b
subGraphStmts = (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) a -> b
f forall a b. (a -> b) -> a -> b
$ forall n. DotSubGraph n -> DotStatements n
subGraphStmts DotSubGraph a
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' = 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. DotStatements n -> b
g forall a b. (a -> b) -> a -> b
$ forall n. DotSubGraph n -> DotStatements n
subGraphStmts DotSubGraph n
sg
where
mid :: Maybe (Maybe GraphID)
mid = forall a. a -> a -> Bool -> a
bool forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall n. DotSubGraph n -> Maybe GraphID
subGraphID DotSubGraph n
sg) forall a b. (a -> b) -> a -> b
$ 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 :: DotStatements n
graphStatements = DotStatements n
newStmts }
where
startN :: Int
startN = forall a. Enum a => a -> a
succ forall a b. (a -> b) -> a -> b
$ forall n. DotGraph n -> Int
maxSGInt DotGraph n
dg
newStmts :: DotStatements n
newStmts = forall s a. State s a -> s -> a
evalState (forall {n}.
Seq (DotStatement n) -> StateT Int Identity (Seq (DotStatement n))
stsRe forall a b. (a -> b) -> a -> b
$ forall n. DotGraph n -> DotStatements n
graphStatements DotGraph n
dg) Int
startN
stsRe :: Seq (DotStatement n) -> StateT Int Identity (Seq (DotStatement n))
stsRe = forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
T.mapM DotStatement n -> StateT Int Identity (DotStatement n)
stRe
stRe :: DotStatement n -> StateT Int Identity (DotStatement n)
stRe (SG DotSubGraph n
sg) = forall n. DotSubGraph n -> DotStatement n
SG 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 = 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 forall n. DotSubGraph n -> Maybe GraphID
subGraphID DotSubGraph n
sg of
Maybe GraphID
Nothing -> do Int
n <- forall s (m :: * -> *). MonadState s m => m s
get
forall s (m :: * -> *). MonadState s m => s -> m ()
put forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> a
succ Int
n
forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Number -> GraphID
Num forall a b. (a -> b) -> a -> b
$ Int -> Number
Int Int
n
Maybe GraphID
sgid -> 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 forall a b. (a -> b) -> a -> b
$ forall n. DotSubGraph n -> DotStatements n
subGraphStmts DotSubGraph n
sg
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ DotSubGraph n
sg { subGraphID :: Maybe GraphID
subGraphID = Maybe GraphID
sgid'
, subGraphStmts :: Seq (DotStatement n)
subGraphStmts = Seq (DotStatement n)
stmts'
}
maxSGInt :: DotGraph n -> Int
maxSGInt :: forall n. DotGraph n -> Int
maxSGInt DotGraph n
dg = forall s a. State s a -> s -> s
execState (forall {n}. DotStatements n -> StateT Int Identity ()
stsInt forall a b. (a -> b) -> a -> b
$ forall n. DotGraph n -> DotStatements n
graphStatements DotGraph n
dg)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe GraphID -> Int -> Int
`check` Int
0)
forall a b. (a -> b) -> a -> b
$ forall n. DotGraph n -> Maybe GraphID
graphID DotGraph n
dg
where
check :: Maybe GraphID -> Int -> Int
check = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id forall a. Ord a => a -> a -> a
max forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GraphID -> Maybe Int
numericValue forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<)
stsInt :: DotStatements n -> StateT Int Identity ()
stsInt = 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
_ = forall (m :: * -> *) a. Monad m => a -> m a
return ()
sgInt :: DotSubGraph n -> StateT Int Identity ()
sgInt DotSubGraph n
sg = do forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (Maybe GraphID -> Int -> Int
check forall a b. (a -> b) -> a -> b
$ forall n. DotSubGraph n -> Maybe GraphID
subGraphID DotSubGraph n
sg)
DotStatements n -> StateT Int Identity ()
stsInt forall a b. (a -> b) -> a -> b
$ forall n. DotSubGraph n -> DotStatements n
subGraphStmts DotSubGraph n
sg