{-# 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
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 -- Don't want the option of quoting
          forall (p :: * -> *) a. Commitment p => p a -> ShowS -> p a
`adjustErr`
          (String
"Not a valid generalised DotGraph\n\t"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 :: 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 }

-- | 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     = 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
                                 }

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

-- | 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 = 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 -- Don't want the option of quoting
          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
      -- Have to do something special here because of "a -> b -> c"
      -- syntax for edges.
      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 -- Have to re-make this to make the type checker happy.
  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`
              -- Take anonymous DotSubGraphs into account
              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 -- Don't want the option of quoting
          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