{-# OPTIONS_HADDOCK hide #-}
{-# LANGUAGE FlexibleInstances #-}
module Data.GraphViz.Internal.State
( GraphvizStateM(..)
, GraphvizState(..)
, AttributeType(..)
, setAttributeType
, getAttributeType
, initialState
, setDirectedness
, getDirectedness
, setLayerSep
, getLayerSep
, setLayerListSep
, getLayerListSep
, setColorScheme
, getColorScheme
) where
import Data.GraphViz.Attributes.ColorScheme
import Text.ParserCombinators.Poly.StateText (Parser, stQuery, stUpdate)
class (Monad m) => GraphvizStateM m where
modifyGS :: (GraphvizState -> GraphvizState) -> m ()
getsGS :: (GraphvizState -> a) -> m a
instance GraphvizStateM (Parser GraphvizState) where
modifyGS :: (GraphvizState -> GraphvizState) -> Parser GraphvizState ()
modifyGS = (GraphvizState -> GraphvizState) -> Parser GraphvizState ()
forall s. (s -> s) -> Parser s ()
stUpdate
getsGS :: (GraphvizState -> a) -> Parser GraphvizState a
getsGS = (GraphvizState -> a) -> Parser GraphvizState a
forall s a. (s -> a) -> Parser s a
stQuery
data AttributeType = GraphAttribute
| SubGraphAttribute
| ClusterAttribute
| NodeAttribute
| EdgeAttribute
deriving (AttributeType -> AttributeType -> Bool
(AttributeType -> AttributeType -> Bool)
-> (AttributeType -> AttributeType -> Bool) -> Eq AttributeType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AttributeType -> AttributeType -> Bool
$c/= :: AttributeType -> AttributeType -> Bool
== :: AttributeType -> AttributeType -> Bool
$c== :: AttributeType -> AttributeType -> Bool
Eq, Eq AttributeType
Eq AttributeType =>
(AttributeType -> AttributeType -> Ordering)
-> (AttributeType -> AttributeType -> Bool)
-> (AttributeType -> AttributeType -> Bool)
-> (AttributeType -> AttributeType -> Bool)
-> (AttributeType -> AttributeType -> Bool)
-> (AttributeType -> AttributeType -> AttributeType)
-> (AttributeType -> AttributeType -> AttributeType)
-> Ord AttributeType
AttributeType -> AttributeType -> Bool
AttributeType -> AttributeType -> Ordering
AttributeType -> AttributeType -> AttributeType
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
min :: AttributeType -> AttributeType -> AttributeType
$cmin :: AttributeType -> AttributeType -> AttributeType
max :: AttributeType -> AttributeType -> AttributeType
$cmax :: AttributeType -> AttributeType -> AttributeType
>= :: AttributeType -> AttributeType -> Bool
$c>= :: AttributeType -> AttributeType -> Bool
> :: AttributeType -> AttributeType -> Bool
$c> :: AttributeType -> AttributeType -> Bool
<= :: AttributeType -> AttributeType -> Bool
$c<= :: AttributeType -> AttributeType -> Bool
< :: AttributeType -> AttributeType -> Bool
$c< :: AttributeType -> AttributeType -> Bool
compare :: AttributeType -> AttributeType -> Ordering
$ccompare :: AttributeType -> AttributeType -> Ordering
$cp1Ord :: Eq AttributeType
Ord, Int -> AttributeType -> ShowS
[AttributeType] -> ShowS
AttributeType -> String
(Int -> AttributeType -> ShowS)
-> (AttributeType -> String)
-> ([AttributeType] -> ShowS)
-> Show AttributeType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AttributeType] -> ShowS
$cshowList :: [AttributeType] -> ShowS
show :: AttributeType -> String
$cshow :: AttributeType -> String
showsPrec :: Int -> AttributeType -> ShowS
$cshowsPrec :: Int -> AttributeType -> ShowS
Show, ReadPrec [AttributeType]
ReadPrec AttributeType
Int -> ReadS AttributeType
ReadS [AttributeType]
(Int -> ReadS AttributeType)
-> ReadS [AttributeType]
-> ReadPrec AttributeType
-> ReadPrec [AttributeType]
-> Read AttributeType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AttributeType]
$creadListPrec :: ReadPrec [AttributeType]
readPrec :: ReadPrec AttributeType
$creadPrec :: ReadPrec AttributeType
readList :: ReadS [AttributeType]
$creadList :: ReadS [AttributeType]
readsPrec :: Int -> ReadS AttributeType
$creadsPrec :: Int -> ReadS AttributeType
Read)
data GraphvizState = GS { GraphvizState -> Bool
parseStrictly :: !Bool
, GraphvizState -> Bool
directedEdges :: !Bool
, GraphvizState -> String
layerSep :: [Char]
, GraphvizState -> String
layerListSep :: [Char]
, GraphvizState -> AttributeType
attributeType :: !AttributeType
, GraphvizState -> ColorScheme
graphColor :: !ColorScheme
, GraphvizState -> ColorScheme
clusterColor :: !ColorScheme
, GraphvizState -> ColorScheme
nodeColor :: !ColorScheme
, GraphvizState -> ColorScheme
edgeColor :: !ColorScheme
}
deriving (GraphvizState -> GraphvizState -> Bool
(GraphvizState -> GraphvizState -> Bool)
-> (GraphvizState -> GraphvizState -> Bool) -> Eq GraphvizState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GraphvizState -> GraphvizState -> Bool
$c/= :: GraphvizState -> GraphvizState -> Bool
== :: GraphvizState -> GraphvizState -> Bool
$c== :: GraphvizState -> GraphvizState -> Bool
Eq, Eq GraphvizState
Eq GraphvizState =>
(GraphvizState -> GraphvizState -> Ordering)
-> (GraphvizState -> GraphvizState -> Bool)
-> (GraphvizState -> GraphvizState -> Bool)
-> (GraphvizState -> GraphvizState -> Bool)
-> (GraphvizState -> GraphvizState -> Bool)
-> (GraphvizState -> GraphvizState -> GraphvizState)
-> (GraphvizState -> GraphvizState -> GraphvizState)
-> Ord GraphvizState
GraphvizState -> GraphvizState -> Bool
GraphvizState -> GraphvizState -> Ordering
GraphvizState -> GraphvizState -> GraphvizState
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
min :: GraphvizState -> GraphvizState -> GraphvizState
$cmin :: GraphvizState -> GraphvizState -> GraphvizState
max :: GraphvizState -> GraphvizState -> GraphvizState
$cmax :: GraphvizState -> GraphvizState -> GraphvizState
>= :: GraphvizState -> GraphvizState -> Bool
$c>= :: GraphvizState -> GraphvizState -> Bool
> :: GraphvizState -> GraphvizState -> Bool
$c> :: GraphvizState -> GraphvizState -> Bool
<= :: GraphvizState -> GraphvizState -> Bool
$c<= :: GraphvizState -> GraphvizState -> Bool
< :: GraphvizState -> GraphvizState -> Bool
$c< :: GraphvizState -> GraphvizState -> Bool
compare :: GraphvizState -> GraphvizState -> Ordering
$ccompare :: GraphvizState -> GraphvizState -> Ordering
$cp1Ord :: Eq GraphvizState
Ord, Int -> GraphvizState -> ShowS
[GraphvizState] -> ShowS
GraphvizState -> String
(Int -> GraphvizState -> ShowS)
-> (GraphvizState -> String)
-> ([GraphvizState] -> ShowS)
-> Show GraphvizState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GraphvizState] -> ShowS
$cshowList :: [GraphvizState] -> ShowS
show :: GraphvizState -> String
$cshow :: GraphvizState -> String
showsPrec :: Int -> GraphvizState -> ShowS
$cshowsPrec :: Int -> GraphvizState -> ShowS
Show, ReadPrec [GraphvizState]
ReadPrec GraphvizState
Int -> ReadS GraphvizState
ReadS [GraphvizState]
(Int -> ReadS GraphvizState)
-> ReadS [GraphvizState]
-> ReadPrec GraphvizState
-> ReadPrec [GraphvizState]
-> Read GraphvizState
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GraphvizState]
$creadListPrec :: ReadPrec [GraphvizState]
readPrec :: ReadPrec GraphvizState
$creadPrec :: ReadPrec GraphvizState
readList :: ReadS [GraphvizState]
$creadList :: ReadS [GraphvizState]
readsPrec :: Int -> ReadS GraphvizState
$creadsPrec :: Int -> ReadS GraphvizState
Read)
initialState :: GraphvizState
initialState :: GraphvizState
initialState = $WGS :: Bool
-> Bool
-> String
-> String
-> AttributeType
-> ColorScheme
-> ColorScheme
-> ColorScheme
-> ColorScheme
-> GraphvizState
GS { parseStrictly :: Bool
parseStrictly = Bool
True
, directedEdges :: Bool
directedEdges = Bool
True
, layerSep :: String
layerSep = String
defLayerSep
, layerListSep :: String
layerListSep = String
defLayerListSep
, attributeType :: AttributeType
attributeType = AttributeType
GraphAttribute
, graphColor :: ColorScheme
graphColor = ColorScheme
X11
, clusterColor :: ColorScheme
clusterColor = ColorScheme
X11
, nodeColor :: ColorScheme
nodeColor = ColorScheme
X11
, edgeColor :: ColorScheme
edgeColor = ColorScheme
X11
}
setDirectedness :: (GraphvizStateM m) => Bool -> m ()
setDirectedness :: Bool -> m ()
setDirectedness d :: Bool
d = (GraphvizState -> GraphvizState) -> m ()
forall (m :: * -> *).
GraphvizStateM m =>
(GraphvizState -> GraphvizState) -> m ()
modifyGS (\ gs :: GraphvizState
gs -> GraphvizState
gs { directedEdges :: Bool
directedEdges = Bool
d } )
getDirectedness :: (GraphvizStateM m) => m Bool
getDirectedness :: m Bool
getDirectedness = (GraphvizState -> Bool) -> m Bool
forall (m :: * -> *) a.
GraphvizStateM m =>
(GraphvizState -> a) -> m a
getsGS GraphvizState -> Bool
directedEdges
setAttributeType :: (GraphvizStateM m) => AttributeType -> m ()
setAttributeType :: AttributeType -> m ()
setAttributeType tp :: AttributeType
tp = (GraphvizState -> GraphvizState) -> m ()
forall (m :: * -> *).
GraphvizStateM m =>
(GraphvizState -> GraphvizState) -> m ()
modifyGS ((GraphvizState -> GraphvizState) -> m ())
-> (GraphvizState -> GraphvizState) -> m ()
forall a b. (a -> b) -> a -> b
$ \ gs :: GraphvizState
gs -> GraphvizState
gs { attributeType :: AttributeType
attributeType = AttributeType
tp }
getAttributeType :: (GraphvizStateM m) => m AttributeType
getAttributeType :: m AttributeType
getAttributeType = (GraphvizState -> AttributeType) -> m AttributeType
forall (m :: * -> *) a.
GraphvizStateM m =>
(GraphvizState -> a) -> m a
getsGS GraphvizState -> AttributeType
attributeType
setLayerSep :: (GraphvizStateM m) => [Char] -> m ()
setLayerSep :: String -> m ()
setLayerSep sep :: String
sep = (GraphvizState -> GraphvizState) -> m ()
forall (m :: * -> *).
GraphvizStateM m =>
(GraphvizState -> GraphvizState) -> m ()
modifyGS (\ gs :: GraphvizState
gs -> GraphvizState
gs { layerSep :: String
layerSep = String
sep } )
getLayerSep :: (GraphvizStateM m) => m [Char]
getLayerSep :: m String
getLayerSep = (GraphvizState -> String) -> m String
forall (m :: * -> *) a.
GraphvizStateM m =>
(GraphvizState -> a) -> m a
getsGS GraphvizState -> String
layerSep
setLayerListSep :: (GraphvizStateM m) => [Char] -> m ()
setLayerListSep :: String -> m ()
setLayerListSep sep :: String
sep = (GraphvizState -> GraphvizState) -> m ()
forall (m :: * -> *).
GraphvizStateM m =>
(GraphvizState -> GraphvizState) -> m ()
modifyGS (\ gs :: GraphvizState
gs -> GraphvizState
gs { layerListSep :: String
layerListSep = String
sep } )
getLayerListSep :: (GraphvizStateM m) => m [Char]
getLayerListSep :: m String
getLayerListSep = (GraphvizState -> String) -> m String
forall (m :: * -> *) a.
GraphvizStateM m =>
(GraphvizState -> a) -> m a
getsGS GraphvizState -> String
layerListSep
setColorScheme :: (GraphvizStateM m) => ColorScheme -> m ()
setColorScheme :: ColorScheme -> m ()
setColorScheme cs :: ColorScheme
cs = do AttributeType
tp <- (GraphvizState -> AttributeType) -> m AttributeType
forall (m :: * -> *) a.
GraphvizStateM m =>
(GraphvizState -> a) -> m a
getsGS GraphvizState -> AttributeType
attributeType
(GraphvizState -> GraphvizState) -> m ()
forall (m :: * -> *).
GraphvizStateM m =>
(GraphvizState -> GraphvizState) -> m ()
modifyGS ((GraphvizState -> GraphvizState) -> m ())
-> (GraphvizState -> GraphvizState) -> m ()
forall a b. (a -> b) -> a -> b
$ \gs :: GraphvizState
gs -> case AttributeType
tp of
GraphAttribute -> GraphvizState
gs { graphColor :: ColorScheme
graphColor = ColorScheme
cs }
SubGraphAttribute -> GraphvizState
gs { graphColor :: ColorScheme
graphColor = ColorScheme
cs }
ClusterAttribute -> GraphvizState
gs { clusterColor :: ColorScheme
clusterColor = ColorScheme
cs }
NodeAttribute -> GraphvizState
gs { nodeColor :: ColorScheme
nodeColor = ColorScheme
cs }
EdgeAttribute -> GraphvizState
gs { edgeColor :: ColorScheme
edgeColor = ColorScheme
cs }
getColorScheme :: (GraphvizStateM m) => m ColorScheme
getColorScheme :: m ColorScheme
getColorScheme = do AttributeType
tp <- (GraphvizState -> AttributeType) -> m AttributeType
forall (m :: * -> *) a.
GraphvizStateM m =>
(GraphvizState -> a) -> m a
getsGS GraphvizState -> AttributeType
attributeType
(GraphvizState -> ColorScheme) -> m ColorScheme
forall (m :: * -> *) a.
GraphvizStateM m =>
(GraphvizState -> a) -> m a
getsGS ((GraphvizState -> ColorScheme) -> m ColorScheme)
-> (GraphvizState -> ColorScheme) -> m ColorScheme
forall a b. (a -> b) -> a -> b
$ case AttributeType
tp of
GraphAttribute -> GraphvizState -> ColorScheme
graphColor
SubGraphAttribute -> GraphvizState -> ColorScheme
graphColor
ClusterAttribute -> GraphvizState -> ColorScheme
clusterColor
NodeAttribute -> GraphvizState -> ColorScheme
nodeColor
EdgeAttribute -> GraphvizState -> ColorScheme
edgeColor
defLayerSep :: [Char]
defLayerSep :: String
defLayerSep = [' ', ':', '\t']
defLayerListSep :: [Char]
defLayerListSep :: String
defLayerListSep = [',']