{-# LANGUAGE CPP, FlexibleInstances, MultiParamTypeClasses #-}
module Data.GraphViz.Types.Monadic
( Dot
, DotM
, GraphID(..)
, digraph
, digraph'
, graph
, graph'
, graphAttrs
, nodeAttrs
, edgeAttrs
, subgraph
, anonSubgraph
, cluster
, node
, node'
, edge
, (-->)
, (<->)
) where
import Data.GraphViz.Attributes (Attributes)
import Data.GraphViz.Types.Generalised
import Data.DList (DList)
import qualified Data.DList as DL
import qualified Data.Sequence as Seq
#if !(MIN_VERSION_base (4,8,0))
import Control.Applicative (Applicative(..))
import Data.Monoid (Monoid(..))
#endif
#if MIN_VERSION_base (4,9,0) && !MIN_VERSION_base (4,13,0)
import Data.Semigroup (Semigroup(..))
#endif
import Control.Monad.Fix (MonadFix (mfix))
type Dot n = DotM n ()
newtype DotM n a = DotM { forall n a. DotM n a -> (a, DotStmts n)
runDot :: (a, DotStmts n) }
execDot :: DotM n a -> DotStmts n
execDot :: forall n a. DotM n a -> DotStmts n
execDot = forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n a. DotM n a -> (a, DotStmts n)
runDot
instance Functor (DotM n) where
fmap :: forall a b. (a -> b) -> DotM n a -> DotM n b
fmap a -> b
f (DotM (a
a,DotStmts n
stmts)) = forall n a. (a, DotStmts n) -> DotM n a
DotM (a -> b
f a
a, DotStmts n
stmts)
instance Applicative (DotM n) where
pure :: forall a. a -> DotM n a
pure = forall n a. (a, DotStmts n) -> DotM n a
DotM forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip (,) forall a. DList a
DL.empty
(DotM (a -> b
f,DotStmts n
stmts1)) <*> :: forall a b. DotM n (a -> b) -> DotM n a -> DotM n b
<*> (DotM (a
a,DotStmts n
stmts2)) = forall n a. (a, DotStmts n) -> DotM n a
DotM (a -> b
f a
a, DotStmts n
stmts1 forall a. DList a -> DList a -> DList a
`DL.append` DotStmts n
stmts2)
instance Monad (DotM n) where
return :: forall a. a -> DotM n a
return = forall (f :: * -> *) a. Applicative f => a -> f a
pure
DotM n a
dt >>= :: forall a b. DotM n a -> (a -> DotM n b) -> DotM n b
>>= a -> DotM n b
f = forall n a. (a, DotStmts n) -> DotM n a
DotM
forall a b. (a -> b) -> a -> b
$ let ~(a
a,DotStmts n
stmts) = forall n a. DotM n a -> (a, DotStmts n)
runDot DotM n a
dt
~(b
b,DotStmts n
stmts') = forall n a. DotM n a -> (a, DotStmts n)
runDot forall a b. (a -> b) -> a -> b
$ a -> DotM n b
f a
a
in (b
b, DotStmts n
stmts forall a. DList a -> DList a -> DList a
`DL.append` DotStmts n
stmts')
instance MonadFix (DotM n) where
mfix :: forall a. (a -> DotM n a) -> DotM n a
mfix a -> DotM n a
m = let (a
a,DotStmts n
n) = forall n a. DotM n a -> (a, DotStmts n)
runDot forall a b. (a -> b) -> a -> b
$ a -> DotM n a
m a
a
in forall n a. (a, DotStmts n) -> DotM n a
DotM (a
a,DotStmts n
n)
#if MIN_VERSION_base (4,9,0)
instance Semigroup a => Semigroup (DotM n a) where
DotM (a, DotStmts n)
x1 <> :: DotM n a -> DotM n a -> DotM n a
<> DotM (a, DotStmts n)
x2 = forall n a. (a, DotStmts n) -> DotM n a
DotM ((a, DotStmts n)
x1 forall a. Semigroup a => a -> a -> a
<> (a, DotStmts n)
x2)
#endif
instance Monoid a => Monoid (DotM n a) where
mappend :: DotM n a -> DotM n a -> DotM n a
mappend (DotM (a, DotStmts n)
x1) (DotM (a, DotStmts n)
x2) = forall n a. (a, DotStmts n) -> DotM n a
DotM (forall a. Monoid a => a -> a -> a
mappend (a, DotStmts n)
x1 (a, DotStmts n)
x2)
mempty :: DotM n a
mempty = forall n a. (a, DotStmts n) -> DotM n a
DotM forall a. Monoid a => a
mempty
tell :: DotStmts n -> Dot n
tell :: forall n. DotStmts n -> Dot n
tell = forall n a. (a, DotStmts n) -> DotM n a
DotM forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,) ()
tellStmt :: DotStmt n -> Dot n
tellStmt :: forall n. DotStmt n -> Dot n
tellStmt = forall n. DotStmts n -> Dot n
tell forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> DList a
DL.singleton
digraph :: GraphID -> DotM n a -> DotGraph n
digraph :: forall n a. GraphID -> DotM n a -> DotGraph n
digraph = forall n a. Bool -> Maybe GraphID -> DotM n a -> DotGraph n
mkGraph Bool
True forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just
digraph' :: DotM n a -> DotGraph n
digraph' :: forall n a. DotM n a -> DotGraph n
digraph' = forall n a. Bool -> Maybe GraphID -> DotM n a -> DotGraph n
mkGraph Bool
True forall a. Maybe a
Nothing
graph :: GraphID -> DotM n a -> DotGraph n
graph :: forall n a. GraphID -> DotM n a -> DotGraph n
graph = forall n a. Bool -> Maybe GraphID -> DotM n a -> DotGraph n
mkGraph Bool
False forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just
graph' :: DotM n a -> DotGraph n
graph' :: forall n a. DotM n a -> DotGraph n
graph' = forall n a. Bool -> Maybe GraphID -> DotM n a -> DotGraph n
mkGraph Bool
False forall a. Maybe a
Nothing
mkGraph :: Bool -> Maybe GraphID -> DotM n a -> DotGraph n
mkGraph :: forall n a. Bool -> Maybe GraphID -> DotM n a -> DotGraph n
mkGraph Bool
isDir Maybe GraphID
mid DotM n a
dot = DotGraph { strictGraph :: Bool
strictGraph = Bool
False
, directedGraph :: Bool
directedGraph = Bool
isDir
, graphID :: Maybe GraphID
graphID = Maybe GraphID
mid
, graphStatements :: DotStatements n
graphStatements = forall n a. DotM n a -> DotStatements n
execStmts DotM n a
dot
}
type DotStmts n = DList (DotStmt n)
execStmts :: DotM n a -> DotStatements n
execStmts :: forall n a. DotM n a -> DotStatements n
execStmts = forall n. DotStmts n -> DotStatements n
convertStatements forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n a. DotM n a -> DotStmts n
execDot
convertStatements :: DotStmts n -> DotStatements n
convertStatements :: forall n. DotStmts n -> DotStatements n
convertStatements = 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. DotStmt n -> DotStatement n
convertStatement forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. DList a -> [a]
DL.toList
data DotStmt n = MA GlobalAttributes
| MS (Subgraph n)
| MN (DotNode n)
| ME (DotEdge n)
convertStatement :: DotStmt n -> DotStatement n
convertStatement :: forall n. DotStmt n -> DotStatement n
convertStatement (MA GlobalAttributes
gas) = forall n. GlobalAttributes -> DotStatement n
GA GlobalAttributes
gas
convertStatement (MS Subgraph n
sg) = forall n. DotSubGraph n -> DotStatement n
SG forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Bool -> Maybe GraphID -> DotStatements n -> DotSubGraph n
DotSG (forall n. Subgraph n -> Bool
sgIsClust Subgraph n
sg) (forall n. Subgraph n -> Maybe GraphID
sgID Subgraph n
sg)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n a. DotM n a -> DotStatements n
execStmts forall a b. (a -> b) -> a -> b
$ forall n. Subgraph n -> Dot n
sgStmts Subgraph n
sg
convertStatement (MN DotNode n
dn) = forall n. DotNode n -> DotStatement n
DN DotNode n
dn
convertStatement (ME DotEdge n
de) = forall n. DotEdge n -> DotStatement n
DE DotEdge n
de
graphAttrs :: Attributes -> Dot n
graphAttrs :: forall n. Attributes -> Dot n
graphAttrs = forall n. DotStmt n -> Dot n
tellStmt forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. GlobalAttributes -> DotStmt n
MA forall b c a. (b -> c) -> (a -> b) -> a -> c
. Attributes -> GlobalAttributes
GraphAttrs
nodeAttrs :: Attributes -> Dot n
nodeAttrs :: forall n. Attributes -> Dot n
nodeAttrs = forall n. DotStmt n -> Dot n
tellStmt forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. GlobalAttributes -> DotStmt n
MA forall b c a. (b -> c) -> (a -> b) -> a -> c
. Attributes -> GlobalAttributes
NodeAttrs
edgeAttrs :: Attributes -> Dot n
edgeAttrs :: forall n. Attributes -> Dot n
edgeAttrs = forall n. DotStmt n -> Dot n
tellStmt forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. GlobalAttributes -> DotStmt n
MA forall b c a. (b -> c) -> (a -> b) -> a -> c
. Attributes -> GlobalAttributes
EdgeAttrs
data Subgraph n = Sg { forall n. Subgraph n -> Bool
sgIsClust :: Bool
, forall n. Subgraph n -> Maybe GraphID
sgID :: Maybe GraphID
, forall n. Subgraph n -> Dot n
sgStmts :: Dot n
}
subgraph :: GraphID -> DotM n a -> Dot n
subgraph :: forall n a. GraphID -> DotM n a -> Dot n
subgraph = forall n a. Maybe GraphID -> DotM n a -> Dot n
nonClust forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just
anonSubgraph :: DotM n a -> Dot n
anonSubgraph :: forall n a. DotM n a -> Dot n
anonSubgraph = forall n a. Maybe GraphID -> DotM n a -> Dot n
nonClust forall a. Maybe a
Nothing
nonClust :: Maybe GraphID -> DotM n a -> Dot n
nonClust :: forall n a. Maybe GraphID -> DotM n a -> Dot n
nonClust = forall n a. Bool -> Maybe GraphID -> DotM n a -> Dot n
createSubGraph Bool
False
createSubGraph :: Bool -> Maybe GraphID -> DotM n a -> Dot n
createSubGraph :: forall n a. Bool -> Maybe GraphID -> DotM n a -> Dot n
createSubGraph Bool
isCl Maybe GraphID
mid = forall n. DotStmt n -> Dot n
tellStmt forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Subgraph n -> DotStmt n
MS forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Bool -> Maybe GraphID -> Dot n -> Subgraph n
Sg Bool
isCl Maybe GraphID
mid forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ())
cluster :: GraphID -> DotM n a -> Dot n
cluster :: forall n a. GraphID -> DotM n a -> Dot n
cluster = forall n a. Bool -> Maybe GraphID -> DotM n a -> Dot n
createSubGraph Bool
True forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just
node :: n -> Attributes -> Dot n
node :: forall n. n -> Attributes -> Dot n
node n
n = forall n. DotStmt n -> Dot n
tellStmt forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. DotNode n -> DotStmt n
MN forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. n -> Attributes -> DotNode n
DotNode n
n
node' :: n -> Dot n
node' :: forall n. n -> Dot n
node' = (forall n. n -> Attributes -> Dot n
`node` [])
edge :: n -> n -> Attributes -> Dot n
edge :: forall n. n -> n -> Attributes -> Dot n
edge n
f n
t = forall n. DotStmt n -> Dot n
tellStmt forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. DotEdge n -> DotStmt n
ME forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. n -> n -> Attributes -> DotEdge n
DotEdge n
f n
t
(-->) :: n -> n -> Dot n
n
f --> :: forall n. n -> n -> Dot n
--> n
t = forall n. n -> n -> Attributes -> Dot n
edge n
f n
t []
infixr 9 -->
(<->) :: n -> n -> Dot n
<-> :: forall n. n -> n -> Dot n
(<->) = forall n. n -> n -> Dot n
(-->)
infixr 9 <->