    {-# OPTIONS_HADDOCK hide #-}
    {-# LANGUAGE FlexibleInstances #-}

    {- |
       Module      : Data.GraphViz.Internal.State
       Description : Printing and parsing state.
       Copyright   : (c) Ivan Lazar Miljenovic
       License     : 3-Clause BSD-style
       Maintainer  : Ivan.Miljenovic@gmail.com

       When printing and parsing Dot code, some items depend on values
       that are set earlier.
    -}
    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 :: forall a. (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
    $c== :: AttributeType -> AttributeType -> Bool
    == :: AttributeType -> AttributeType -> Bool
    $c/= :: AttributeType -> AttributeType -> Bool
    /= :: 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
    $ccompare :: AttributeType -> AttributeType -> Ordering
    compare :: AttributeType -> AttributeType -> Ordering
    $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
    >= :: AttributeType -> AttributeType -> Bool
    $cmax :: AttributeType -> AttributeType -> AttributeType
    max :: AttributeType -> AttributeType -> AttributeType
    $cmin :: AttributeType -> AttributeType -> AttributeType
    min :: AttributeType -> AttributeType -> 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
    $cshowsPrec :: Int -> AttributeType -> ShowS
    showsPrec :: Int -> AttributeType -> ShowS
    $cshow :: AttributeType -> String
    show :: AttributeType -> String
    $cshowList :: [AttributeType] -> ShowS
    showList :: [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
    $creadsPrec :: Int -> ReadS AttributeType
    readsPrec :: Int -> ReadS AttributeType
    $creadList :: ReadS [AttributeType]
    readList :: ReadS [AttributeType]
    $creadPrec :: ReadPrec AttributeType
    readPrec :: ReadPrec AttributeType
    $creadListPrec :: ReadPrec [AttributeType]
    readListPrec :: ReadPrec [AttributeType]
    Read)

    -- | Several aspects of Dot code are either global or mutable state.
    data GraphvizState = GS { GraphvizState -> Bool
    parseStrictly :: !Bool
                              -- ^ If 'False', allow fallbacks for
                              --   attributes that don't match known
                              --   specification when parsing.
                            , 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
    $c== :: GraphvizState -> GraphvizState -> Bool
    == :: GraphvizState -> GraphvizState -> Bool
    $c/= :: GraphvizState -> GraphvizState -> Bool
    /= :: 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
    $ccompare :: GraphvizState -> GraphvizState -> Ordering
    compare :: GraphvizState -> GraphvizState -> Ordering
    $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
    >= :: GraphvizState -> GraphvizState -> Bool
    $cmax :: GraphvizState -> GraphvizState -> GraphvizState
    max :: GraphvizState -> GraphvizState -> GraphvizState
    $cmin :: GraphvizState -> GraphvizState -> GraphvizState
    min :: GraphvizState -> GraphvizState -> 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
    $cshowsPrec :: Int -> GraphvizState -> ShowS
    showsPrec :: Int -> GraphvizState -> ShowS
    $cshow :: GraphvizState -> String
    show :: GraphvizState -> String
    $cshowList :: [GraphvizState] -> ShowS
    showList :: [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
    $creadsPrec :: Int -> ReadS GraphvizState
    readsPrec :: Int -> ReadS GraphvizState
    $creadList :: ReadS [GraphvizState]
    readList :: ReadS [GraphvizState]
    $creadPrec :: ReadPrec GraphvizState
    readPrec :: ReadPrec GraphvizState
    $creadListPrec :: ReadPrec [GraphvizState]
    readListPrec :: ReadPrec [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 = (GraphvizState -> GraphvizState) -> m ()
    forall (m :: * -> *).
    GraphvizStateM m =>
    (GraphvizState -> GraphvizState) -> m ()
    modifyGS (\ GraphvizState
    gs -> GraphvizState
    gs { directedEdges = d } )

    getDirectedness :: (GraphvizStateM m) => m Bool
    getDirectedness :: forall (m :: * -> *). GraphvizStateM m => m Bool
    getDirectedness = (GraphvizState -> Bool) -> m Bool
    forall a. (GraphvizState -> a) -> m a
    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 = (GraphvizState -> GraphvizState) -> m ()
    forall (m :: * -> *).
    GraphvizStateM m =>
    (GraphvizState -> GraphvizState) -> m ()
    modifyGS ((GraphvizState -> GraphvizState) -> m ())
    -> (GraphvizState -> GraphvizState) -> m ()
    forall a b. (a -> b) -> a -> b
    $ \ GraphvizState
    gs -> GraphvizState
    gs { attributeType = tp }

    getAttributeType :: (GraphvizStateM m) => m AttributeType
    getAttributeType :: forall (m :: * -> *). GraphvizStateM m => m AttributeType
    getAttributeType = (GraphvizState -> AttributeType) -> m AttributeType
    forall a. (GraphvizState -> a) -> m a
    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 = (GraphvizState -> GraphvizState) -> m ()
    forall (m :: * -> *).
    GraphvizStateM m =>
    (GraphvizState -> GraphvizState) -> m ()
    modifyGS (\ GraphvizState
    gs -> GraphvizState
    gs { layerSep = sep } )

    getLayerSep :: (GraphvizStateM m) => m [Char]
    getLayerSep :: forall (m :: * -> *). GraphvizStateM m => m String
    getLayerSep = (GraphvizState -> String) -> m String
    forall a. (GraphvizState -> a) -> m a
    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 = (GraphvizState -> GraphvizState) -> m ()
    forall (m :: * -> *).
    GraphvizStateM m =>
    (GraphvizState -> GraphvizState) -> m ()
    modifyGS (\ GraphvizState
    gs -> GraphvizState
    gs { layerListSep = sep } )

    getLayerListSep :: (GraphvizStateM m) => m [Char]
    getLayerListSep :: forall (m :: * -> *). GraphvizStateM m => m String
    getLayerListSep = (GraphvizState -> String) -> m String
    forall a. (GraphvizState -> a) -> m a
    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 tp <- (GraphvizState -> AttributeType) -> m AttributeType
    forall a. (GraphvizState -> a) -> m a
    forall (m :: * -> *) a.
    GraphvizStateM m =>
    (GraphvizState -> a) -> m a
    getsGS GraphvizState -> AttributeType
    attributeType
                           modifyGS $ \GraphvizState
    gs -> case AttributeType
    tp of
                                               AttributeType
    GraphAttribute    -> GraphvizState
    gs { graphColor   = cs }
                                                -- subgraphs don't have specified scheme
                                               AttributeType
    SubGraphAttribute -> GraphvizState
    gs { graphColor   = cs }
                                               AttributeType
    ClusterAttribute  -> GraphvizState
    gs { clusterColor = cs }
                                               AttributeType
    NodeAttribute     -> GraphvizState
    gs { nodeColor    = cs }
                                               AttributeType
    EdgeAttribute     -> GraphvizState
    gs { edgeColor    = cs }

    getColorScheme :: (GraphvizStateM m) => m ColorScheme
    getColorScheme :: forall (m :: * -> *). GraphvizStateM m => m ColorScheme
    getColorScheme = do tp <- (GraphvizState -> AttributeType) -> m AttributeType
    forall a. (GraphvizState -> a) -> m a
    forall (m :: * -> *) a.
    GraphvizStateM m =>
    (GraphvizState -> a) -> m a
    getsGS GraphvizState -> AttributeType
    attributeType
                        getsGS $ case tp of
                                   AttributeType
    GraphAttribute    -> GraphvizState -> ColorScheme
    graphColor
                                    -- subgraphs don't have specified scheme
                                   AttributeType
    SubGraphAttribute -> GraphvizState -> ColorScheme
    graphColor
                                   AttributeType
    ClusterAttribute  -> GraphvizState -> ColorScheme
    clusterColor
                                   AttributeType
    NodeAttribute     -> GraphvizState -> ColorScheme
    nodeColor
                                   AttributeType
    EdgeAttribute     -> GraphvizState -> ColorScheme
    edgeColor

    -- | The default separators for
    --   'Data.GraphViz.Attributes.Complete.LayerSep'.
    defLayerSep :: [Char]
    defLayerSep :: String
    defLayerSep = [Char
    ' ', Char
    ':', Char
    '\t']

    -- | The default separators for
    --   'Data.GraphViz.Attributes.Complete.LayerListSep'.
    defLayerListSep :: [Char]
    defLayerListSep :: String
    defLayerListSep = [Char
    ',']