{-# 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 = forall s. (s -> s) -> Parser s ()
stUpdate
getsGS :: forall a. (GraphvizState -> a) -> Parser GraphvizState a
getsGS = forall s a. (s -> a) -> Parser s a
stQuery
data AttributeType = GraphAttribute
| SubGraphAttribute
| ClusterAttribute
| NodeAttribute
| EdgeAttribute
deriving (AttributeType -> AttributeType -> Bool
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
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
Ord, Int -> AttributeType -> ShowS
[AttributeType] -> ShowS
AttributeType -> String
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]
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
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
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
Ord, Int -> GraphvizState -> ShowS
[GraphvizState] -> ShowS
GraphvizState -> String
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]
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 = 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 :: forall (m :: * -> *). GraphvizStateM m => Bool -> m ()
setDirectedness Bool
d = forall (m :: * -> *).
GraphvizStateM m =>
(GraphvizState -> GraphvizState) -> m ()
modifyGS (\ GraphvizState
gs -> GraphvizState
gs { directedEdges :: Bool
directedEdges = Bool
d } )
getDirectedness :: (GraphvizStateM m) => m Bool
getDirectedness :: forall (m :: * -> *). GraphvizStateM m => m Bool
getDirectedness = forall (m :: * -> *) a.
GraphvizStateM m =>
(GraphvizState -> a) -> m a
getsGS GraphvizState -> Bool
directedEdges
setAttributeType :: (GraphvizStateM m) => AttributeType -> m ()
setAttributeType :: forall (m :: * -> *). GraphvizStateM m => AttributeType -> m ()
setAttributeType AttributeType
tp = forall (m :: * -> *).
GraphvizStateM m =>
(GraphvizState -> GraphvizState) -> m ()
modifyGS forall a b. (a -> b) -> a -> b
$ \ GraphvizState
gs -> GraphvizState
gs { attributeType :: AttributeType
attributeType = AttributeType
tp }
getAttributeType :: (GraphvizStateM m) => m AttributeType
getAttributeType :: forall (m :: * -> *). GraphvizStateM m => m AttributeType
getAttributeType = forall (m :: * -> *) a.
GraphvizStateM m =>
(GraphvizState -> a) -> m a
getsGS GraphvizState -> AttributeType
attributeType
setLayerSep :: (GraphvizStateM m) => [Char] -> m ()
setLayerSep :: forall (m :: * -> *). GraphvizStateM m => String -> m ()
setLayerSep String
sep = forall (m :: * -> *).
GraphvizStateM m =>
(GraphvizState -> GraphvizState) -> m ()
modifyGS (\ GraphvizState
gs -> GraphvizState
gs { layerSep :: String
layerSep = String
sep } )
getLayerSep :: (GraphvizStateM m) => m [Char]
getLayerSep :: forall (m :: * -> *). GraphvizStateM m => m String
getLayerSep = forall (m :: * -> *) a.
GraphvizStateM m =>
(GraphvizState -> a) -> m a
getsGS GraphvizState -> String
layerSep
setLayerListSep :: (GraphvizStateM m) => [Char] -> m ()
setLayerListSep :: forall (m :: * -> *). GraphvizStateM m => String -> m ()
setLayerListSep String
sep = forall (m :: * -> *).
GraphvizStateM m =>
(GraphvizState -> GraphvizState) -> m ()
modifyGS (\ GraphvizState
gs -> GraphvizState
gs { layerListSep :: String
layerListSep = String
sep } )
getLayerListSep :: (GraphvizStateM m) => m [Char]
getLayerListSep :: forall (m :: * -> *). GraphvizStateM m => m String
getLayerListSep = forall (m :: * -> *) a.
GraphvizStateM m =>
(GraphvizState -> a) -> m a
getsGS GraphvizState -> String
layerListSep
setColorScheme :: (GraphvizStateM m) => ColorScheme -> m ()
setColorScheme :: forall (m :: * -> *). GraphvizStateM m => ColorScheme -> m ()
setColorScheme ColorScheme
cs = do AttributeType
tp <- forall (m :: * -> *) a.
GraphvizStateM m =>
(GraphvizState -> a) -> m a
getsGS GraphvizState -> AttributeType
attributeType
forall (m :: * -> *).
GraphvizStateM m =>
(GraphvizState -> GraphvizState) -> m ()
modifyGS forall a b. (a -> b) -> a -> b
$ \GraphvizState
gs -> case AttributeType
tp of
AttributeType
GraphAttribute -> GraphvizState
gs { graphColor :: ColorScheme
graphColor = ColorScheme
cs }
AttributeType
SubGraphAttribute -> GraphvizState
gs { graphColor :: ColorScheme
graphColor = ColorScheme
cs }
AttributeType
ClusterAttribute -> GraphvizState
gs { clusterColor :: ColorScheme
clusterColor = ColorScheme
cs }
AttributeType
NodeAttribute -> GraphvizState
gs { nodeColor :: ColorScheme
nodeColor = ColorScheme
cs }
AttributeType
EdgeAttribute -> GraphvizState
gs { edgeColor :: ColorScheme
edgeColor = ColorScheme
cs }
getColorScheme :: (GraphvizStateM m) => m ColorScheme
getColorScheme :: forall (m :: * -> *). GraphvizStateM m => m ColorScheme
getColorScheme = do AttributeType
tp <- forall (m :: * -> *) a.
GraphvizStateM m =>
(GraphvizState -> a) -> m a
getsGS GraphvizState -> AttributeType
attributeType
forall (m :: * -> *) a.
GraphvizStateM m =>
(GraphvizState -> a) -> m a
getsGS forall a b. (a -> b) -> a -> b
$ case AttributeType
tp of
AttributeType
GraphAttribute -> GraphvizState -> ColorScheme
graphColor
AttributeType
SubGraphAttribute -> GraphvizState -> ColorScheme
graphColor
AttributeType
ClusterAttribute -> GraphvizState -> ColorScheme
clusterColor
AttributeType
NodeAttribute -> GraphvizState -> ColorScheme
nodeColor
AttributeType
EdgeAttribute -> GraphvizState -> ColorScheme
edgeColor
defLayerSep :: [Char]
defLayerSep :: String
defLayerSep = [Char
' ', Char
':', Char
'\t']
defLayerListSep :: [Char]
defLayerListSep :: String
defLayerListSep = [Char
',']