    {-# LANGUAGE CPP, FlexibleInstances, GeneralizedNewtypeDeriving,
                 OverloadedStrings #-}
    {-# OPTIONS_GHC -fno-warn-orphans #-}

    {- |
       Module      : Data.GraphViz.Printing
       Description : Helper functions for converting to Dot format.
       Copyright   : (c) Ivan Lazar Miljenovic
       License     : 3-Clause BSD-style
       Maintainer  : Ivan.Miljenovic@gmail.com

       This module defines simple helper functions for use with
       "Text.PrettyPrint".  It also re-exports all the pretty-printing
       combinators from that module.

       Note that the 'PrintDot' instances for 'Bool', etc. match those
       specified for use with Graphviz.

       You should only be using this module if you are writing custom node
       types for use with "Data.GraphViz.Types".  For actual printing of
       code, use @'Data.GraphViz.Types.printDotGraph'@ (which produces a
       'Text' value).

       The Dot language specification specifies that any identifier is in
       one of four forms:

           * Any string of alphabetic ([a-zA-Z\\200-\\377]) characters,
             underscores ('_') or digits ([0-9]), not beginning with a
             digit;

           * a number [-]?(.[0-9]+ | [0-9]+(.[0-9]*)? );

           * any double-quoted string (\"...\") possibly containing
             escaped quotes (\\\");

           * an HTML string (\<...\>).

       (Note that the first restriction is referring to a byte-by-byte
       comparison using octal values; when using UTF-8 this corresponds to
       all characters @c@ where @ord c >= 128@.)

       Due to these restrictions, you should only use 'text' when you are
       sure that the 'Text' in question is static and quotes are
       definitely needed/unneeded; it is better to use the 'Text'
       instance for 'PrintDot'.  For more information, see the
       specification page:
          <http://graphviz.org/doc/info/lang.html>
    -}
    module Data.GraphViz.Printing
        ( module Text.PrettyPrint.Leijen.Text.Monadic
        , DotCode
        , DotCodeM
        , runDotCode
        , renderDot -- Exported for Data.GraphViz.Types.Internal.Common.printSGID
        , PrintDot(..)
        , unqtText
        , dotText
        , printIt
        , addQuotes
        , unqtEscaped
        , printEscaped
        , wrap
        , commaDel
        , printField
        , angled
        , fslash
        , printColorScheme
        ) where

    import Data.GraphViz.Internal.State
    import Data.GraphViz.Internal.Util
    -- To avoid orphan instances and cyclic imports
    import Data.GraphViz.Attributes.ColorScheme

    -- Only implicitly import and re-export combinators.
    import qualified Data.Text                            as ST
    import           Data.Text.Lazy                       (Text)
    import qualified Data.Text.Lazy                       as T
    import           Text.PrettyPrint.Leijen.Text.Monadic hiding (Pretty(..),
                                                           SimpleDoc(..), bool,
                                                           displayIO, displayT,
                                                           hPutDoc, putDoc,
                                                           renderCompact,
                                                           renderPretty, string,
                                                           width, (<$>))
    import qualified Text.PrettyPrint.Leijen.Text.Monadic as PP

    import           Control.Monad       (ap, when)
    import           Control.Monad.State (MonadState, State, evalState, gets,
                                          modify)
    import           Data.Char           (toLower)
    import qualified Data.Set            as Set
    import           Data.String         (IsString(..))
    import           Data.Version        (Version(..))
    import           Data.Word           (Word64, Word32, Word16, Word8)

    #if !(MIN_VERSION_base (4,11,0))

    #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(..))
    #else
    import Data.Monoid ((<>))
    #endif

    #endif

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

    -- | A type alias to indicate what is being produced.
    newtype DotCodeM a = DotCodeM { forall a. DotCodeM a -> State GraphvizState a
    getDotCode :: State GraphvizState a }
      deriving ((forall a b. (a -> b) -> DotCodeM a -> DotCodeM b)
    -> (forall a b. a -> DotCodeM b -> DotCodeM a) -> Functor DotCodeM
    forall a b. a -> DotCodeM b -> DotCodeM a
    forall a b. (a -> b) -> DotCodeM a -> DotCodeM b
    forall (f :: * -> *).
    (forall a b. (a -> b) -> f a -> f b)
    -> (forall a b. a -> f b -> f a) -> Functor f
    $cfmap :: forall a b. (a -> b) -> DotCodeM a -> DotCodeM b
    fmap :: forall a b. (a -> b) -> DotCodeM a -> DotCodeM b
    $c<$ :: forall a b. a -> DotCodeM b -> DotCodeM a
    <$ :: forall a b. a -> DotCodeM b -> DotCodeM a
    Functor, Functor DotCodeM
    Functor DotCodeM =>
    (forall a. a -> DotCodeM a)
    -> (forall a b. DotCodeM (a -> b) -> DotCodeM a -> DotCodeM b)
    -> (forall a b c.
        (a -> b -> c) -> DotCodeM a -> DotCodeM b -> DotCodeM c)
    -> (forall a b. DotCodeM a -> DotCodeM b -> DotCodeM b)
    -> (forall a b. DotCodeM a -> DotCodeM b -> DotCodeM a)
    -> Applicative DotCodeM
    forall a. a -> DotCodeM a
    forall a b. DotCodeM a -> DotCodeM b -> DotCodeM a
    forall a b. DotCodeM a -> DotCodeM b -> DotCodeM b
    forall a b. DotCodeM (a -> b) -> DotCodeM a -> DotCodeM b
    forall a b c.
    (a -> b -> c) -> DotCodeM a -> DotCodeM b -> DotCodeM c
    forall (f :: * -> *).
    Functor f =>
    (forall a. a -> f a)
    -> (forall a b. f (a -> b) -> f a -> f b)
    -> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
    -> (forall a b. f a -> f b -> f b)
    -> (forall a b. f a -> f b -> f a)
    -> Applicative f
    $cpure :: forall a. a -> DotCodeM a
    pure :: forall a. a -> DotCodeM a
    $c<*> :: forall a b. DotCodeM (a -> b) -> DotCodeM a -> DotCodeM b
    <*> :: forall a b. DotCodeM (a -> b) -> DotCodeM a -> DotCodeM b
    $cliftA2 :: forall a b c.
    (a -> b -> c) -> DotCodeM a -> DotCodeM b -> DotCodeM c
    liftA2 :: forall a b c.
    (a -> b -> c) -> DotCodeM a -> DotCodeM b -> DotCodeM c
    $c*> :: forall a b. DotCodeM a -> DotCodeM b -> DotCodeM b
    *> :: forall a b. DotCodeM a -> DotCodeM b -> DotCodeM b
    $c<* :: forall a b. DotCodeM a -> DotCodeM b -> DotCodeM a
    <* :: forall a b. DotCodeM a -> DotCodeM b -> DotCodeM a
    Applicative, Applicative DotCodeM
    Applicative DotCodeM =>
    (forall a b. DotCodeM a -> (a -> DotCodeM b) -> DotCodeM b)
    -> (forall a b. DotCodeM a -> DotCodeM b -> DotCodeM b)
    -> (forall a. a -> DotCodeM a)
    -> Monad DotCodeM
    forall a. a -> DotCodeM a
    forall a b. DotCodeM a -> DotCodeM b -> DotCodeM b
    forall a b. DotCodeM a -> (a -> DotCodeM b) -> DotCodeM b
    forall (m :: * -> *).
    Applicative m =>
    (forall a b. m a -> (a -> m b) -> m b)
    -> (forall a b. m a -> m b -> m b)
    -> (forall a. a -> m a)
    -> Monad m
    $c>>= :: forall a b. DotCodeM a -> (a -> DotCodeM b) -> DotCodeM b
    >>= :: forall a b. DotCodeM a -> (a -> DotCodeM b) -> DotCodeM b
    $c>> :: forall a b. DotCodeM a -> DotCodeM b -> DotCodeM b
    >> :: forall a b. DotCodeM a -> DotCodeM b -> DotCodeM b
    $creturn :: forall a. a -> DotCodeM a
    return :: forall a. a -> DotCodeM a
    Monad, MonadState GraphvizState)

    type DotCode = DotCodeM Doc

    runDotCode :: DotCode -> Doc
    runDotCode :: DotCode -> Doc
    runDotCode = (State GraphvizState Doc -> GraphvizState -> Doc
    forall s a. State s a -> s -> a
    `evalState` GraphvizState
    initialState) (State GraphvizState Doc -> Doc)
    -> (DotCode -> State GraphvizState Doc) -> DotCode -> Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . DotCode -> State GraphvizState Doc
    forall a. DotCodeM a -> State GraphvizState a
    getDotCode

    instance Show DotCode where
      showsPrec :: Int -> DotCode -> ShowS
    showsPrec Int
    d = Int -> Text -> ShowS
    forall a. Show a => Int -> a -> ShowS
    showsPrec Int
    d (Text -> ShowS) -> (DotCode -> Text) -> DotCode -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . DotCode -> Text
    renderDot

    instance IsString DotCode where
      fromString :: String -> DotCode
    fromString = Text -> DotCode
    forall (m :: * -> *). Applicative m => Text -> m Doc
    PP.string (Text -> DotCode) -> (String -> Text) -> String -> DotCode
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Text
    forall a. IsString a => String -> a
    fromString

    #if MIN_VERSION_base (4,9,0)
    instance Semigroup DotCode where
      <> :: DotCode -> DotCode -> DotCode
    (<>) = DotCode -> DotCode -> DotCode
    forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
    beside

    instance Monoid DotCode where
      mempty :: DotCode
    mempty  = DotCode
    forall (m :: * -> *). Applicative m => m Doc
    empty
      mappend :: DotCode -> DotCode -> DotCode
    mappend = DotCode -> DotCode -> DotCode
    forall a. Semigroup a => a -> a -> a
    (<>)
    #else
    instance Monoid DotCode where
      mempty  = empty
      mappend = beside
    #endif

    instance GraphvizStateM DotCodeM where
      modifyGS :: (GraphvizState -> GraphvizState) -> DotCodeM ()
    modifyGS = (GraphvizState -> GraphvizState) -> DotCodeM ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify

      getsGS :: forall a. (GraphvizState -> a) -> DotCodeM a
    getsGS = (GraphvizState -> a) -> DotCodeM a
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets

    -- | Correctly render Graphviz output.
    renderDot :: DotCode -> Text
    renderDot :: DotCode -> Text
    renderDot = SimpleDoc -> Text
    PP.displayT (SimpleDoc -> Text) -> (DotCode -> SimpleDoc) -> DotCode -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Float -> Int -> Doc -> SimpleDoc
    PP.renderPretty Float
    0.4 Int
    80
                (Doc -> SimpleDoc) -> (DotCode -> Doc) -> DotCode -> SimpleDoc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . DotCode -> Doc
    runDotCode

    -- | A class used to correctly print parts of the Graphviz Dot language.
    --   Minimal implementation is 'unqtDot'.
    class PrintDot a where
      -- | The unquoted representation, for use when composing values to
      --   produce a larger printing value.
      unqtDot :: a -> DotCode

      -- | The actual quoted representation; this should be quoted if it
      --   contains characters not permitted a plain ID String, a number
      --   or it is not an HTML string.  Defaults to 'unqtDot'.
      toDot :: a -> DotCode
      toDot = a -> DotCode
    forall a. PrintDot a => a -> DotCode
    unqtDot

      -- | The correct way of representing a list of this value when
      --   printed; not all Dot values require this to be implemented.
      --   Defaults to Haskell-like list representation.
      unqtListToDot :: [a] -> DotCode
      unqtListToDot = DotCodeM [Doc] -> DotCode
    forall (m :: * -> *). Functor m => m [Doc] -> m Doc
    list (DotCodeM [Doc] -> DotCode)
    -> ([a] -> DotCodeM [Doc]) -> [a] -> DotCode
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (a -> DotCode) -> [a] -> DotCodeM [Doc]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM a -> DotCode
    forall a. PrintDot a => a -> DotCode
    unqtDot

      -- | The quoted form of 'unqtListToDot'; defaults to wrapping double
      --   quotes around the result of 'unqtListToDot' (since the default
      --   implementation has characters that must be quoted).
      listToDot :: [a] -> DotCode
      listToDot = DotCode -> DotCode
    forall (m :: * -> *). Functor m => m Doc -> m Doc
    dquotes (DotCode -> DotCode) -> ([a] -> DotCode) -> [a] -> DotCode
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [a] -> DotCode
    forall a. PrintDot a => [a] -> DotCode
    unqtListToDot

    -- | Convert to DotCode; note that this has no indentation, as we can
    --   only have one of indentation and (possibly) infinite line lengths.
    printIt :: (PrintDot a) => a -> Text
    printIt :: forall a. PrintDot a => a -> Text
    printIt = DotCode -> Text
    renderDot (DotCode -> Text) -> (a -> DotCode) -> a -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> DotCode
    forall a. PrintDot a => a -> DotCode
    toDot

    instance PrintDot Int where
      unqtDot :: Int -> DotCode
    unqtDot = Int -> DotCode
    forall (m :: * -> *). Applicative m => Int -> m Doc
    int

    instance PrintDot Integer where
      unqtDot :: Integer -> DotCode
    unqtDot = Text -> DotCode
    forall (m :: * -> *). Applicative m => Text -> m Doc
    text (Text -> DotCode) -> (Integer -> Text) -> Integer -> DotCode
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Text
    T.pack (String -> Text) -> (Integer -> String) -> Integer -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Integer -> String
    forall a. Show a => a -> String
    show

    instance PrintDot Word8 where
      unqtDot :: Word8 -> DotCode
    unqtDot = Int -> DotCode
    forall (m :: * -> *). Applicative m => Int -> m Doc
    int (Int -> DotCode) -> (Word8 -> Int) -> Word8 -> DotCode
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Word8 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral

    instance PrintDot Word16 where
      unqtDot :: Word16 -> DotCode
    unqtDot = Int -> DotCode
    forall (m :: * -> *). Applicative m => Int -> m Doc
    int (Int -> DotCode) -> (Word16 -> Int) -> Word16 -> DotCode
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Word16 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral

    instance PrintDot Word32 where
      unqtDot :: Word32 -> DotCode
    unqtDot = Integer -> DotCode
    forall a. PrintDot a => a -> DotCode
    unqtDot (Integer -> DotCode) -> (Word32 -> Integer) -> Word32 -> DotCode
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Word32 -> Integer
    forall a. Integral a => a -> Integer
    toInteger

    instance PrintDot Word64 where
      unqtDot :: Word64 -> DotCode
    unqtDot = Integer -> DotCode
    forall a. PrintDot a => a -> DotCode
    unqtDot (Integer -> DotCode) -> (Word64 -> Integer) -> Word64 -> DotCode
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Word64 -> Integer
    forall a. Integral a => a -> Integer
    toInteger

    instance PrintDot Double where
      -- If it's an "integral" double, then print as an integer.  This
      -- seems to match how Graphviz apps use Dot.
      unqtDot :: Double -> DotCode
    unqtDot Double
    d = if Double
    d Double -> Double -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int -> Double
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    di
                  then Int -> DotCode
    forall (m :: * -> *). Applicative m => Int -> m Doc
    int Int
    di
                  else Double -> DotCode
    forall (m :: * -> *). Applicative m => Double -> m Doc
    double Double
    d
          where
            di :: Int
    di = Double -> Int
    forall b. Integral b => Double -> b
    forall a b. (RealFrac a, Integral b) => a -> b
    round Double
    d

      toDot :: Double -> DotCode
    toDot Double
    d = if (Char -> Bool) -> String -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    (==) Char
    'e' (Char -> Bool) -> (Char -> Char) -> Char -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Char -> Char
    toLower) (String -> Bool) -> String -> Bool
    forall a b. (a -> b) -> a -> b
    $ Double -> String
    forall a. Show a => a -> String
    show Double
    d
                then DotCode -> DotCode
    forall (m :: * -> *). Functor m => m Doc -> m Doc
    dquotes DotCode
    ud
                else DotCode
    ud
        where
          ud :: DotCode
    ud = Double -> DotCode
    forall a. PrintDot a => a -> DotCode
    unqtDot Double
    d

      unqtListToDot :: [Double] -> DotCode
    unqtListToDot = DotCodeM [Doc] -> DotCode
    forall (m :: * -> *). Functor m => m [Doc] -> m Doc
    hcat (DotCodeM [Doc] -> DotCode)
    -> ([Double] -> DotCodeM [Doc]) -> [Double] -> DotCode
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . DotCode -> DotCodeM [Doc] -> DotCodeM [Doc]
    forall (m :: * -> *). Applicative m => m Doc -> m [Doc] -> m [Doc]
    punctuate DotCode
    forall (m :: * -> *). Applicative m => m Doc
    colon (DotCodeM [Doc] -> DotCodeM [Doc])
    -> ([Double] -> DotCodeM [Doc]) -> [Double] -> DotCodeM [Doc]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Double -> DotCode) -> [Double] -> DotCodeM [Doc]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM Double -> DotCode
    forall a. PrintDot a => a -> DotCode
    unqtDot

      listToDot :: [Double] -> DotCode
    listToDot [Double
    d] = Double -> DotCode
    forall a. PrintDot a => a -> DotCode
    toDot Double
    d
      listToDot [Double]
    ds  = DotCode -> DotCode
    forall (m :: * -> *). Functor m => m Doc -> m Doc
    dquotes (DotCode -> DotCode) -> DotCode -> DotCode
    forall a b. (a -> b) -> a -> b
    $ [Double] -> DotCode
    forall a. PrintDot a => [a] -> DotCode
    unqtListToDot [Double]
    ds

    instance PrintDot Bool where
      unqtDot :: Bool -> DotCode
    unqtDot Bool
    True  = Text -> DotCode
    forall (m :: * -> *). Applicative m => Text -> m Doc
    text Text
    "true"
      unqtDot Bool
    False = Text -> DotCode
    forall (m :: * -> *). Applicative m => Text -> m Doc
    text Text
    "false"

    instance PrintDot Char where
      unqtDot :: Char -> DotCode
    unqtDot = Char -> DotCode
    forall (m :: * -> *). Applicative m => Char -> m Doc
    char

      toDot :: Char -> DotCode
    toDot = Char -> DotCode
    qtChar

      unqtListToDot :: String -> DotCode
    unqtListToDot = Text -> DotCode
    forall a. PrintDot a => a -> DotCode
    unqtDot (Text -> DotCode) -> (String -> Text) -> String -> DotCode
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Text
    T.pack

      listToDot :: String -> DotCode
    listToDot = Text -> DotCode
    forall a. PrintDot a => a -> DotCode
    toDot (Text -> DotCode) -> (String -> Text) -> String -> DotCode
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Text
    T.pack

    -- | Ignores 'versionTags' and assumes 'not . null . versionBranch'
    --   (usually you want 'length . versionBranch == 2').
    instance PrintDot Version where
      unqtDot :: Version -> DotCode
    unqtDot = DotCodeM [Doc] -> DotCode
    forall (m :: * -> *). Functor m => m [Doc] -> m Doc
    hcat (DotCodeM [Doc] -> DotCode)
    -> (Version -> DotCodeM [Doc]) -> Version -> DotCode
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . DotCode -> DotCodeM [Doc] -> DotCodeM [Doc]
    forall (m :: * -> *). Applicative m => m Doc -> m [Doc] -> m [Doc]
    punctuate DotCode
    forall (m :: * -> *). Applicative m => m Doc
    dot (DotCodeM [Doc] -> DotCodeM [Doc])
    -> (Version -> DotCodeM [Doc]) -> Version -> DotCodeM [Doc]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Int -> DotCode) -> [Int] -> DotCodeM [Doc]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM Int -> DotCode
    forall (m :: * -> *). Applicative m => Int -> m Doc
    int ([Int] -> DotCodeM [Doc])
    -> (Version -> [Int]) -> Version -> DotCodeM [Doc]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Version -> [Int]
    versionBranch

      toDot :: Version -> DotCode
    toDot Version
    v = (DotCode -> DotCode)
    -> (DotCode -> DotCode) -> Bool -> DotCode -> DotCode
    forall a. a -> a -> Bool -> a
    bool DotCode -> DotCode
    forall a. a -> a
    id DotCode -> DotCode
    forall (m :: * -> *). Functor m => m Doc -> m Doc
    dquotes (Bool -> Bool
    not (Bool -> Bool) -> (Version -> Bool) -> Version -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Int] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null ([Int] -> Bool) -> (Version -> [Int]) -> Version -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> [Int] -> [Int]
    forall a. Int -> [a] -> [a]
    drop Int
    2 ([Int] -> [Int]) -> (Version -> [Int]) -> Version -> [Int]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Version -> [Int]
    versionBranch (Version -> Bool) -> Version -> Bool
    forall a b. (a -> b) -> a -> b
    $ Version
    v)
                (DotCode -> DotCode) -> DotCode -> DotCode
    forall a b. (a -> b) -> a -> b
    $ Version -> DotCode
    forall a. PrintDot a => a -> DotCode
    unqtDot Version
    v

    instance PrintDot Text where
      unqtDot :: Text -> DotCode
    unqtDot = Text -> DotCode
    unqtString

      toDot :: Text -> DotCode
    toDot = Text -> DotCode
    qtString

    instance PrintDot ST.Text where
      unqtDot :: Text -> DotCode
    unqtDot = Text -> DotCode
    forall a. PrintDot a => a -> DotCode
    unqtDot (Text -> DotCode) -> (Text -> Text) -> Text -> DotCode
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> Text
    T.fromStrict

      toDot :: Text -> DotCode
    toDot = Text -> DotCode
    qtString (Text -> DotCode) -> (Text -> Text) -> Text -> DotCode
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> Text
    T.fromStrict

    -- | For use with @OverloadedStrings@ to avoid ambiguous type variable errors.
    unqtText :: Text -> DotCode
    unqtText :: Text -> DotCode
    unqtText = Text -> DotCode
    forall a. PrintDot a => a -> DotCode
    unqtDot

    -- | For use with @OverloadedStrings@ to avoid ambiguous type variable errors.
    dotText :: Text -> DotCode
    dotText :: Text -> DotCode
    dotText = Text -> DotCode
    forall a. PrintDot a => a -> DotCode
    toDot

    -- | Check to see if this 'Char' needs to be quoted or not.
    qtChar :: Char -> DotCode
    qtChar :: Char -> DotCode
    qtChar Char
    c
      | Char -> Bool
    restIDString Char
    c = Char -> DotCode
    forall (m :: * -> *). Applicative m => Char -> m Doc
    char Char
    c -- Could be a number as well.
      | Bool
    otherwise      = DotCode -> DotCode
    forall (m :: * -> *). Functor m => m Doc -> m Doc
    dquotes (DotCode -> DotCode) -> DotCode -> DotCode
    forall a b. (a -> b) -> a -> b
    $ Char -> DotCode
    forall (m :: * -> *). Applicative m => Char -> m Doc
    char Char
    c

    needsQuotes :: Text -> Bool
    needsQuotes :: Text -> Bool
    needsQuotes Text
    str
      | Text -> Bool
    T.null Text
    str            = Bool
    True
      | Text -> Bool
    isKeyword Text
    str         = Bool
    True
      | Text -> Bool
    isIDString Text
    str        = Bool
    False
      | Bool -> Text -> Bool
    isNumString Bool
    False Text
    str = Bool
    False
      | Bool
    otherwise             = Bool
    True

    addQuotes :: Text -> DotCode -> DotCode
    addQuotes :: Text -> DotCode -> DotCode
    addQuotes = (DotCode -> DotCode)
    -> (DotCode -> DotCode) -> Bool -> DotCode -> DotCode
    forall a. a -> a -> Bool -> a
    bool DotCode -> DotCode
    forall a. a -> a
    id DotCode -> DotCode
    forall (m :: * -> *). Functor m => m Doc -> m Doc
    dquotes (Bool -> DotCode -> DotCode)
    -> (Text -> Bool) -> Text -> DotCode -> DotCode
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> Bool
    needsQuotes

    -- | Escape quotes in Strings that need them.
    unqtString     :: Text -> DotCode
    unqtString :: Text -> DotCode
    unqtString Text
    ""  = DotCode
    forall (m :: * -> *). Applicative m => m Doc
    empty
    unqtString Text
    str = String -> Text -> DotCode
    unqtEscaped [] Text
    str -- no quotes? no worries!

    -- | Escape quotes and quote Texts that need them (including keywords).
    qtString :: Text -> DotCode
    qtString :: Text -> DotCode
    qtString = String -> Text -> DotCode
    printEscaped []

    instance (PrintDot a) => PrintDot [a] where
      unqtDot :: [a] -> DotCode
    unqtDot = [a] -> DotCode
    forall a. PrintDot a => [a] -> DotCode
    unqtListToDot

      toDot :: [a] -> DotCode
    toDot = [a] -> DotCode
    forall a. PrintDot a => [a] -> DotCode
    listToDot

    wrap       :: DotCode -> DotCode -> DotCode -> DotCode
    wrap :: DotCode -> DotCode -> DotCode -> DotCode
    wrap DotCode
    b DotCode
    a DotCode
    d = DotCode
    b DotCode -> DotCode -> DotCode
    forall a. Semigroup a => a -> a -> a
    <> DotCode
    d DotCode -> DotCode -> DotCode
    forall a. Semigroup a => a -> a -> a
    <> DotCode
    a

    commaDel     :: (PrintDot a, PrintDot b) => a -> b -> DotCode
    commaDel :: forall a b. (PrintDot a, PrintDot b) => a -> b -> DotCode
    commaDel a
    a b
    b = a -> DotCode
    forall a. PrintDot a => a -> DotCode
    unqtDot a
    a DotCode -> DotCode -> DotCode
    forall a. Semigroup a => a -> a -> a
    <> DotCode
    forall (m :: * -> *). Applicative m => m Doc
    comma DotCode -> DotCode -> DotCode
    forall a. Semigroup a => a -> a -> a
    <> b -> DotCode
    forall a. PrintDot a => a -> DotCode
    unqtDot b
    b

    printField     :: (PrintDot a) => Text -> a -> DotCode
    printField :: forall a. PrintDot a => Text -> a -> DotCode
    printField Text
    f a
    v = Text -> DotCode
    forall (m :: * -> *). Applicative m => Text -> m Doc
    text Text
    f DotCode -> DotCode -> DotCode
    forall a. Semigroup a => a -> a -> a
    <> DotCode
    forall (m :: * -> *). Applicative m => m Doc
    equals DotCode -> DotCode -> DotCode
    forall a. Semigroup a => a -> a -> a
    <> a -> DotCode
    forall a. PrintDot a => a -> DotCode
    toDot a
    v

    -- | Escape the specified chars as well as @\"@.
    unqtEscaped    :: [Char] -> Text -> DotCode
    unqtEscaped :: String -> Text -> DotCode
    unqtEscaped String
    cs = Text -> DotCode
    forall (m :: * -> *). Applicative m => Text -> m Doc
    text (Text -> DotCode) -> (Text -> Text) -> Text -> DotCode
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Text -> Text
    addEscapes String
    cs

    -- | Escape the specified chars as well as @\"@ and then wrap the
    --   result in quotes.
    printEscaped        :: [Char] -> Text -> DotCode
    printEscaped :: String -> Text -> DotCode
    printEscaped String
    cs Text
    str = Text -> DotCode -> DotCode
    addQuotes Text
    str' (DotCode -> DotCode) -> DotCode -> DotCode
    forall a b. (a -> b) -> a -> b
    $ Text -> DotCode
    forall (m :: * -> *). Applicative m => Text -> m Doc
    text Text
    str'
      where
        str' :: Text
    str' = String -> Text -> Text
    addEscapes String
    cs Text
    str

    -- | Ensure the provided characters are all escaped.  Note that we
    --   cannot convert to 'DotCode' immediately because 'printEscaped'
    --   needs to pass the result from this to 'addQuotes' to determine if
    --   it needs to be quoted or not.
    addEscapes    :: [Char] -> Text -> Text
    addEscapes :: String -> Text -> Text
    addEscapes String
    cs = ((Char, Char) -> Text -> Text) -> Text -> [(Char, Char)] -> Text
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr (Char, Char) -> Text -> Text
    escape Text
    T.empty ([(Char, Char)] -> Text)
    -> (Text -> [(Char, Char)]) -> Text -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> [(Char, Char)]
    withNext
      where
        cs' :: Set Char
    cs' = String -> Set Char
    forall a. Ord a => [a] -> Set a
    Set.fromList (String -> Set Char) -> String -> Set Char
    forall a b. (a -> b) -> a -> b
    $ Char
    quote Char -> ShowS
    forall a. a -> [a] -> [a]
    : Char
    slash Char -> ShowS
    forall a. a -> [a] -> [a]
    : String
    cs
        slash :: Char
    slash = Char
    '\\'
        quote :: Char
    quote = Char
    '"'
        escape :: (Char, Char) -> Text -> Text
    escape (Char
    c,Char
    c') Text
    str
          | Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    slash Bool -> Bool -> Bool
    && Char
    c' Char -> Set Char -> Bool
    forall a. Ord a => a -> Set a -> Bool
    `Set.member` Set Char
    escLetters = Char
    c Char -> Text -> Text
    `T.cons` Text
    str
          | Char
    c Char -> Set Char -> Bool
    forall a. Ord a => a -> Set a -> Bool
    `Set.member` Set Char
    cs'                       = Char
    slash Char -> Text -> Text
    `T.cons` (Char
    c Char -> Text -> Text
    `T.cons` Text
    str)
          | Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '\n'                                = Char
    slash Char -> Text -> Text
    `T.cons` (Char
    'n' Char -> Text -> Text
    `T.cons` Text
    str)
          | Bool
    otherwise                                = Char
    c Char -> Text -> Text
    `T.cons` Text
    str

        -- When a slash precedes one of these characters, don't escape the slash.
        escLetters :: Set Char
    escLetters = String -> Set Char
    forall a. Ord a => [a] -> Set a
    Set.fromList [Char
    'N', Char
    'G', Char
    'E', Char
    'T', Char
    'H', Char
    'L', Char
    'n', Char
    'l', Char
    'r']

        -- Need to check subsequent characters when escaping slashes, but
        -- don't want to lose the last character when zipping, so append a space.
        withNext :: Text -> [(Char, Char)]
    withNext Text
    ""  = []
        withNext Text
    str = Text -> Text -> [(Char, Char)]
    T.zip (Text -> Text -> [(Char, Char)])
    -> (Text -> Text) -> Text -> [(Char, Char)]
    forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
    `ap` ((Text -> Char -> Text
    `T.snoc` Char
    ' ') (Text -> Text) -> (Text -> Text) -> Text -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . HasCallStack => Text -> Text
    Text -> Text
    T.tail) (Text -> [(Char, Char)]) -> Text -> [(Char, Char)]
    forall a b. (a -> b) -> a -> b
    $ Text
    str

    angled :: DotCode -> DotCode
    angled :: DotCode -> DotCode
    angled = DotCode -> DotCode -> DotCode -> DotCode
    wrap DotCode
    forall (m :: * -> *). Applicative m => m Doc
    langle DotCode
    forall (m :: * -> *). Applicative m => m Doc
    rangle

    fslash :: DotCode
    fslash :: DotCode
    fslash = Char -> DotCode
    forall (m :: * -> *). Applicative m => Char -> m Doc
    char Char
    '/'

    -- -----------------------------------------------------------------------------
    -- These instances are defined here to avoid cyclic imports and orphan instances

    instance PrintDot ColorScheme where
      unqtDot :: ColorScheme -> DotCode
    unqtDot = Bool -> ColorScheme -> DotCode
    printColorScheme Bool
    True

    printColorScheme        :: Bool -> ColorScheme -> DotCode
    printColorScheme :: Bool -> ColorScheme -> DotCode
    printColorScheme Bool
    scs ColorScheme
    cs = do Bool -> DotCodeM () -> DotCodeM ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when Bool
    scs (DotCodeM () -> DotCodeM ()) -> DotCodeM () -> DotCodeM ()
    forall a b. (a -> b) -> a -> b
    $ ColorScheme -> DotCodeM ()
    forall (m :: * -> *). GraphvizStateM m => ColorScheme -> m ()
    setColorScheme ColorScheme
    cs
                                 case ColorScheme
    cs of
                                   ColorScheme
    X11       -> Text -> DotCode
    unqtText Text
    "X11"
                                   ColorScheme
    SVG       -> Text -> DotCode
    unqtText Text
    "svg"
                                   Brewer BrewerScheme
    bs -> BrewerScheme -> DotCode
    forall a. PrintDot a => a -> DotCode
    unqtDot BrewerScheme
    bs

    instance PrintDot BrewerScheme where
      unqtDot :: BrewerScheme -> DotCode
    unqtDot (BScheme BrewerName
    n Word8
    l) = BrewerName -> DotCode
    forall a. PrintDot a => a -> DotCode
    unqtDot BrewerName
    n DotCode -> DotCode -> DotCode
    forall a. Semigroup a => a -> a -> a
    <> Word8 -> DotCode
    forall a. PrintDot a => a -> DotCode
    unqtDot Word8
    l

    instance PrintDot BrewerName where
      unqtDot :: BrewerName -> DotCode
    unqtDot BrewerName
    Accent   = Text -> DotCode
    unqtText Text
    "accent"
      unqtDot BrewerName
    Blues    = Text -> DotCode
    unqtText Text
    "blues"
      unqtDot BrewerName
    Brbg     = Text -> DotCode
    unqtText Text
    "brbg"
      unqtDot BrewerName
    Bugn     = Text -> DotCode
    unqtText Text
    "bugn"
      unqtDot BrewerName
    Bupu     = Text -> DotCode
    unqtText Text
    "bupu"
      unqtDot BrewerName
    Dark2    = Text -> DotCode
    unqtText Text
    "dark2"
      unqtDot BrewerName
    Gnbu     = Text -> DotCode
    unqtText Text
    "gnbu"
      unqtDot BrewerName
    Greens   = Text -> DotCode
    unqtText Text
    "greens"
      unqtDot BrewerName
    Greys    = Text -> DotCode
    unqtText Text
    "greys"
      unqtDot BrewerName
    Oranges  = Text -> DotCode
    unqtText Text
    "oranges"
      unqtDot BrewerName
    Orrd     = Text -> DotCode
    unqtText Text
    "orrd"
      unqtDot BrewerName
    Paired   = Text -> DotCode
    unqtText Text
    "paired"
      unqtDot BrewerName
    Pastel1  = Text -> DotCode
    unqtText Text
    "pastel1"
      unqtDot BrewerName
    Pastel2  = Text -> DotCode
    unqtText Text
    "pastel2"
      unqtDot BrewerName
    Piyg     = Text -> DotCode
    unqtText Text
    "piyg"
      unqtDot BrewerName
    Prgn     = Text -> DotCode
    unqtText Text
    "prgn"
      unqtDot BrewerName
    Pubu     = Text -> DotCode
    unqtText Text
    "pubu"
      unqtDot BrewerName
    Pubugn   = Text -> DotCode
    unqtText Text
    "pubugn"
      unqtDot BrewerName
    Puor     = Text -> DotCode
    unqtText Text
    "puor"
      unqtDot BrewerName
    Purd     = Text -> DotCode
    unqtText Text
    "purd"
      unqtDot BrewerName
    Purples  = Text -> DotCode
    unqtText Text
    "purples"
      unqtDot BrewerName
    Rdbu     = Text -> DotCode
    unqtText Text
    "rdbu"
      unqtDot BrewerName
    Rdgy     = Text -> DotCode
    unqtText Text
    "rdgy"
      unqtDot BrewerName
    Rdpu     = Text -> DotCode
    unqtText Text
    "rdpu"
      unqtDot BrewerName
    Rdylbu   = Text -> DotCode
    unqtText Text
    "rdylbu"
      unqtDot BrewerName
    Rdylgn   = Text -> DotCode
    unqtText Text
    "rdylgn"
      unqtDot BrewerName
    Reds     = Text -> DotCode
    unqtText Text
    "reds"
      unqtDot BrewerName
    Set1     = Text -> DotCode
    unqtText Text
    "set1"
      unqtDot BrewerName
    Set2     = Text -> DotCode
    unqtText Text
    "set2"
      unqtDot BrewerName
    Set3     = Text -> DotCode
    unqtText Text
    "set3"
      unqtDot BrewerName
    Spectral = Text -> DotCode
    unqtText Text
    "spectral"
      unqtDot BrewerName
    Ylgn     = Text -> DotCode
    unqtText Text
    "ylgn"
      unqtDot BrewerName
    Ylgnbu   = Text -> DotCode
    unqtText Text
    "ylgnbu"
      unqtDot BrewerName
    Ylorbr   = Text -> DotCode
    unqtText Text
    "ylorbr"
      unqtDot BrewerName
    Ylorrd   = Text -> DotCode
    unqtText Text
    "ylorrd"