{-# 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 -> 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
<$ :: forall a b. a -> DotCodeM b -> DotCodeM a
$c<$ :: forall a b. a -> DotCodeM b -> DotCodeM a
fmap :: forall a b. (a -> b) -> DotCodeM a -> DotCodeM b
$cfmap :: forall a b. (a -> b) -> DotCodeM a -> DotCodeM b
Functor, Functor 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
<* :: forall a b. DotCodeM a -> DotCodeM b -> DotCodeM a
$c<* :: forall a b. DotCodeM a -> DotCodeM b -> DotCodeM a
*> :: forall a b. DotCodeM a -> DotCodeM b -> DotCodeM b
$c*> :: forall a b. DotCodeM a -> DotCodeM b -> DotCodeM b
liftA2 :: forall a b c.
(a -> b -> c) -> DotCodeM a -> DotCodeM b -> DotCodeM c
$cliftA2 :: forall a b c.
(a -> b -> c) -> DotCodeM a -> DotCodeM b -> DotCodeM c
<*> :: forall a b. DotCodeM (a -> b) -> DotCodeM a -> DotCodeM b
$c<*> :: forall a b. DotCodeM (a -> b) -> DotCodeM a -> DotCodeM b
pure :: forall a. a -> DotCodeM a
$cpure :: forall a. a -> DotCodeM a
Applicative, Applicative 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
return :: forall a. a -> DotCodeM a
$creturn :: forall a. a -> DotCodeM a
>> :: forall a b. DotCodeM a -> DotCodeM b -> DotCodeM b
$c>> :: forall a b. DotCodeM a -> DotCodeM b -> DotCodeM b
>>= :: forall a b. DotCodeM a -> (a -> DotCodeM b) -> DotCodeM b
$c>>= :: forall a b. DotCodeM a -> (a -> DotCodeM b) -> DotCodeM b
Monad, MonadState GraphvizState)

type DotCode = DotCodeM Doc

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

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

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

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

instance Monoid DotCode where
  mempty :: DotCode
mempty  = forall (m :: * -> *). Applicative m => m Doc
empty
  mappend :: DotCode -> DotCode -> DotCode
mappend = 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 = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify

  getsGS :: forall a. (GraphvizState -> a) -> DotCodeM a
getsGS = 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Int -> Doc -> SimpleDoc
PP.renderPretty Float
0.4 Int
80
            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 = 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 = forall (m :: * -> *). Functor m => m [Doc] -> m Doc
list forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM 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 = forall (m :: * -> *). Functor m => m Doc -> m Doc
dquotes forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. PrintDot a => a -> DotCode
toDot

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

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

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

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

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

instance PrintDot Word64 where
  unqtDot :: Word64 -> DotCode
unqtDot = forall a. PrintDot a => a -> DotCode
unqtDot forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 forall a. Eq a => a -> a -> Bool
== forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
di
              then forall (m :: * -> *). Applicative m => Int -> m Doc
int Int
di
              else forall (m :: * -> *). Applicative m => Double -> m Doc
double Double
d
      where
        di :: Int
di = forall a b. (RealFrac a, Integral b) => a -> b
round Double
d

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

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

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

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

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

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

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

  listToDot :: String -> DotCode
listToDot = forall a. PrintDot a => a -> DotCode
toDot 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 = forall (m :: * -> *). Functor m => m [Doc] -> m Doc
hcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). Applicative m => m Doc -> m [Doc] -> m [Doc]
punctuate forall (m :: * -> *). Applicative m => m Doc
dot forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *). Applicative m => Int -> m Doc
int forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> [Int]
versionBranch

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

  toDot :: Text -> DotCode
toDot = Text -> DotCode
qtString 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 = forall a. PrintDot a => a -> DotCode
unqtDot

-- | For use with @OverloadedStrings@ to avoid ambiguous type variable errors.
dotText :: Text -> DotCode
dotText :: Text -> DotCode
dotText = 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 = forall (m :: * -> *). Applicative m => Char -> m Doc
char Char
c -- Could be a number as well.
  | Bool
otherwise      = forall (m :: * -> *). Functor m => m Doc -> m Doc
dquotes forall a b. (a -> b) -> a -> b
$ 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 = forall a. a -> a -> Bool -> a
bool forall a. a -> a
id forall (m :: * -> *). Functor m => m Doc -> m Doc
dquotes 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
""  = 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 = forall a. PrintDot a => [a] -> DotCode
unqtListToDot

  toDot :: [a] -> DotCode
toDot = 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 forall a. Semigroup a => a -> a -> a
<> DotCode
d 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 = forall a. PrintDot a => a -> DotCode
unqtDot a
a forall a. Semigroup a => a -> a -> a
<> forall (m :: * -> *). Applicative m => m Doc
comma forall a. Semigroup a => a -> a -> a
<> 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 = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
f forall a. Semigroup a => a -> a -> a
<> forall (m :: * -> *). Applicative m => m Doc
equals forall a. Semigroup a => a -> a -> a
<> 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 = forall (m :: * -> *). Applicative m => Text -> m Doc
text 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' forall a b. (a -> b) -> a -> b
$ 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 = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Char, Char) -> Text -> Text
escape Text
T.empty forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [(Char, Char)]
withNext
  where
    cs' :: Set Char
cs' = forall a. Ord a => [a] -> Set a
Set.fromList forall a b. (a -> b) -> a -> b
$ Char
quote forall a. a -> [a] -> [a]
: Char
slash 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 forall a. Eq a => a -> a -> Bool
== Char
slash Bool -> Bool -> Bool
&& Char
c' forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Char
escLetters = Char
c Char -> Text -> Text
`T.cons` Text
str
      | Char
c 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 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 = 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 forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` ((Text -> Char -> Text
`T.snoc` Char
' ') forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.tail) forall a b. (a -> b) -> a -> b
$ Text
str

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

fslash :: DotCode
fslash :: DotCode
fslash = 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 forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
scs forall a b. (a -> b) -> a -> b
$ 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 -> forall a. PrintDot a => a -> DotCode
unqtDot BrewerScheme
bs

instance PrintDot BrewerScheme where
  unqtDot :: BrewerScheme -> DotCode
unqtDot (BScheme BrewerName
n Word8
l) = forall a. PrintDot a => a -> DotCode
unqtDot BrewerName
n forall a. Semigroup a => a -> a -> a
<> 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"