{-# LANGUAGE CPP, OverloadedStrings, PatternGuards #-}

{- |
   Module      : Data.GraphViz.Attributes.HTML
   Description : Specification of HTML-like types for Graphviz.
   Copyright   : (c) Ivan Lazar Miljenovic
   License     : 3-Clause BSD-style
   Maintainer  : Ivan.Miljenovic@gmail.com

   This module is written to be imported qualified.  It defines the
   syntax for HTML-like values for use in Graphviz.  Please note that
   these values are /not/ really HTML, but the term \"HTML\" is used
   throughout as it is less cumbersome than \"HTML-like\".  To be able
   to use this, the version of Graphviz must be at least 1.10.  For
   more information, please see:
       <http://graphviz.org/doc/info/shapes.html#html>

   The actual definition of the syntax specifies that these types must
   be valid XML syntax.  As such, this assumed when printing and parsing,
   though the correct escape/descaping for @\"@, @&@, @\<@ and @\>@ are
   automatically done when printing and parsing.

   Differences from how Graphviz treats HTML-like values:

   * Graphviz only specifies the above-listed characters must be
     escaped; however, internally it also escapes @-@, @\'@ and multiple
     sequences of spaces.  This library attempts to match this behaviour.
     Please let me know if this behaviour (especially about escaping
     multiple spaces) is unwanted.

   * When parsing escaped HTML characters, numeric escapes are
     converted to the corresponding character as are the various characters
     listed above; all other escaped characters (apart from those listed
     above) are silently ignored and removed from the input (since
     technically these must be valid /XML/, which doesn't recognise as many
     named escape characters as does HTML).

   * All whitespace read in is kept (even if Graphviz would ignore
     multiple whitespace characters); when printing them, however, they are
     replaced with non-breaking spaces.  As such, if multiple literal
     whitespace characters are used in a sequence, then the result of
     parsing and then printing some Dot code will /not/ be the same as the
     initial Dot code.  Furthermore, all whitespace characters are printed
     as spaces.

   * It is assumed that all parsed @&@ values are the beginning of an
     XML escape sequence (which /must/ finish with a @;@ character).

   * There should be no pre-escaped characters in values; when
     printing, the @&@ will get escaped without considering if that is an
     escaped character.

-}
module Data.GraphViz.Attributes.HTML
       ( Label(..)
       , Text
       , TextItem(..)
       , Format(..)
       , Table(..)
       , Row(..)
       , Cell(..)
       , Img(..)
       , Attributes
       , Attribute(..)
       , Align(..)
       , VAlign(..)
       , CellFormat(..)
       , Scale(..)
       , Side(..)
       , Style(..)
       ) where

import Data.GraphViz.Attributes.Colors
import Data.GraphViz.Attributes.Internal
import Data.GraphViz.Internal.Util       (bool)
import Data.GraphViz.Parsing
import Data.GraphViz.Printing

import           Data.Char      (chr, isSpace, ord)
import           Data.Function  (on)
import           Data.List      (delete)
import qualified Data.Map       as Map
import           Data.Maybe     (catMaybes, listToMaybe)
import qualified Data.Text.Lazy as T
import           Data.Word      (Word16, Word8)
import           Numeric        (readHex)

#if !MIN_VERSION_base (4,13,0)
import Data.Monoid ((<>))
#endif

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

-- | The overall type for HTML-like labels.  Fundamentally, HTML-like
--   values in Graphviz are either textual (i.e. a single element with
--   formatting) or a table.  Note that 'Label' values can be
--   nested via 'LabelCell'.
data Label = Text  Text
           | Table Table
           deriving (Label -> Label -> Bool
(Label -> Label -> Bool) -> (Label -> Label -> Bool) -> Eq Label
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Label -> Label -> Bool
== :: Label -> Label -> Bool
$c/= :: Label -> Label -> Bool
/= :: Label -> Label -> Bool
Eq, Eq Label
Eq Label =>
(Label -> Label -> Ordering)
-> (Label -> Label -> Bool)
-> (Label -> Label -> Bool)
-> (Label -> Label -> Bool)
-> (Label -> Label -> Bool)
-> (Label -> Label -> Label)
-> (Label -> Label -> Label)
-> Ord Label
Label -> Label -> Bool
Label -> Label -> Ordering
Label -> Label -> Label
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 :: Label -> Label -> Ordering
compare :: Label -> Label -> Ordering
$c< :: Label -> Label -> Bool
< :: Label -> Label -> Bool
$c<= :: Label -> Label -> Bool
<= :: Label -> Label -> Bool
$c> :: Label -> Label -> Bool
> :: Label -> Label -> Bool
$c>= :: Label -> Label -> Bool
>= :: Label -> Label -> Bool
$cmax :: Label -> Label -> Label
max :: Label -> Label -> Label
$cmin :: Label -> Label -> Label
min :: Label -> Label -> Label
Ord, Int -> Label -> ShowS
[Label] -> ShowS
Label -> String
(Int -> Label -> ShowS)
-> (Label -> String) -> ([Label] -> ShowS) -> Show Label
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Label -> ShowS
showsPrec :: Int -> Label -> ShowS
$cshow :: Label -> String
show :: Label -> String
$cshowList :: [Label] -> ShowS
showList :: [Label] -> ShowS
Show, ReadPrec [Label]
ReadPrec Label
Int -> ReadS Label
ReadS [Label]
(Int -> ReadS Label)
-> ReadS [Label]
-> ReadPrec Label
-> ReadPrec [Label]
-> Read Label
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Label
readsPrec :: Int -> ReadS Label
$creadList :: ReadS [Label]
readList :: ReadS [Label]
$creadPrec :: ReadPrec Label
readPrec :: ReadPrec Label
$creadListPrec :: ReadPrec [Label]
readListPrec :: ReadPrec [Label]
Read)

instance PrintDot Label where
  unqtDot :: Label -> DotCodeM Doc
unqtDot (Text Text
txt)  = Text -> DotCodeM Doc
forall a. PrintDot a => a -> DotCodeM Doc
unqtDot Text
txt
  unqtDot (Table Table
tbl) = Table -> DotCodeM Doc
forall a. PrintDot a => a -> DotCodeM Doc
unqtDot Table
tbl

instance ParseDot Label where
  -- Try parsing Table first in case of a FONT tag being used.
  parseUnqt :: Parse Label
parseUnqt = (Table -> Label) -> Parser GraphvizState Table -> Parse Label
forall a b.
(a -> b) -> Parser GraphvizState a -> Parser GraphvizState b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Table -> Label
Table Parser GraphvizState Table
forall a. ParseDot a => Parse a
parseUnqt
              Parse Label -> Parse Label -> Parse Label
forall s a. Parser s a -> Parser s a -> Parser s a
`onFail`
              (Text -> Label) -> Parser GraphvizState Text -> Parse Label
forall a b.
(a -> b) -> Parser GraphvizState a -> Parser GraphvizState b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Label
Text Parser GraphvizState Text
forall a. ParseDot a => Parse a
parseUnqt
              Parse Label -> ShowS -> Parse Label
forall a. Parser GraphvizState a -> ShowS -> Parser GraphvizState a
forall (p :: * -> *) a. Commitment p => p a -> ShowS -> p a
`adjustErr`
              (String
"Can't parse Html.Label\n\t"String -> ShowS
forall a. [a] -> [a] -> [a]
++)

  parse :: Parse Label
parse = Parse Label
forall a. ParseDot a => Parse a
parseUnqt

-- | Represents a textual component of an HTML-like label.  It is
--   assumed that a 'Text' list is non-empty.  It is preferable
--   to \"group\" 'Str' values together rather than have
--   individual ones.  Note that when printing, the individual values
--   are concatenated together without spaces, and when parsing
--   anything that isn't a tag is assumed to be a 'Str': that is,
--   something like \"@\<BR\/\> \<BR\/\>@\" is parsed as:
--
--  > [Newline [], Str " ", Newline []]
type Text = [TextItem]

-- | Textual items in HTML-like labels.
data TextItem = Str T.Text
                -- | Only accepts an optional 'Align'
                --   'Attribute'; defined this way for ease of
                --   printing/parsing.
              | Newline Attributes
              | Font Attributes Text
                -- | Only available in Graphviz >= 2.28.0.
              | Format Format Text
              deriving (TextItem -> TextItem -> Bool
(TextItem -> TextItem -> Bool)
-> (TextItem -> TextItem -> Bool) -> Eq TextItem
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TextItem -> TextItem -> Bool
== :: TextItem -> TextItem -> Bool
$c/= :: TextItem -> TextItem -> Bool
/= :: TextItem -> TextItem -> Bool
Eq, Eq TextItem
Eq TextItem =>
(TextItem -> TextItem -> Ordering)
-> (TextItem -> TextItem -> Bool)
-> (TextItem -> TextItem -> Bool)
-> (TextItem -> TextItem -> Bool)
-> (TextItem -> TextItem -> Bool)
-> (TextItem -> TextItem -> TextItem)
-> (TextItem -> TextItem -> TextItem)
-> Ord TextItem
TextItem -> TextItem -> Bool
TextItem -> TextItem -> Ordering
TextItem -> TextItem -> TextItem
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 :: TextItem -> TextItem -> Ordering
compare :: TextItem -> TextItem -> Ordering
$c< :: TextItem -> TextItem -> Bool
< :: TextItem -> TextItem -> Bool
$c<= :: TextItem -> TextItem -> Bool
<= :: TextItem -> TextItem -> Bool
$c> :: TextItem -> TextItem -> Bool
> :: TextItem -> TextItem -> Bool
$c>= :: TextItem -> TextItem -> Bool
>= :: TextItem -> TextItem -> Bool
$cmax :: TextItem -> TextItem -> TextItem
max :: TextItem -> TextItem -> TextItem
$cmin :: TextItem -> TextItem -> TextItem
min :: TextItem -> TextItem -> TextItem
Ord, Int -> TextItem -> ShowS
Text -> ShowS
TextItem -> String
(Int -> TextItem -> ShowS)
-> (TextItem -> String) -> (Text -> ShowS) -> Show TextItem
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TextItem -> ShowS
showsPrec :: Int -> TextItem -> ShowS
$cshow :: TextItem -> String
show :: TextItem -> String
$cshowList :: Text -> ShowS
showList :: Text -> ShowS
Show, ReadPrec Text
ReadPrec TextItem
Int -> ReadS TextItem
ReadS Text
(Int -> ReadS TextItem)
-> ReadS Text
-> ReadPrec TextItem
-> ReadPrec Text
-> Read TextItem
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS TextItem
readsPrec :: Int -> ReadS TextItem
$creadList :: ReadS Text
readList :: ReadS Text
$creadPrec :: ReadPrec TextItem
readPrec :: ReadPrec TextItem
$creadListPrec :: ReadPrec Text
readListPrec :: ReadPrec Text
Read)

instance PrintDot TextItem where
  unqtDot :: TextItem -> DotCodeM Doc
unqtDot (Str Text
str)        = Text -> DotCodeM Doc
escapeValue Text
str
  unqtDot (Newline Attributes
as)     = DotCodeM Doc -> Attributes -> DotCodeM Doc
printEmptyTag (Text -> DotCodeM Doc
forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"BR") Attributes
as
  unqtDot (Font Attributes
as Text
txt)    = Attributes -> DotCodeM Doc -> DotCodeM Doc
printFontTag Attributes
as (DotCodeM Doc -> DotCodeM Doc) -> DotCodeM Doc -> DotCodeM Doc
forall a b. (a -> b) -> a -> b
$ Text -> DotCodeM Doc
forall a. PrintDot a => a -> DotCodeM Doc
unqtDot Text
txt
  unqtDot (Format Format
fmt Text
txt) = DotCodeM Doc -> Attributes -> DotCodeM Doc -> DotCodeM Doc
printTag (Format -> DotCodeM Doc
forall a. PrintDot a => a -> DotCodeM Doc
unqtDot Format
fmt) [] (DotCodeM Doc -> DotCodeM Doc) -> DotCodeM Doc -> DotCodeM Doc
forall a b. (a -> b) -> a -> b
$ Text -> DotCodeM Doc
forall a. PrintDot a => a -> DotCodeM Doc
unqtDot Text
txt

  unqtListToDot :: Text -> DotCodeM Doc
unqtListToDot = DotCodeM [Doc] -> DotCodeM Doc
forall (m :: * -> *). Functor m => m [Doc] -> m Doc
hcat (DotCodeM [Doc] -> DotCodeM Doc)
-> (Text -> DotCodeM [Doc]) -> Text -> DotCodeM Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TextItem -> DotCodeM Doc) -> Text -> 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 TextItem -> DotCodeM Doc
forall a. PrintDot a => a -> DotCodeM Doc
unqtDot

  listToDot :: Text -> DotCodeM Doc
listToDot = Text -> DotCodeM Doc
forall a. PrintDot a => [a] -> DotCodeM Doc
unqtListToDot

instance ParseDot TextItem where
  parseUnqt :: Parse TextItem
parseUnqt = [Parse TextItem] -> Parse TextItem
forall (p :: * -> *) a. PolyParse p => [p a] -> p a
oneOf [ (Text -> TextItem) -> Parser GraphvizState Text -> Parse TextItem
forall a b.
(a -> b) -> Parser GraphvizState a -> Parser GraphvizState b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> TextItem
Str Parser GraphvizState Text
unescapeValue
                    , (Attributes -> TextItem) -> String -> Parse TextItem
forall tag. (Attributes -> tag) -> String -> Parse tag
parseEmptyTag Attributes -> TextItem
Newline String
"BR"
                    , (Attributes -> Text -> TextItem)
-> Parser GraphvizState Text -> Parse TextItem
forall val tag.
(Attributes -> val -> tag) -> Parse val -> Parse tag
parseFontTag Attributes -> Text -> TextItem
Font Parser GraphvizState Text
forall a. ParseDot a => Parse a
parseUnqt
                    , (Format -> Text -> TextItem)
-> Parse Format -> Parser GraphvizState Text -> Parse TextItem
forall tagName val tag.
(tagName -> val -> tag) -> Parse tagName -> Parse val -> Parse tag
parseTagRep Format -> Text -> TextItem
Format Parse Format
forall a. ParseDot a => Parse a
parseUnqt Parser GraphvizState Text
forall a. ParseDot a => Parse a
parseUnqt
                    ]
              Parse TextItem -> ShowS -> Parse TextItem
forall a. Parser GraphvizState a -> ShowS -> Parser GraphvizState a
forall (p :: * -> *) a. Commitment p => p a -> ShowS -> p a
`adjustErr`
              (String
"Can't parse Html.TextItem\n\t"String -> ShowS
forall a. [a] -> [a] -> [a]
++)

  parse :: Parse TextItem
parse = Parse TextItem
forall a. ParseDot a => Parse a
parseUnqt

  parseUnqtList :: Parser GraphvizState Text
parseUnqtList = Parse TextItem -> Parser GraphvizState Text
forall a. Parser GraphvizState a -> Parser GraphvizState [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parse TextItem
forall a. ParseDot a => Parse a
parseUnqt

  parseList :: Parser GraphvizState Text
parseList = Parser GraphvizState Text
forall a. ParseDot a => Parse [a]
parseUnqtList

data Format = Italics
              | Bold
              | Underline
              | Overline -- ^ Requires Graphviz >= 2.38.0.
              | Subscript
              | Superscript
              deriving (Format -> Format -> Bool
(Format -> Format -> Bool)
-> (Format -> Format -> Bool) -> Eq Format
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Format -> Format -> Bool
== :: Format -> Format -> Bool
$c/= :: Format -> Format -> Bool
/= :: Format -> Format -> Bool
Eq, Eq Format
Eq Format =>
(Format -> Format -> Ordering)
-> (Format -> Format -> Bool)
-> (Format -> Format -> Bool)
-> (Format -> Format -> Bool)
-> (Format -> Format -> Bool)
-> (Format -> Format -> Format)
-> (Format -> Format -> Format)
-> Ord Format
Format -> Format -> Bool
Format -> Format -> Ordering
Format -> Format -> Format
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 :: Format -> Format -> Ordering
compare :: Format -> Format -> Ordering
$c< :: Format -> Format -> Bool
< :: Format -> Format -> Bool
$c<= :: Format -> Format -> Bool
<= :: Format -> Format -> Bool
$c> :: Format -> Format -> Bool
> :: Format -> Format -> Bool
$c>= :: Format -> Format -> Bool
>= :: Format -> Format -> Bool
$cmax :: Format -> Format -> Format
max :: Format -> Format -> Format
$cmin :: Format -> Format -> Format
min :: Format -> Format -> Format
Ord, Format
Format -> Format -> Bounded Format
forall a. a -> a -> Bounded a
$cminBound :: Format
minBound :: Format
$cmaxBound :: Format
maxBound :: Format
Bounded, Int -> Format
Format -> Int
Format -> [Format]
Format -> Format
Format -> Format -> [Format]
Format -> Format -> Format -> [Format]
(Format -> Format)
-> (Format -> Format)
-> (Int -> Format)
-> (Format -> Int)
-> (Format -> [Format])
-> (Format -> Format -> [Format])
-> (Format -> Format -> [Format])
-> (Format -> Format -> Format -> [Format])
-> Enum Format
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Format -> Format
succ :: Format -> Format
$cpred :: Format -> Format
pred :: Format -> Format
$ctoEnum :: Int -> Format
toEnum :: Int -> Format
$cfromEnum :: Format -> Int
fromEnum :: Format -> Int
$cenumFrom :: Format -> [Format]
enumFrom :: Format -> [Format]
$cenumFromThen :: Format -> Format -> [Format]
enumFromThen :: Format -> Format -> [Format]
$cenumFromTo :: Format -> Format -> [Format]
enumFromTo :: Format -> Format -> [Format]
$cenumFromThenTo :: Format -> Format -> Format -> [Format]
enumFromThenTo :: Format -> Format -> Format -> [Format]
Enum, Int -> Format -> ShowS
[Format] -> ShowS
Format -> String
(Int -> Format -> ShowS)
-> (Format -> String) -> ([Format] -> ShowS) -> Show Format
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Format -> ShowS
showsPrec :: Int -> Format -> ShowS
$cshow :: Format -> String
show :: Format -> String
$cshowList :: [Format] -> ShowS
showList :: [Format] -> ShowS
Show, ReadPrec [Format]
ReadPrec Format
Int -> ReadS Format
ReadS [Format]
(Int -> ReadS Format)
-> ReadS [Format]
-> ReadPrec Format
-> ReadPrec [Format]
-> Read Format
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Format
readsPrec :: Int -> ReadS Format
$creadList :: ReadS [Format]
readList :: ReadS [Format]
$creadPrec :: ReadPrec Format
readPrec :: ReadPrec Format
$creadListPrec :: ReadPrec [Format]
readListPrec :: ReadPrec [Format]
Read)

instance PrintDot Format where
  unqtDot :: Format -> DotCodeM Doc
unqtDot Format
Italics     = Text -> DotCodeM Doc
forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"I"
  unqtDot Format
Bold        = Text -> DotCodeM Doc
forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"B"
  unqtDot Format
Underline   = Text -> DotCodeM Doc
forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"U"
  unqtDot Format
Overline    = Text -> DotCodeM Doc
forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"O"
  unqtDot Format
Subscript   = Text -> DotCodeM Doc
forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"SUB"
  unqtDot Format
Superscript = Text -> DotCodeM Doc
forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"SUP"

instance ParseDot Format where
  parseUnqt :: Parse Format
parseUnqt = [(String, Format)] -> Parse Format
forall a. [(String, a)] -> Parse a
stringValue [ (String
"I", Format
Italics)
                          , (String
"B", Format
Bold)
                          , (String
"U", Format
Underline)
                          , (String
"O", Format
Overline)
                          , (String
"SUB", Format
Subscript)
                          , (String
"SUP", Format
Superscript)
                          ]

-- | A table in HTML-like labels.  Tables are optionally wrapped in
--   overall @FONT@ tags.
data Table = HTable { -- | Optional @FONT@ attributes.  @'Just'
                      --   []@ denotes empty @FONT@ tags;
                      --   @'Nothing'@ denotes no such tags.
                      Table -> Maybe Attributes
tableFontAttrs :: Maybe Attributes
                    , Table -> Attributes
tableAttrs     :: Attributes
                      -- | This list is assumed to be non-empty.
                    , Table -> [Row]
tableRows      :: [Row]
                    }
               deriving (Table -> Table -> Bool
(Table -> Table -> Bool) -> (Table -> Table -> Bool) -> Eq Table
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Table -> Table -> Bool
== :: Table -> Table -> Bool
$c/= :: Table -> Table -> Bool
/= :: Table -> Table -> Bool
Eq, Eq Table
Eq Table =>
(Table -> Table -> Ordering)
-> (Table -> Table -> Bool)
-> (Table -> Table -> Bool)
-> (Table -> Table -> Bool)
-> (Table -> Table -> Bool)
-> (Table -> Table -> Table)
-> (Table -> Table -> Table)
-> Ord Table
Table -> Table -> Bool
Table -> Table -> Ordering
Table -> Table -> Table
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 :: Table -> Table -> Ordering
compare :: Table -> Table -> Ordering
$c< :: Table -> Table -> Bool
< :: Table -> Table -> Bool
$c<= :: Table -> Table -> Bool
<= :: Table -> Table -> Bool
$c> :: Table -> Table -> Bool
> :: Table -> Table -> Bool
$c>= :: Table -> Table -> Bool
>= :: Table -> Table -> Bool
$cmax :: Table -> Table -> Table
max :: Table -> Table -> Table
$cmin :: Table -> Table -> Table
min :: Table -> Table -> Table
Ord, Int -> Table -> ShowS
[Table] -> ShowS
Table -> String
(Int -> Table -> ShowS)
-> (Table -> String) -> ([Table] -> ShowS) -> Show Table
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Table -> ShowS
showsPrec :: Int -> Table -> ShowS
$cshow :: Table -> String
show :: Table -> String
$cshowList :: [Table] -> ShowS
showList :: [Table] -> ShowS
Show, ReadPrec [Table]
ReadPrec Table
Int -> ReadS Table
ReadS [Table]
(Int -> ReadS Table)
-> ReadS [Table]
-> ReadPrec Table
-> ReadPrec [Table]
-> Read Table
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Table
readsPrec :: Int -> ReadS Table
$creadList :: ReadS [Table]
readList :: ReadS [Table]
$creadPrec :: ReadPrec Table
readPrec :: ReadPrec Table
$creadListPrec :: ReadPrec [Table]
readListPrec :: ReadPrec [Table]
Read)

instance PrintDot Table where
  unqtDot :: Table -> DotCodeM Doc
unqtDot Table
tbl = case Table -> Maybe Attributes
tableFontAttrs Table
tbl of
                  (Just Attributes
as) -> Attributes -> DotCodeM Doc -> DotCodeM Doc
printFontTag Attributes
as DotCodeM Doc
tbl'
                  Maybe Attributes
Nothing   -> DotCodeM Doc
tbl'
    where
      tbl' :: DotCodeM Doc
tbl' = DotCodeM Doc -> Attributes -> DotCodeM Doc -> DotCodeM Doc
printTag (Text -> DotCodeM Doc
forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"TABLE")
                          (Table -> Attributes
tableAttrs Table
tbl)
                          ([Row] -> DotCodeM Doc
forall a. PrintDot a => a -> DotCodeM Doc
toDot ([Row] -> DotCodeM Doc) -> [Row] -> DotCodeM Doc
forall a b. (a -> b) -> a -> b
$ Table -> [Row]
tableRows Table
tbl)

instance ParseDot Table where
  parseUnqt :: Parser GraphvizState Table
parseUnqt = Parser GraphvizState Table -> Parser GraphvizState Table
forall a. Parse a -> Parse a
wrapWhitespace ((Attributes -> Table -> Table)
-> Parser GraphvizState Table -> Parser GraphvizState Table
forall val tag.
(Attributes -> val -> tag) -> Parse val -> Parse tag
parseFontTag Attributes -> Table -> Table
addFontAttrs Parser GraphvizState Table
pTbl)
              Parser GraphvizState Table
-> Parser GraphvizState Table -> Parser GraphvizState Table
forall s a. Parser s a -> Parser s a -> Parser s a
`onFail`
              Parser GraphvizState Table
pTbl
              Parser GraphvizState Table -> ShowS -> Parser GraphvizState Table
forall a. Parser GraphvizState a -> ShowS -> Parser GraphvizState a
forall (p :: * -> *) a. Commitment p => p a -> ShowS -> p a
`adjustErr`
              (String
"Can't parse Html.Table\n\t"String -> ShowS
forall a. [a] -> [a] -> [a]
++)
    where
      pTbl :: Parser GraphvizState Table
pTbl = Parser GraphvizState Table -> Parser GraphvizState Table
forall a. Parse a -> Parse a
wrapWhitespace (Parser GraphvizState Table -> Parser GraphvizState Table)
-> Parser GraphvizState Table -> Parser GraphvizState Table
forall a b. (a -> b) -> a -> b
$ (Attributes -> [Row] -> Table)
-> String -> Parse [Row] -> Parser GraphvizState Table
forall val tag.
(Attributes -> val -> tag) -> String -> Parse val -> Parse tag
parseTag (Maybe Attributes -> Attributes -> [Row] -> Table
HTable Maybe Attributes
forall a. Maybe a
Nothing)
                                       String
"TABLE"
                                       (Parse [Row] -> Parse [Row]
forall a. Parse a -> Parse a
wrapWhitespace Parse [Row]
forall a. ParseDot a => Parse a
parseUnqt)
      addFontAttrs :: Attributes -> Table -> Table
addFontAttrs Attributes
fas Table
tbl = Table
tbl { tableFontAttrs = Just fas }

  parse :: Parser GraphvizState Table
parse = Parser GraphvizState Table
forall a. ParseDot a => Parse a
parseUnqt

-- | A row in a 'Table'.  The list of 'Cell' values is
--   assumed to be non-empty.
data Row = Cells [Cell]
         | HorizontalRule -- ^ Should be between 'Cells' values,
                          --   requires Graphviz >= 2.29.0
         deriving (Row -> Row -> Bool
(Row -> Row -> Bool) -> (Row -> Row -> Bool) -> Eq Row
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Row -> Row -> Bool
== :: Row -> Row -> Bool
$c/= :: Row -> Row -> Bool
/= :: Row -> Row -> Bool
Eq, Eq Row
Eq Row =>
(Row -> Row -> Ordering)
-> (Row -> Row -> Bool)
-> (Row -> Row -> Bool)
-> (Row -> Row -> Bool)
-> (Row -> Row -> Bool)
-> (Row -> Row -> Row)
-> (Row -> Row -> Row)
-> Ord Row
Row -> Row -> Bool
Row -> Row -> Ordering
Row -> Row -> Row
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 :: Row -> Row -> Ordering
compare :: Row -> Row -> Ordering
$c< :: Row -> Row -> Bool
< :: Row -> Row -> Bool
$c<= :: Row -> Row -> Bool
<= :: Row -> Row -> Bool
$c> :: Row -> Row -> Bool
> :: Row -> Row -> Bool
$c>= :: Row -> Row -> Bool
>= :: Row -> Row -> Bool
$cmax :: Row -> Row -> Row
max :: Row -> Row -> Row
$cmin :: Row -> Row -> Row
min :: Row -> Row -> Row
Ord, Int -> Row -> ShowS
[Row] -> ShowS
Row -> String
(Int -> Row -> ShowS)
-> (Row -> String) -> ([Row] -> ShowS) -> Show Row
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Row -> ShowS
showsPrec :: Int -> Row -> ShowS
$cshow :: Row -> String
show :: Row -> String
$cshowList :: [Row] -> ShowS
showList :: [Row] -> ShowS
Show, ReadPrec [Row]
ReadPrec Row
Int -> ReadS Row
ReadS [Row]
(Int -> ReadS Row)
-> ReadS [Row] -> ReadPrec Row -> ReadPrec [Row] -> Read Row
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Row
readsPrec :: Int -> ReadS Row
$creadList :: ReadS [Row]
readList :: ReadS [Row]
$creadPrec :: ReadPrec Row
readPrec :: ReadPrec Row
$creadListPrec :: ReadPrec [Row]
readListPrec :: ReadPrec [Row]
Read)

instance PrintDot Row where
  unqtDot :: Row -> DotCodeM Doc
unqtDot (Cells [Cell]
cs)     = DotCodeM Doc -> Attributes -> DotCodeM Doc -> DotCodeM Doc
printTag (Text -> DotCodeM Doc
forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"TR") [] (DotCodeM Doc -> DotCodeM Doc) -> DotCodeM Doc -> DotCodeM Doc
forall a b. (a -> b) -> a -> b
$ [Cell] -> DotCodeM Doc
forall a. PrintDot a => a -> DotCodeM Doc
unqtDot [Cell]
cs
  unqtDot Row
HorizontalRule = DotCodeM Doc -> Attributes -> DotCodeM Doc
printEmptyTag (Text -> DotCodeM Doc
forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"HR") []

  unqtListToDot :: [Row] -> DotCodeM Doc
unqtListToDot = DotCodeM Doc -> DotCodeM Doc
forall (m :: * -> *). Functor m => m Doc -> m Doc
align (DotCodeM Doc -> DotCodeM Doc)
-> ([Row] -> DotCodeM Doc) -> [Row] -> DotCodeM Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DotCodeM [Doc] -> DotCodeM Doc
forall (m :: * -> *). Functor m => m [Doc] -> m Doc
cat (DotCodeM [Doc] -> DotCodeM Doc)
-> ([Row] -> DotCodeM [Doc]) -> [Row] -> DotCodeM Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Row -> DotCodeM Doc) -> [Row] -> 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 Row -> DotCodeM Doc
forall a. PrintDot a => a -> DotCodeM Doc
unqtDot

  listToDot :: [Row] -> DotCodeM Doc
listToDot = [Row] -> DotCodeM Doc
forall a. PrintDot a => [a] -> DotCodeM Doc
unqtListToDot

instance ParseDot Row where
  -- To save doing it manually, use 'parseTag' and ignore any
  -- 'Attributes' that it might accidentally parse.
  parseUnqt :: Parse Row
parseUnqt = Parse Row -> Parse Row
forall a. Parse a -> Parse a
wrapWhitespace (Parse Row -> Parse Row) -> Parse Row -> Parse Row
forall a b. (a -> b) -> a -> b
$ (Attributes -> [Cell] -> Row)
-> String -> Parse [Cell] -> Parse Row
forall val tag.
(Attributes -> val -> tag) -> String -> Parse val -> Parse tag
parseTag (([Cell] -> Row) -> Attributes -> [Cell] -> Row
forall a b. a -> b -> a
const [Cell] -> Row
Cells) String
"TR" Parse [Cell]
forall a. ParseDot a => Parse a
parseUnqt
              Parse Row -> Parse Row -> Parse Row
forall s a. Parser s a -> Parser s a -> Parser s a
`onFail`
              (Attributes -> Row) -> String -> Parse Row
forall tag. (Attributes -> tag) -> String -> Parse tag
parseEmptyTag (Row -> Attributes -> Row
forall a b. a -> b -> a
const Row
HorizontalRule) String
"HR"
              Parse Row -> ShowS -> Parse Row
forall a. Parser GraphvizState a -> ShowS -> Parser GraphvizState a
forall (p :: * -> *) a. Commitment p => p a -> ShowS -> p a
`adjustErr`
              (String
"Can't parse Html.Row\n\t"String -> ShowS
forall a. [a] -> [a] -> [a]
++)

  parse :: Parse Row
parse = Parse Row
forall a. ParseDot a => Parse a
parseUnqt

  parseUnqtList :: Parse [Row]
parseUnqtList = Parse [Row] -> Parse [Row]
forall a. Parse a -> Parse a
wrapWhitespace (Parse [Row] -> Parse [Row]) -> Parse [Row] -> Parse [Row]
forall a b. (a -> b) -> a -> b
$ Parse Row -> Parser GraphvizState () -> Parse [Row]
forall (p :: * -> *) a sep. PolyParse p => p a -> p sep -> p [a]
sepBy1 Parse Row
forall a. ParseDot a => Parse a
parseUnqt Parser GraphvizState ()
whitespace

  parseList :: Parse [Row]
parseList = Parse [Row]
forall a. ParseDot a => Parse [a]
parseUnqtList

-- | Cells either recursively contain another 'Label' or else a
--   path to an image file.
data Cell = LabelCell Attributes Label
          | ImgCell Attributes Img
          | VerticalRule -- ^ Should be between 'LabelCell' or
                         --   'ImgCell' values, requires Graphviz >=
                         --   2.29.0
          deriving (Cell -> Cell -> Bool
(Cell -> Cell -> Bool) -> (Cell -> Cell -> Bool) -> Eq Cell
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Cell -> Cell -> Bool
== :: Cell -> Cell -> Bool
$c/= :: Cell -> Cell -> Bool
/= :: Cell -> Cell -> Bool
Eq, Eq Cell
Eq Cell =>
(Cell -> Cell -> Ordering)
-> (Cell -> Cell -> Bool)
-> (Cell -> Cell -> Bool)
-> (Cell -> Cell -> Bool)
-> (Cell -> Cell -> Bool)
-> (Cell -> Cell -> Cell)
-> (Cell -> Cell -> Cell)
-> Ord Cell
Cell -> Cell -> Bool
Cell -> Cell -> Ordering
Cell -> Cell -> Cell
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 :: Cell -> Cell -> Ordering
compare :: Cell -> Cell -> Ordering
$c< :: Cell -> Cell -> Bool
< :: Cell -> Cell -> Bool
$c<= :: Cell -> Cell -> Bool
<= :: Cell -> Cell -> Bool
$c> :: Cell -> Cell -> Bool
> :: Cell -> Cell -> Bool
$c>= :: Cell -> Cell -> Bool
>= :: Cell -> Cell -> Bool
$cmax :: Cell -> Cell -> Cell
max :: Cell -> Cell -> Cell
$cmin :: Cell -> Cell -> Cell
min :: Cell -> Cell -> Cell
Ord, Int -> Cell -> ShowS
[Cell] -> ShowS
Cell -> String
(Int -> Cell -> ShowS)
-> (Cell -> String) -> ([Cell] -> ShowS) -> Show Cell
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Cell -> ShowS
showsPrec :: Int -> Cell -> ShowS
$cshow :: Cell -> String
show :: Cell -> String
$cshowList :: [Cell] -> ShowS
showList :: [Cell] -> ShowS
Show, ReadPrec [Cell]
ReadPrec Cell
Int -> ReadS Cell
ReadS [Cell]
(Int -> ReadS Cell)
-> ReadS [Cell] -> ReadPrec Cell -> ReadPrec [Cell] -> Read Cell
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Cell
readsPrec :: Int -> ReadS Cell
$creadList :: ReadS [Cell]
readList :: ReadS [Cell]
$creadPrec :: ReadPrec Cell
readPrec :: ReadPrec Cell
$creadListPrec :: ReadPrec [Cell]
readListPrec :: ReadPrec [Cell]
Read)

instance PrintDot Cell where
  unqtDot :: Cell -> DotCodeM Doc
unqtDot (LabelCell Attributes
as Label
l) = Attributes -> DotCodeM Doc -> DotCodeM Doc
printCell Attributes
as (DotCodeM Doc -> DotCodeM Doc) -> DotCodeM Doc -> DotCodeM Doc
forall a b. (a -> b) -> a -> b
$ Label -> DotCodeM Doc
forall a. PrintDot a => a -> DotCodeM Doc
unqtDot Label
l
  unqtDot (ImgCell Attributes
as Img
img) = Attributes -> DotCodeM Doc -> DotCodeM Doc
printCell Attributes
as (DotCodeM Doc -> DotCodeM Doc) -> DotCodeM Doc -> DotCodeM Doc
forall a b. (a -> b) -> a -> b
$ Img -> DotCodeM Doc
forall a. PrintDot a => a -> DotCodeM Doc
unqtDot Img
img
  unqtDot Cell
VerticalRule     = DotCodeM Doc -> Attributes -> DotCodeM Doc
printEmptyTag (Text -> DotCodeM Doc
forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"VR") []

  unqtListToDot :: [Cell] -> DotCodeM Doc
unqtListToDot = DotCodeM [Doc] -> DotCodeM Doc
forall (m :: * -> *). Functor m => m [Doc] -> m Doc
hsep (DotCodeM [Doc] -> DotCodeM Doc)
-> ([Cell] -> DotCodeM [Doc]) -> [Cell] -> DotCodeM Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Cell -> DotCodeM Doc) -> [Cell] -> 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 Cell -> DotCodeM Doc
forall a. PrintDot a => a -> DotCodeM Doc
unqtDot

  listToDot :: [Cell] -> DotCodeM Doc
listToDot = [Cell] -> DotCodeM Doc
forall a. PrintDot a => [a] -> DotCodeM Doc
unqtListToDot

printCell :: Attributes -> DotCode -> DotCode
printCell :: Attributes -> DotCodeM Doc -> DotCodeM Doc
printCell = DotCodeM Doc -> Attributes -> DotCodeM Doc -> DotCodeM Doc
printTag (Text -> DotCodeM Doc
forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"TD")

instance ParseDot Cell where
  parseUnqt :: Parse Cell
parseUnqt = [Parse Cell] -> Parse Cell
forall (p :: * -> *) a. PolyParse p => [p a] -> p a
oneOf [ (Attributes -> Label -> Cell) -> Parse Label -> Parse Cell
forall val tag.
(Attributes -> val -> tag) -> Parse val -> Parse tag
parseCell Attributes -> Label -> Cell
LabelCell Parse Label
forall a. ParseDot a => Parse a
parse
                    , (Attributes -> Img -> Cell) -> Parse Img -> Parse Cell
forall val tag.
(Attributes -> val -> tag) -> Parse val -> Parse tag
parseCell Attributes -> Img -> Cell
ImgCell (Parse Img -> Parse Cell) -> Parse Img -> Parse Cell
forall a b. (a -> b) -> a -> b
$ Parse Img -> Parse Img
forall a. Parse a -> Parse a
wrapWhitespace Parse Img
forall a. ParseDot a => Parse a
parse
                    , (Attributes -> Cell) -> String -> Parse Cell
forall tag. (Attributes -> tag) -> String -> Parse tag
parseEmptyTag (Cell -> Attributes -> Cell
forall a b. a -> b -> a
const Cell
VerticalRule) String
"VR"
                    ]
              Parse Cell -> ShowS -> Parse Cell
forall a. Parser GraphvizState a -> ShowS -> Parser GraphvizState a
forall (p :: * -> *) a. Commitment p => p a -> ShowS -> p a
`adjustErr`
              (String
"Can't parse Html.Cell\n\t"String -> ShowS
forall a. [a] -> [a] -> [a]
++)
    where
      parseCell :: (Attributes -> val -> tag) -> Parse val -> Parse tag
parseCell = ((Attributes -> val -> tag) -> String -> Parse val -> Parse tag
forall val tag.
(Attributes -> val -> tag) -> String -> Parse val -> Parse tag
`parseTag` String
"TD")

  parse :: Parse Cell
parse = Parse Cell
forall a. ParseDot a => Parse a
parseUnqt

  parseUnqtList :: Parse [Cell]
parseUnqtList = Parse [Cell] -> Parse [Cell]
forall a. Parse a -> Parse a
wrapWhitespace (Parse [Cell] -> Parse [Cell]) -> Parse [Cell] -> Parse [Cell]
forall a b. (a -> b) -> a -> b
$ Parse Cell -> Parser GraphvizState () -> Parse [Cell]
forall (p :: * -> *) a sep. PolyParse p => p a -> p sep -> p [a]
sepBy1 Parse Cell
forall a. ParseDot a => Parse a
parseUnqt Parser GraphvizState ()
whitespace

  parseList :: Parse [Cell]
parseList = Parse [Cell]
forall a. ParseDot a => Parse [a]
parseUnqtList

-- | The path to an image; accepted 'Attributes' are 'Scale' and 'Src'.
newtype Img = Img Attributes
            deriving (Img -> Img -> Bool
(Img -> Img -> Bool) -> (Img -> Img -> Bool) -> Eq Img
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Img -> Img -> Bool
== :: Img -> Img -> Bool
$c/= :: Img -> Img -> Bool
/= :: Img -> Img -> Bool
Eq, Eq Img
Eq Img =>
(Img -> Img -> Ordering)
-> (Img -> Img -> Bool)
-> (Img -> Img -> Bool)
-> (Img -> Img -> Bool)
-> (Img -> Img -> Bool)
-> (Img -> Img -> Img)
-> (Img -> Img -> Img)
-> Ord Img
Img -> Img -> Bool
Img -> Img -> Ordering
Img -> Img -> Img
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 :: Img -> Img -> Ordering
compare :: Img -> Img -> Ordering
$c< :: Img -> Img -> Bool
< :: Img -> Img -> Bool
$c<= :: Img -> Img -> Bool
<= :: Img -> Img -> Bool
$c> :: Img -> Img -> Bool
> :: Img -> Img -> Bool
$c>= :: Img -> Img -> Bool
>= :: Img -> Img -> Bool
$cmax :: Img -> Img -> Img
max :: Img -> Img -> Img
$cmin :: Img -> Img -> Img
min :: Img -> Img -> Img
Ord, Int -> Img -> ShowS
[Img] -> ShowS
Img -> String
(Int -> Img -> ShowS)
-> (Img -> String) -> ([Img] -> ShowS) -> Show Img
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Img -> ShowS
showsPrec :: Int -> Img -> ShowS
$cshow :: Img -> String
show :: Img -> String
$cshowList :: [Img] -> ShowS
showList :: [Img] -> ShowS
Show, ReadPrec [Img]
ReadPrec Img
Int -> ReadS Img
ReadS [Img]
(Int -> ReadS Img)
-> ReadS [Img] -> ReadPrec Img -> ReadPrec [Img] -> Read Img
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Img
readsPrec :: Int -> ReadS Img
$creadList :: ReadS [Img]
readList :: ReadS [Img]
$creadPrec :: ReadPrec Img
readPrec :: ReadPrec Img
$creadListPrec :: ReadPrec [Img]
readListPrec :: ReadPrec [Img]
Read)

instance PrintDot Img where
  unqtDot :: Img -> DotCodeM Doc
unqtDot (Img Attributes
as) = DotCodeM Doc -> Attributes -> DotCodeM Doc
printEmptyTag (Text -> DotCodeM Doc
forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"IMG") Attributes
as

instance ParseDot Img where
  parseUnqt :: Parse Img
parseUnqt = Parse Img -> Parse Img
forall a. Parse a -> Parse a
wrapWhitespace ((Attributes -> Img) -> String -> Parse Img
forall tag. (Attributes -> tag) -> String -> Parse tag
parseEmptyTag Attributes -> Img
Img String
"IMG")
              Parse Img -> ShowS -> Parse Img
forall a. Parser GraphvizState a -> ShowS -> Parser GraphvizState a
forall (p :: * -> *) a. Commitment p => p a -> ShowS -> p a
`adjustErr`
              (String
"Can't parse Html.Img\n\t"String -> ShowS
forall a. [a] -> [a] -> [a]
++)

  parse :: Parse Img
parse = Parse Img
forall a. ParseDot a => Parse a
parseUnqt

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

-- | The various HTML-like label-specific attributes being used.
type Attributes = [Attribute]

-- | Note that not all 'Attribute' values are valid everywhere:
--   see the comments for each one on where it is valid.
data Attribute = Align Align        -- ^ Valid for: 'Table', 'Cell', 'Newline'.
               | BAlign Align       -- ^ Valid for: 'Cell'.
               | BGColor Color      -- ^ Valid for: 'Table' (including 'tableFontAttrs'), 'Cell', 'Font'.
               | Border Word8       -- ^ Valid for: 'Table', 'Cell'.  Default is @1@; @0@ represents no border.
               | CellBorder Word8   -- ^ Valid for: 'Table'.  Default is @1@; @0@ represents no border.
               | CellPadding Word8  -- ^ Valid for: 'Table', 'Cell'.  Default is @2@.
               | CellSpacing Word8  -- ^ Valid for: 'Table', 'Cell'.  Default is @2@; maximum is @127@.
               | Color Color        -- ^ Valid for: 'Table', 'Cell'.
               | ColSpan Word16     -- ^ Valid for: 'Cell'.  Default is @1@.
               | Columns CellFormat -- ^ Valid for: 'Table'.  Requires Graphviz >= 2.40.1
               | Face T.Text        -- ^ Valid for: 'tableFontAttrs', 'Font'.
               | FixedSize Bool     -- ^ Valid for: 'Table', 'Cell'.  Default is @'False'@.
               | GradientAngle Int  -- ^ Valid for: 'Table', 'Cell'.  Default is @0@.  Requires Graphviz >= 2.40.1
               | Height Word16      -- ^ Valid for: 'Table', 'Cell'.
               | HRef T.Text        -- ^ Valid for: 'Table', 'Cell'.
               | ID T.Text          -- ^ Valid for: 'Table', 'Cell'.  Requires Graphviz >= 2.29.0
               | PointSize Double   -- ^ Valid for: 'tableFontAttrs', 'Font'.
               | Port PortName      -- ^ Valid for: 'Table', 'Cell'.
               | Rows CellFormat    -- ^ Valid for: 'Table'.  Requires Graphviz >= 2.40.1
               | RowSpan Word16     -- ^ Valid for: 'Cell'.
               | Scale Scale        -- ^ Valid for: 'Img'.
               | Sides [Side]       -- ^ Valid for: 'Table', 'Cell'.  Default is @['LeftSide', 'TopSide', 'RightSide', 'BottomSide']@.  Requires Graphviz >= 2.40.1
               | Src FilePath       -- ^ Valid for: 'Img'.
               | Style Style        -- ^ Valid for: 'Table', 'Cell'.  Requires Graphviz >= 2.40.1
               | Target T.Text      -- ^ Valid for: 'Table', 'Cell'.
               | Title T.Text       -- ^ Valid for: 'Table', 'Cell'.  Has an alias of @TOOLTIP@.
               | VAlign VAlign      -- ^ Valid for: 'Table', 'Cell'.
               | Width Word16       -- ^ Valid for: 'Table', 'Cell'.
               deriving (Attribute -> Attribute -> Bool
(Attribute -> Attribute -> Bool)
-> (Attribute -> Attribute -> Bool) -> Eq Attribute
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Attribute -> Attribute -> Bool
== :: Attribute -> Attribute -> Bool
$c/= :: Attribute -> Attribute -> Bool
/= :: Attribute -> Attribute -> Bool
Eq, Eq Attribute
Eq Attribute =>
(Attribute -> Attribute -> Ordering)
-> (Attribute -> Attribute -> Bool)
-> (Attribute -> Attribute -> Bool)
-> (Attribute -> Attribute -> Bool)
-> (Attribute -> Attribute -> Bool)
-> (Attribute -> Attribute -> Attribute)
-> (Attribute -> Attribute -> Attribute)
-> Ord Attribute
Attribute -> Attribute -> Bool
Attribute -> Attribute -> Ordering
Attribute -> Attribute -> Attribute
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 :: Attribute -> Attribute -> Ordering
compare :: Attribute -> Attribute -> Ordering
$c< :: Attribute -> Attribute -> Bool
< :: Attribute -> Attribute -> Bool
$c<= :: Attribute -> Attribute -> Bool
<= :: Attribute -> Attribute -> Bool
$c> :: Attribute -> Attribute -> Bool
> :: Attribute -> Attribute -> Bool
$c>= :: Attribute -> Attribute -> Bool
>= :: Attribute -> Attribute -> Bool
$cmax :: Attribute -> Attribute -> Attribute
max :: Attribute -> Attribute -> Attribute
$cmin :: Attribute -> Attribute -> Attribute
min :: Attribute -> Attribute -> Attribute
Ord, Int -> Attribute -> ShowS
Attributes -> ShowS
Attribute -> String
(Int -> Attribute -> ShowS)
-> (Attribute -> String) -> (Attributes -> ShowS) -> Show Attribute
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Attribute -> ShowS
showsPrec :: Int -> Attribute -> ShowS
$cshow :: Attribute -> String
show :: Attribute -> String
$cshowList :: Attributes -> ShowS
showList :: Attributes -> ShowS
Show, ReadPrec Attributes
ReadPrec Attribute
Int -> ReadS Attribute
ReadS Attributes
(Int -> ReadS Attribute)
-> ReadS Attributes
-> ReadPrec Attribute
-> ReadPrec Attributes
-> Read Attribute
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Attribute
readsPrec :: Int -> ReadS Attribute
$creadList :: ReadS Attributes
readList :: ReadS Attributes
$creadPrec :: ReadPrec Attribute
readPrec :: ReadPrec Attribute
$creadListPrec :: ReadPrec Attributes
readListPrec :: ReadPrec Attributes
Read)

instance PrintDot Attribute where
  unqtDot :: Attribute -> DotCodeM Doc
unqtDot (Align Align
v)         = Text -> Align -> DotCodeM Doc
forall a. PrintDot a => Text -> a -> DotCodeM Doc
printHtmlField  Text
"ALIGN" Align
v
  unqtDot (BAlign Align
v)        = Text -> Align -> DotCodeM Doc
forall a. PrintDot a => Text -> a -> DotCodeM Doc
printHtmlField  Text
"BALIGN" Align
v
  unqtDot (BGColor Color
v)       = Text -> Color -> DotCodeM Doc
forall a. PrintDot a => Text -> a -> DotCodeM Doc
printHtmlField  Text
"BGCOLOR" Color
v
  unqtDot (Border Word8
v)        = Text -> Word8 -> DotCodeM Doc
forall a. PrintDot a => Text -> a -> DotCodeM Doc
printHtmlField  Text
"BORDER" Word8
v
  unqtDot (CellBorder Word8
v)    = Text -> Word8 -> DotCodeM Doc
forall a. PrintDot a => Text -> a -> DotCodeM Doc
printHtmlField  Text
"CELLBORDER" Word8
v
  unqtDot (CellPadding Word8
v)   = Text -> Word8 -> DotCodeM Doc
forall a. PrintDot a => Text -> a -> DotCodeM Doc
printHtmlField  Text
"CELLPADDING" Word8
v
  unqtDot (CellSpacing Word8
v)   = Text -> Word8 -> DotCodeM Doc
forall a. PrintDot a => Text -> a -> DotCodeM Doc
printHtmlField  Text
"CELLSPACING" Word8
v
  unqtDot (Color Color
v)         = Text -> Color -> DotCodeM Doc
forall a. PrintDot a => Text -> a -> DotCodeM Doc
printHtmlField  Text
"COLOR" Color
v
  unqtDot (ColSpan Word16
v)       = Text -> Word16 -> DotCodeM Doc
forall a. PrintDot a => Text -> a -> DotCodeM Doc
printHtmlField  Text
"COLSPAN" Word16
v
  unqtDot (Columns CellFormat
v)       = Text -> CellFormat -> DotCodeM Doc
forall a. PrintDot a => Text -> a -> DotCodeM Doc
printHtmlField  Text
"COLUMNS" CellFormat
v
  unqtDot (Face Text
v)          = Text -> DotCodeM Doc -> DotCodeM Doc
printHtmlField' Text
"FACE" (DotCodeM Doc -> DotCodeM Doc) -> DotCodeM Doc -> DotCodeM Doc
forall a b. (a -> b) -> a -> b
$ Text -> DotCodeM Doc
escapeAttribute Text
v
  unqtDot (FixedSize Bool
v)     = Text -> DotCodeM Doc -> DotCodeM Doc
printHtmlField' Text
"FIXEDSIZE" (DotCodeM Doc -> DotCodeM Doc) -> DotCodeM Doc -> DotCodeM Doc
forall a b. (a -> b) -> a -> b
$ Bool -> DotCodeM Doc
printBoolHtml Bool
v
  unqtDot (GradientAngle Int
v) = Text -> Int -> DotCodeM Doc
forall a. PrintDot a => Text -> a -> DotCodeM Doc
printHtmlField  Text
"GRADIENTANGLE" Int
v
  unqtDot (Height Word16
v)        = Text -> Word16 -> DotCodeM Doc
forall a. PrintDot a => Text -> a -> DotCodeM Doc
printHtmlField  Text
"HEIGHT" Word16
v
  unqtDot (HRef Text
v)          = Text -> DotCodeM Doc -> DotCodeM Doc
printHtmlField' Text
"HREF" (DotCodeM Doc -> DotCodeM Doc) -> DotCodeM Doc -> DotCodeM Doc
forall a b. (a -> b) -> a -> b
$ Text -> DotCodeM Doc
escapeAttribute Text
v
  unqtDot (ID Text
v)            = Text -> DotCodeM Doc -> DotCodeM Doc
printHtmlField' Text
"ID" (DotCodeM Doc -> DotCodeM Doc) -> DotCodeM Doc -> DotCodeM Doc
forall a b. (a -> b) -> a -> b
$ Text -> DotCodeM Doc
escapeAttribute Text
v
  unqtDot (PointSize Double
v)     = Text -> Double -> DotCodeM Doc
forall a. PrintDot a => Text -> a -> DotCodeM Doc
printHtmlField  Text
"POINT-SIZE" Double
v
  unqtDot (Port PortName
v)          = Text -> DotCodeM Doc -> DotCodeM Doc
printHtmlField' Text
"PORT" (DotCodeM Doc -> DotCodeM Doc)
-> (Text -> DotCodeM Doc) -> Text -> DotCodeM Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> DotCodeM Doc
escapeAttribute (Text -> DotCodeM Doc) -> Text -> DotCodeM Doc
forall a b. (a -> b) -> a -> b
$ PortName -> Text
portName PortName
v
  unqtDot (Rows CellFormat
v)          = Text -> CellFormat -> DotCodeM Doc
forall a. PrintDot a => Text -> a -> DotCodeM Doc
printHtmlField  Text
"ROWS" CellFormat
v
  unqtDot (RowSpan Word16
v)       = Text -> Word16 -> DotCodeM Doc
forall a. PrintDot a => Text -> a -> DotCodeM Doc
printHtmlField  Text
"ROWSPAN" Word16
v
  unqtDot (Scale Scale
v)         = Text -> Scale -> DotCodeM Doc
forall a. PrintDot a => Text -> a -> DotCodeM Doc
printHtmlField  Text
"SCALE" Scale
v
  unqtDot (Sides [Side]
v)         = Text -> [Side] -> DotCodeM Doc
forall a. PrintDot a => Text -> a -> DotCodeM Doc
printHtmlField  Text
"SIDES" [Side]
v
  unqtDot (Src String
v)           = Text -> DotCodeM Doc -> DotCodeM Doc
printHtmlField' Text
"SRC" (DotCodeM Doc -> DotCodeM Doc)
-> (Text -> DotCodeM Doc) -> Text -> DotCodeM Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> DotCodeM Doc
escapeAttribute (Text -> DotCodeM Doc) -> Text -> DotCodeM Doc
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
v
  unqtDot (Style Style
v)         = Text -> Style -> DotCodeM Doc
forall a. PrintDot a => Text -> a -> DotCodeM Doc
printHtmlField  Text
"STYLE" Style
v
  unqtDot (Target Text
v)        = Text -> DotCodeM Doc -> DotCodeM Doc
printHtmlField' Text
"TARGET" (DotCodeM Doc -> DotCodeM Doc) -> DotCodeM Doc -> DotCodeM Doc
forall a b. (a -> b) -> a -> b
$ Text -> DotCodeM Doc
escapeAttribute Text
v
  unqtDot (Title Text
v)         = Text -> DotCodeM Doc -> DotCodeM Doc
printHtmlField' Text
"TITLE" (DotCodeM Doc -> DotCodeM Doc) -> DotCodeM Doc -> DotCodeM Doc
forall a b. (a -> b) -> a -> b
$ Text -> DotCodeM Doc
escapeAttribute Text
v
  unqtDot (VAlign VAlign
v)        = Text -> VAlign -> DotCodeM Doc
forall a. PrintDot a => Text -> a -> DotCodeM Doc
printHtmlField  Text
"VALIGN" VAlign
v
  unqtDot (Width Word16
v)         = Text -> Word16 -> DotCodeM Doc
forall a. PrintDot a => Text -> a -> DotCodeM Doc
printHtmlField  Text
"WIDTH" Word16
v

  unqtListToDot :: Attributes -> DotCodeM Doc
unqtListToDot = DotCodeM [Doc] -> DotCodeM Doc
forall (m :: * -> *). Functor m => m [Doc] -> m Doc
hsep (DotCodeM [Doc] -> DotCodeM Doc)
-> (Attributes -> DotCodeM [Doc]) -> Attributes -> DotCodeM Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Attribute -> DotCodeM Doc) -> Attributes -> 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 Attribute -> DotCodeM Doc
forall a. PrintDot a => a -> DotCodeM Doc
unqtDot

  listToDot :: Attributes -> DotCodeM Doc
listToDot = Attributes -> DotCodeM Doc
forall a. PrintDot a => [a] -> DotCodeM Doc
unqtListToDot

-- | Only to be used when the 'PrintDot' instance of @a@ matches the
--   HTML syntax (i.e. numbers and @Html.*@ values; 'Color' values also
--   seem to work).
printHtmlField   :: (PrintDot a) => T.Text -> a -> DotCode
printHtmlField :: forall a. PrintDot a => Text -> a -> DotCodeM Doc
printHtmlField Text
f = Text -> DotCodeM Doc -> DotCodeM Doc
printHtmlField' Text
f (DotCodeM Doc -> DotCodeM Doc)
-> (a -> DotCodeM Doc) -> a -> DotCodeM Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> DotCodeM Doc
forall a. PrintDot a => a -> DotCodeM Doc
unqtDot

printHtmlField'     :: T.Text -> DotCode -> DotCode
printHtmlField' :: Text -> DotCodeM Doc -> DotCodeM Doc
printHtmlField' Text
f DotCodeM Doc
v = Text -> DotCodeM Doc
forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
f DotCodeM Doc -> DotCodeM Doc -> DotCodeM Doc
forall a. Semigroup a => a -> a -> a
<> DotCodeM Doc
forall (m :: * -> *). Applicative m => m Doc
equals DotCodeM Doc -> DotCodeM Doc -> DotCodeM Doc
forall a. Semigroup a => a -> a -> a
<> DotCodeM Doc -> DotCodeM Doc
forall (m :: * -> *). Functor m => m Doc -> m Doc
dquotes DotCodeM Doc
v

instance ParseDot Attribute where
  parseUnqt :: Parse Attribute
parseUnqt = [Parse Attribute] -> Parse Attribute
forall (p :: * -> *) a. PolyParse p => [p a] -> p a
oneOf [ (Align -> Attribute) -> String -> Parse Attribute
forall a.
ParseDot a =>
(a -> Attribute) -> String -> Parse Attribute
parseHtmlField  Align -> Attribute
Align String
"ALIGN"
                    , (Align -> Attribute) -> String -> Parse Attribute
forall a.
ParseDot a =>
(a -> Attribute) -> String -> Parse Attribute
parseHtmlField  Align -> Attribute
BAlign String
"BALIGN"
                    , (Color -> Attribute) -> String -> Parse Attribute
forall a.
ParseDot a =>
(a -> Attribute) -> String -> Parse Attribute
parseHtmlField  Color -> Attribute
BGColor String
"BGCOLOR"
                    , (Word8 -> Attribute) -> String -> Parse Attribute
forall a.
ParseDot a =>
(a -> Attribute) -> String -> Parse Attribute
parseHtmlField  Word8 -> Attribute
Border String
"BORDER"
                    , (Word8 -> Attribute) -> String -> Parse Attribute
forall a.
ParseDot a =>
(a -> Attribute) -> String -> Parse Attribute
parseHtmlField  Word8 -> Attribute
CellBorder String
"CELLBORDER"
                    , (Word8 -> Attribute) -> String -> Parse Attribute
forall a.
ParseDot a =>
(a -> Attribute) -> String -> Parse Attribute
parseHtmlField  Word8 -> Attribute
CellPadding String
"CELLPADDING"
                    , (Word8 -> Attribute) -> String -> Parse Attribute
forall a.
ParseDot a =>
(a -> Attribute) -> String -> Parse Attribute
parseHtmlField  Word8 -> Attribute
CellSpacing String
"CELLSPACING"
                    , (Color -> Attribute) -> String -> Parse Attribute
forall a.
ParseDot a =>
(a -> Attribute) -> String -> Parse Attribute
parseHtmlField  Color -> Attribute
Color String
"COLOR"
                    , (Word16 -> Attribute) -> String -> Parse Attribute
forall a.
ParseDot a =>
(a -> Attribute) -> String -> Parse Attribute
parseHtmlField  Word16 -> Attribute
ColSpan String
"COLSPAN"
                    , (CellFormat -> Attribute) -> String -> Parse Attribute
forall a.
ParseDot a =>
(a -> Attribute) -> String -> Parse Attribute
parseHtmlField  CellFormat -> Attribute
Columns String
"COLUMNS"
                    , (Text -> Attribute)
-> String -> Parser GraphvizState Text -> Parse Attribute
forall a. (a -> Attribute) -> String -> Parse a -> Parse Attribute
parseHtmlField' Text -> Attribute
Face String
"FACE" Parser GraphvizState Text
unescapeAttribute
                    , (Bool -> Attribute) -> String -> Parse Bool -> Parse Attribute
forall a. (a -> Attribute) -> String -> Parse a -> Parse Attribute
parseHtmlField' Bool -> Attribute
FixedSize String
"FIXEDSIZE" Parse Bool
parseBoolHtml
                    , (Int -> Attribute) -> String -> Parse Attribute
forall a.
ParseDot a =>
(a -> Attribute) -> String -> Parse Attribute
parseHtmlField  Int -> Attribute
GradientAngle String
"GRADIENTANGLE"
                    , (Word16 -> Attribute) -> String -> Parse Attribute
forall a.
ParseDot a =>
(a -> Attribute) -> String -> Parse Attribute
parseHtmlField  Word16 -> Attribute
Height String
"HEIGHT"
                    , (Text -> Attribute)
-> String -> Parser GraphvizState Text -> Parse Attribute
forall a. (a -> Attribute) -> String -> Parse a -> Parse Attribute
parseHtmlField' Text -> Attribute
HRef String
"HREF" Parser GraphvizState Text
unescapeAttribute
                    , (Text -> Attribute)
-> String -> Parser GraphvizState Text -> Parse Attribute
forall a. (a -> Attribute) -> String -> Parse a -> Parse Attribute
parseHtmlField' Text -> Attribute
ID String
"ID" Parser GraphvizState Text
unescapeAttribute
                    , (Double -> Attribute) -> String -> Parse Attribute
forall a.
ParseDot a =>
(a -> Attribute) -> String -> Parse Attribute
parseHtmlField  Double -> Attribute
PointSize String
"POINT-SIZE"
                    , (Text -> Attribute)
-> String -> Parser GraphvizState Text -> Parse Attribute
forall a. (a -> Attribute) -> String -> Parse a -> Parse Attribute
parseHtmlField' (PortName -> Attribute
Port (PortName -> Attribute) -> (Text -> PortName) -> Text -> Attribute
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> PortName
PN) String
"PORT" Parser GraphvizState Text
unescapeAttribute
                    , (CellFormat -> Attribute) -> String -> Parse Attribute
forall a.
ParseDot a =>
(a -> Attribute) -> String -> Parse Attribute
parseHtmlField  CellFormat -> Attribute
Rows String
"ROWS"
                    , (Word16 -> Attribute) -> String -> Parse Attribute
forall a.
ParseDot a =>
(a -> Attribute) -> String -> Parse Attribute
parseHtmlField  Word16 -> Attribute
RowSpan String
"ROWSPAN"
                    , (Scale -> Attribute) -> String -> Parse Attribute
forall a.
ParseDot a =>
(a -> Attribute) -> String -> Parse Attribute
parseHtmlField  Scale -> Attribute
Scale String
"SCALE"
                    , ([Side] -> Attribute) -> String -> Parse Attribute
forall a.
ParseDot a =>
(a -> Attribute) -> String -> Parse Attribute
parseHtmlField  [Side] -> Attribute
Sides String
"SIDES"
                    , (String -> Attribute) -> String -> Parse String -> Parse Attribute
forall a. (a -> Attribute) -> String -> Parse a -> Parse Attribute
parseHtmlField' String -> Attribute
Src String
"SRC" (Parse String -> Parse Attribute)
-> Parse String -> Parse Attribute
forall a b. (a -> b) -> a -> b
$ (Text -> String) -> Parser GraphvizState Text -> Parse String
forall a b.
(a -> b) -> Parser GraphvizState a -> Parser GraphvizState b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> String
T.unpack Parser GraphvizState Text
unescapeAttribute
                    , (Style -> Attribute) -> String -> Parse Attribute
forall a.
ParseDot a =>
(a -> Attribute) -> String -> Parse Attribute
parseHtmlField  Style -> Attribute
Style String
"STYLE"
                    , (Text -> Attribute)
-> String -> Parser GraphvizState Text -> Parse Attribute
forall a. (a -> Attribute) -> String -> Parse a -> Parse Attribute
parseHtmlField' Text -> Attribute
Target String
"TARGET" Parser GraphvizState Text
unescapeAttribute
                    , (Text -> Attribute)
-> String -> Parser GraphvizState Text -> Parse Attribute
forall a. (a -> Attribute) -> String -> Parse a -> Parse Attribute
parseHtmlField' Text -> Attribute
Title String
"TITLE" Parser GraphvizState Text
unescapeAttribute
                      Parse Attribute -> Parse Attribute -> Parse Attribute
forall s a. Parser s a -> Parser s a -> Parser s a
`onFail`
                      (Text -> Attribute)
-> String -> Parser GraphvizState Text -> Parse Attribute
forall a. (a -> Attribute) -> String -> Parse a -> Parse Attribute
parseHtmlField' Text -> Attribute
Title String
"TOOLTIP" Parser GraphvizState Text
unescapeAttribute
                    , (VAlign -> Attribute) -> String -> Parse Attribute
forall a.
ParseDot a =>
(a -> Attribute) -> String -> Parse Attribute
parseHtmlField  VAlign -> Attribute
VAlign String
"VALIGN"
                    , (Word16 -> Attribute) -> String -> Parse Attribute
forall a.
ParseDot a =>
(a -> Attribute) -> String -> Parse Attribute
parseHtmlField  Word16 -> Attribute
Width String
"WIDTH"
                    ]

  parse :: Parse Attribute
parse = Parse Attribute
forall a. ParseDot a => Parse a
parseUnqt

  parseUnqtList :: Parse Attributes
parseUnqtList = Parse Attribute -> Parser GraphvizState () -> Parse Attributes
forall (p :: * -> *) a sep. PolyParse p => p a -> p sep -> p [a]
sepBy Parse Attribute
forall a. ParseDot a => Parse a
parseUnqt Parser GraphvizState ()
whitespace1 -- needs at least one whitespace char

  parseList :: Parse Attributes
parseList = Parse Attributes
forall a. ParseDot a => Parse [a]
parseUnqtList



parseHtmlField     :: (ParseDot a) => (a -> Attribute) -> String
                  -> Parse Attribute
parseHtmlField :: forall a.
ParseDot a =>
(a -> Attribute) -> String -> Parse Attribute
parseHtmlField a -> Attribute
c String
f = (a -> Attribute) -> String -> Parse a -> Parse Attribute
forall a. (a -> Attribute) -> String -> Parse a -> Parse Attribute
parseHtmlField' a -> Attribute
c String
f Parse a
forall a. ParseDot a => Parse a
parseUnqt

parseHtmlField'       :: (a -> Attribute) -> String -> Parse a
                     -> Parse Attribute
parseHtmlField' :: forall a. (a -> Attribute) -> String -> Parse a -> Parse Attribute
parseHtmlField' a -> Attribute
c String
f Parse a
p = String -> Parser GraphvizState ()
string String
f
                        Parser GraphvizState ()
-> Parser GraphvizState () -> Parser GraphvizState ()
forall a b.
Parser GraphvizState a
-> Parser GraphvizState b -> Parser GraphvizState b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser GraphvizState ()
parseEq
                        Parser GraphvizState () -> Parse Attribute -> Parse Attribute
forall a b.
Parser GraphvizState a
-> Parser GraphvizState b -> Parser GraphvizState b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ( a -> Attribute
c (a -> Attribute) -> Parse a -> Parse Attribute
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ( Parse a -> Parse a
forall a. Parse a -> Parse a
quotedParse Parse a
p
                                      Parse a -> ShowS -> Parse a
forall a. Parser GraphvizState a -> ShowS -> Parser GraphvizState a
forall (p :: * -> *) a. Commitment p => p a -> ShowS -> p a
`adjustErr`
                                      ((String
"Can't parse HTML.Attribute." String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
f String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n\t")String -> ShowS
forall a. [a] -> [a] -> [a]
++)
                                   )
                           )
-- Can't use liftEqParse, etc. here because it causes backtracking
-- problems when the attributes could apply to multiple constructors.
-- This includes using commit! (Example: if it starts with a FONT tag,
-- is it a Table or Text?

-- | Specifies horizontal placement. When an object is allocated more
--   space than required, this value determines where the extra space
--   is placed left and right of the object.
data Align = HLeft
           | HCenter -- ^ Default value.
           | HRight
           | HText -- ^ 'LabelCell' values only; aligns lines of text
                   --   using the full cell width. The alignment of a
                   --   line is determined by its (possibly implicit)
                   --   associated 'Newline' element.
           deriving (Align -> Align -> Bool
(Align -> Align -> Bool) -> (Align -> Align -> Bool) -> Eq Align
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Align -> Align -> Bool
== :: Align -> Align -> Bool
$c/= :: Align -> Align -> Bool
/= :: Align -> Align -> Bool
Eq, Eq Align
Eq Align =>
(Align -> Align -> Ordering)
-> (Align -> Align -> Bool)
-> (Align -> Align -> Bool)
-> (Align -> Align -> Bool)
-> (Align -> Align -> Bool)
-> (Align -> Align -> Align)
-> (Align -> Align -> Align)
-> Ord Align
Align -> Align -> Bool
Align -> Align -> Ordering
Align -> Align -> Align
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 :: Align -> Align -> Ordering
compare :: Align -> Align -> Ordering
$c< :: Align -> Align -> Bool
< :: Align -> Align -> Bool
$c<= :: Align -> Align -> Bool
<= :: Align -> Align -> Bool
$c> :: Align -> Align -> Bool
> :: Align -> Align -> Bool
$c>= :: Align -> Align -> Bool
>= :: Align -> Align -> Bool
$cmax :: Align -> Align -> Align
max :: Align -> Align -> Align
$cmin :: Align -> Align -> Align
min :: Align -> Align -> Align
Ord, Align
Align -> Align -> Bounded Align
forall a. a -> a -> Bounded a
$cminBound :: Align
minBound :: Align
$cmaxBound :: Align
maxBound :: Align
Bounded, Int -> Align
Align -> Int
Align -> [Align]
Align -> Align
Align -> Align -> [Align]
Align -> Align -> Align -> [Align]
(Align -> Align)
-> (Align -> Align)
-> (Int -> Align)
-> (Align -> Int)
-> (Align -> [Align])
-> (Align -> Align -> [Align])
-> (Align -> Align -> [Align])
-> (Align -> Align -> Align -> [Align])
-> Enum Align
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Align -> Align
succ :: Align -> Align
$cpred :: Align -> Align
pred :: Align -> Align
$ctoEnum :: Int -> Align
toEnum :: Int -> Align
$cfromEnum :: Align -> Int
fromEnum :: Align -> Int
$cenumFrom :: Align -> [Align]
enumFrom :: Align -> [Align]
$cenumFromThen :: Align -> Align -> [Align]
enumFromThen :: Align -> Align -> [Align]
$cenumFromTo :: Align -> Align -> [Align]
enumFromTo :: Align -> Align -> [Align]
$cenumFromThenTo :: Align -> Align -> Align -> [Align]
enumFromThenTo :: Align -> Align -> Align -> [Align]
Enum, Int -> Align -> ShowS
[Align] -> ShowS
Align -> String
(Int -> Align -> ShowS)
-> (Align -> String) -> ([Align] -> ShowS) -> Show Align
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Align -> ShowS
showsPrec :: Int -> Align -> ShowS
$cshow :: Align -> String
show :: Align -> String
$cshowList :: [Align] -> ShowS
showList :: [Align] -> ShowS
Show, ReadPrec [Align]
ReadPrec Align
Int -> ReadS Align
ReadS [Align]
(Int -> ReadS Align)
-> ReadS [Align]
-> ReadPrec Align
-> ReadPrec [Align]
-> Read Align
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Align
readsPrec :: Int -> ReadS Align
$creadList :: ReadS [Align]
readList :: ReadS [Align]
$creadPrec :: ReadPrec Align
readPrec :: ReadPrec Align
$creadListPrec :: ReadPrec [Align]
readListPrec :: ReadPrec [Align]
Read)

instance PrintDot Align where
  unqtDot :: Align -> DotCodeM Doc
unqtDot Align
HLeft   = Text -> DotCodeM Doc
forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"LEFT"
  unqtDot Align
HCenter = Text -> DotCodeM Doc
forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"CENTER"
  unqtDot Align
HRight  = Text -> DotCodeM Doc
forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"RIGHT"
  unqtDot Align
HText   = Text -> DotCodeM Doc
forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"TEXT"

instance ParseDot Align where
  parseUnqt :: Parse Align
parseUnqt = [Parse Align] -> Parse Align
forall (p :: * -> *) a. PolyParse p => [p a] -> p a
oneOf [ Align -> String -> Parse Align
forall a. a -> String -> Parse a
stringRep Align
HLeft String
"LEFT"
                    , Align -> String -> Parse Align
forall a. a -> String -> Parse a
stringRep Align
HCenter String
"CENTER"
                    , Align -> String -> Parse Align
forall a. a -> String -> Parse a
stringRep Align
HRight String
"RIGHT"
                    , Align -> String -> Parse Align
forall a. a -> String -> Parse a
stringRep Align
HText String
"TEXT"
                    ]

  parse :: Parse Align
parse = Parse Align
forall a. ParseDot a => Parse a
parseUnqt

-- | Specifies vertical placement. When an object is allocated more
--   space than required, this value determines where the extra space
--   is placed above and below the object.
data VAlign = HTop
            | HMiddle -- ^ Default value.
            | HBottom
            deriving (VAlign -> VAlign -> Bool
(VAlign -> VAlign -> Bool)
-> (VAlign -> VAlign -> Bool) -> Eq VAlign
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: VAlign -> VAlign -> Bool
== :: VAlign -> VAlign -> Bool
$c/= :: VAlign -> VAlign -> Bool
/= :: VAlign -> VAlign -> Bool
Eq, Eq VAlign
Eq VAlign =>
(VAlign -> VAlign -> Ordering)
-> (VAlign -> VAlign -> Bool)
-> (VAlign -> VAlign -> Bool)
-> (VAlign -> VAlign -> Bool)
-> (VAlign -> VAlign -> Bool)
-> (VAlign -> VAlign -> VAlign)
-> (VAlign -> VAlign -> VAlign)
-> Ord VAlign
VAlign -> VAlign -> Bool
VAlign -> VAlign -> Ordering
VAlign -> VAlign -> VAlign
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 :: VAlign -> VAlign -> Ordering
compare :: VAlign -> VAlign -> Ordering
$c< :: VAlign -> VAlign -> Bool
< :: VAlign -> VAlign -> Bool
$c<= :: VAlign -> VAlign -> Bool
<= :: VAlign -> VAlign -> Bool
$c> :: VAlign -> VAlign -> Bool
> :: VAlign -> VAlign -> Bool
$c>= :: VAlign -> VAlign -> Bool
>= :: VAlign -> VAlign -> Bool
$cmax :: VAlign -> VAlign -> VAlign
max :: VAlign -> VAlign -> VAlign
$cmin :: VAlign -> VAlign -> VAlign
min :: VAlign -> VAlign -> VAlign
Ord, VAlign
VAlign -> VAlign -> Bounded VAlign
forall a. a -> a -> Bounded a
$cminBound :: VAlign
minBound :: VAlign
$cmaxBound :: VAlign
maxBound :: VAlign
Bounded, Int -> VAlign
VAlign -> Int
VAlign -> [VAlign]
VAlign -> VAlign
VAlign -> VAlign -> [VAlign]
VAlign -> VAlign -> VAlign -> [VAlign]
(VAlign -> VAlign)
-> (VAlign -> VAlign)
-> (Int -> VAlign)
-> (VAlign -> Int)
-> (VAlign -> [VAlign])
-> (VAlign -> VAlign -> [VAlign])
-> (VAlign -> VAlign -> [VAlign])
-> (VAlign -> VAlign -> VAlign -> [VAlign])
-> Enum VAlign
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: VAlign -> VAlign
succ :: VAlign -> VAlign
$cpred :: VAlign -> VAlign
pred :: VAlign -> VAlign
$ctoEnum :: Int -> VAlign
toEnum :: Int -> VAlign
$cfromEnum :: VAlign -> Int
fromEnum :: VAlign -> Int
$cenumFrom :: VAlign -> [VAlign]
enumFrom :: VAlign -> [VAlign]
$cenumFromThen :: VAlign -> VAlign -> [VAlign]
enumFromThen :: VAlign -> VAlign -> [VAlign]
$cenumFromTo :: VAlign -> VAlign -> [VAlign]
enumFromTo :: VAlign -> VAlign -> [VAlign]
$cenumFromThenTo :: VAlign -> VAlign -> VAlign -> [VAlign]
enumFromThenTo :: VAlign -> VAlign -> VAlign -> [VAlign]
Enum, Int -> VAlign -> ShowS
[VAlign] -> ShowS
VAlign -> String
(Int -> VAlign -> ShowS)
-> (VAlign -> String) -> ([VAlign] -> ShowS) -> Show VAlign
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> VAlign -> ShowS
showsPrec :: Int -> VAlign -> ShowS
$cshow :: VAlign -> String
show :: VAlign -> String
$cshowList :: [VAlign] -> ShowS
showList :: [VAlign] -> ShowS
Show, ReadPrec [VAlign]
ReadPrec VAlign
Int -> ReadS VAlign
ReadS [VAlign]
(Int -> ReadS VAlign)
-> ReadS [VAlign]
-> ReadPrec VAlign
-> ReadPrec [VAlign]
-> Read VAlign
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS VAlign
readsPrec :: Int -> ReadS VAlign
$creadList :: ReadS [VAlign]
readList :: ReadS [VAlign]
$creadPrec :: ReadPrec VAlign
readPrec :: ReadPrec VAlign
$creadListPrec :: ReadPrec [VAlign]
readListPrec :: ReadPrec [VAlign]
Read)

instance PrintDot VAlign where
  unqtDot :: VAlign -> DotCodeM Doc
unqtDot VAlign
HTop    = Text -> DotCodeM Doc
forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"TOP"
  unqtDot VAlign
HMiddle = Text -> DotCodeM Doc
forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"MIDDLE"
  unqtDot VAlign
HBottom = Text -> DotCodeM Doc
forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"BOTTOM"

instance ParseDot VAlign where
  parseUnqt :: Parse VAlign
parseUnqt = [Parse VAlign] -> Parse VAlign
forall (p :: * -> *) a. PolyParse p => [p a] -> p a
oneOf [ VAlign -> String -> Parse VAlign
forall a. a -> String -> Parse a
stringRep VAlign
HTop String
"TOP"
                    , VAlign -> String -> Parse VAlign
forall a. a -> String -> Parse a
stringRep VAlign
HMiddle String
"MIDDLE"
                    , VAlign -> String -> Parse VAlign
forall a. a -> String -> Parse a
stringRep VAlign
HBottom String
"BOTTOM"
                    ]

  parse :: Parse VAlign
parse = Parse VAlign
forall a. ParseDot a => Parse a
parseUnqt

data CellFormat = RuleBetween
                deriving (CellFormat -> CellFormat -> Bool
(CellFormat -> CellFormat -> Bool)
-> (CellFormat -> CellFormat -> Bool) -> Eq CellFormat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CellFormat -> CellFormat -> Bool
== :: CellFormat -> CellFormat -> Bool
$c/= :: CellFormat -> CellFormat -> Bool
/= :: CellFormat -> CellFormat -> Bool
Eq, Eq CellFormat
Eq CellFormat =>
(CellFormat -> CellFormat -> Ordering)
-> (CellFormat -> CellFormat -> Bool)
-> (CellFormat -> CellFormat -> Bool)
-> (CellFormat -> CellFormat -> Bool)
-> (CellFormat -> CellFormat -> Bool)
-> (CellFormat -> CellFormat -> CellFormat)
-> (CellFormat -> CellFormat -> CellFormat)
-> Ord CellFormat
CellFormat -> CellFormat -> Bool
CellFormat -> CellFormat -> Ordering
CellFormat -> CellFormat -> CellFormat
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 :: CellFormat -> CellFormat -> Ordering
compare :: CellFormat -> CellFormat -> Ordering
$c< :: CellFormat -> CellFormat -> Bool
< :: CellFormat -> CellFormat -> Bool
$c<= :: CellFormat -> CellFormat -> Bool
<= :: CellFormat -> CellFormat -> Bool
$c> :: CellFormat -> CellFormat -> Bool
> :: CellFormat -> CellFormat -> Bool
$c>= :: CellFormat -> CellFormat -> Bool
>= :: CellFormat -> CellFormat -> Bool
$cmax :: CellFormat -> CellFormat -> CellFormat
max :: CellFormat -> CellFormat -> CellFormat
$cmin :: CellFormat -> CellFormat -> CellFormat
min :: CellFormat -> CellFormat -> CellFormat
Ord, CellFormat
CellFormat -> CellFormat -> Bounded CellFormat
forall a. a -> a -> Bounded a
$cminBound :: CellFormat
minBound :: CellFormat
$cmaxBound :: CellFormat
maxBound :: CellFormat
Bounded, Int -> CellFormat
CellFormat -> Int
CellFormat -> [CellFormat]
CellFormat -> CellFormat
CellFormat -> CellFormat -> [CellFormat]
CellFormat -> CellFormat -> CellFormat -> [CellFormat]
(CellFormat -> CellFormat)
-> (CellFormat -> CellFormat)
-> (Int -> CellFormat)
-> (CellFormat -> Int)
-> (CellFormat -> [CellFormat])
-> (CellFormat -> CellFormat -> [CellFormat])
-> (CellFormat -> CellFormat -> [CellFormat])
-> (CellFormat -> CellFormat -> CellFormat -> [CellFormat])
-> Enum CellFormat
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: CellFormat -> CellFormat
succ :: CellFormat -> CellFormat
$cpred :: CellFormat -> CellFormat
pred :: CellFormat -> CellFormat
$ctoEnum :: Int -> CellFormat
toEnum :: Int -> CellFormat
$cfromEnum :: CellFormat -> Int
fromEnum :: CellFormat -> Int
$cenumFrom :: CellFormat -> [CellFormat]
enumFrom :: CellFormat -> [CellFormat]
$cenumFromThen :: CellFormat -> CellFormat -> [CellFormat]
enumFromThen :: CellFormat -> CellFormat -> [CellFormat]
$cenumFromTo :: CellFormat -> CellFormat -> [CellFormat]
enumFromTo :: CellFormat -> CellFormat -> [CellFormat]
$cenumFromThenTo :: CellFormat -> CellFormat -> CellFormat -> [CellFormat]
enumFromThenTo :: CellFormat -> CellFormat -> CellFormat -> [CellFormat]
Enum, Int -> CellFormat -> ShowS
[CellFormat] -> ShowS
CellFormat -> String
(Int -> CellFormat -> ShowS)
-> (CellFormat -> String)
-> ([CellFormat] -> ShowS)
-> Show CellFormat
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CellFormat -> ShowS
showsPrec :: Int -> CellFormat -> ShowS
$cshow :: CellFormat -> String
show :: CellFormat -> String
$cshowList :: [CellFormat] -> ShowS
showList :: [CellFormat] -> ShowS
Show, ReadPrec [CellFormat]
ReadPrec CellFormat
Int -> ReadS CellFormat
ReadS [CellFormat]
(Int -> ReadS CellFormat)
-> ReadS [CellFormat]
-> ReadPrec CellFormat
-> ReadPrec [CellFormat]
-> Read CellFormat
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS CellFormat
readsPrec :: Int -> ReadS CellFormat
$creadList :: ReadS [CellFormat]
readList :: ReadS [CellFormat]
$creadPrec :: ReadPrec CellFormat
readPrec :: ReadPrec CellFormat
$creadListPrec :: ReadPrec [CellFormat]
readListPrec :: ReadPrec [CellFormat]
Read)

instance PrintDot CellFormat where
  unqtDot :: CellFormat -> DotCodeM Doc
unqtDot CellFormat
RuleBetween = Text -> DotCodeM Doc
forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"*"

instance ParseDot CellFormat where
  parseUnqt :: Parse CellFormat
parseUnqt = CellFormat -> String -> Parse CellFormat
forall a. a -> String -> Parse a
stringRep CellFormat
RuleBetween String
"*"

  parse :: Parse CellFormat
parse = Parse CellFormat
forall a. ParseDot a => Parse a
parseUnqt

-- | Specifies how an image will use any extra space available in its
--   cell.  If undefined, the image inherits the value of the
--   @ImageScale@ attribute.
data Scale = NaturalSize -- ^ Default value.
           | ScaleUniformly
           | ExpandWidth
           | ExpandHeight
           | ExpandBoth
           deriving (Scale -> Scale -> Bool
(Scale -> Scale -> Bool) -> (Scale -> Scale -> Bool) -> Eq Scale
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Scale -> Scale -> Bool
== :: Scale -> Scale -> Bool
$c/= :: Scale -> Scale -> Bool
/= :: Scale -> Scale -> Bool
Eq, Eq Scale
Eq Scale =>
(Scale -> Scale -> Ordering)
-> (Scale -> Scale -> Bool)
-> (Scale -> Scale -> Bool)
-> (Scale -> Scale -> Bool)
-> (Scale -> Scale -> Bool)
-> (Scale -> Scale -> Scale)
-> (Scale -> Scale -> Scale)
-> Ord Scale
Scale -> Scale -> Bool
Scale -> Scale -> Ordering
Scale -> Scale -> Scale
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 :: Scale -> Scale -> Ordering
compare :: Scale -> Scale -> Ordering
$c< :: Scale -> Scale -> Bool
< :: Scale -> Scale -> Bool
$c<= :: Scale -> Scale -> Bool
<= :: Scale -> Scale -> Bool
$c> :: Scale -> Scale -> Bool
> :: Scale -> Scale -> Bool
$c>= :: Scale -> Scale -> Bool
>= :: Scale -> Scale -> Bool
$cmax :: Scale -> Scale -> Scale
max :: Scale -> Scale -> Scale
$cmin :: Scale -> Scale -> Scale
min :: Scale -> Scale -> Scale
Ord, Scale
Scale -> Scale -> Bounded Scale
forall a. a -> a -> Bounded a
$cminBound :: Scale
minBound :: Scale
$cmaxBound :: Scale
maxBound :: Scale
Bounded, Int -> Scale
Scale -> Int
Scale -> [Scale]
Scale -> Scale
Scale -> Scale -> [Scale]
Scale -> Scale -> Scale -> [Scale]
(Scale -> Scale)
-> (Scale -> Scale)
-> (Int -> Scale)
-> (Scale -> Int)
-> (Scale -> [Scale])
-> (Scale -> Scale -> [Scale])
-> (Scale -> Scale -> [Scale])
-> (Scale -> Scale -> Scale -> [Scale])
-> Enum Scale
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Scale -> Scale
succ :: Scale -> Scale
$cpred :: Scale -> Scale
pred :: Scale -> Scale
$ctoEnum :: Int -> Scale
toEnum :: Int -> Scale
$cfromEnum :: Scale -> Int
fromEnum :: Scale -> Int
$cenumFrom :: Scale -> [Scale]
enumFrom :: Scale -> [Scale]
$cenumFromThen :: Scale -> Scale -> [Scale]
enumFromThen :: Scale -> Scale -> [Scale]
$cenumFromTo :: Scale -> Scale -> [Scale]
enumFromTo :: Scale -> Scale -> [Scale]
$cenumFromThenTo :: Scale -> Scale -> Scale -> [Scale]
enumFromThenTo :: Scale -> Scale -> Scale -> [Scale]
Enum, Int -> Scale -> ShowS
[Scale] -> ShowS
Scale -> String
(Int -> Scale -> ShowS)
-> (Scale -> String) -> ([Scale] -> ShowS) -> Show Scale
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Scale -> ShowS
showsPrec :: Int -> Scale -> ShowS
$cshow :: Scale -> String
show :: Scale -> String
$cshowList :: [Scale] -> ShowS
showList :: [Scale] -> ShowS
Show, ReadPrec [Scale]
ReadPrec Scale
Int -> ReadS Scale
ReadS [Scale]
(Int -> ReadS Scale)
-> ReadS [Scale]
-> ReadPrec Scale
-> ReadPrec [Scale]
-> Read Scale
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Scale
readsPrec :: Int -> ReadS Scale
$creadList :: ReadS [Scale]
readList :: ReadS [Scale]
$creadPrec :: ReadPrec Scale
readPrec :: ReadPrec Scale
$creadListPrec :: ReadPrec [Scale]
readListPrec :: ReadPrec [Scale]
Read)

instance PrintDot Scale where
  unqtDot :: Scale -> DotCodeM Doc
unqtDot Scale
NaturalSize    = Text -> DotCodeM Doc
forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"FALSE"
  unqtDot Scale
ScaleUniformly = Text -> DotCodeM Doc
forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"TRUE"
  unqtDot Scale
ExpandWidth    = Text -> DotCodeM Doc
forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"WIDTH"
  unqtDot Scale
ExpandHeight   = Text -> DotCodeM Doc
forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"HEIGHT"
  unqtDot Scale
ExpandBoth     = Text -> DotCodeM Doc
forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"BOTH"

instance ParseDot Scale where
  parseUnqt :: Parse Scale
parseUnqt = [Parse Scale] -> Parse Scale
forall (p :: * -> *) a. PolyParse p => [p a] -> p a
oneOf [ Scale -> String -> Parse Scale
forall a. a -> String -> Parse a
stringRep Scale
NaturalSize String
"FALSE"
                    , Scale -> String -> Parse Scale
forall a. a -> String -> Parse a
stringRep Scale
ScaleUniformly String
"TRUE"
                    , Scale -> String -> Parse Scale
forall a. a -> String -> Parse a
stringRep Scale
ExpandWidth String
"WIDTH"
                    , Scale -> String -> Parse Scale
forall a. a -> String -> Parse a
stringRep Scale
ExpandHeight String
"HEIGHT"
                    , Scale -> String -> Parse Scale
forall a. a -> String -> Parse a
stringRep Scale
ExpandBoth String
"BOTH"
                    ]

  parse :: Parse Scale
parse = Parse Scale
forall a. ParseDot a => Parse a
parseUnqt

-- | Which sides of a border in a cell or table should be drawn, if a
--   border is drawn.
data Side = LeftSide
          | RightSide
          | TopSide
          | BottomSide
          deriving (Side -> Side -> Bool
(Side -> Side -> Bool) -> (Side -> Side -> Bool) -> Eq Side
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Side -> Side -> Bool
== :: Side -> Side -> Bool
$c/= :: Side -> Side -> Bool
/= :: Side -> Side -> Bool
Eq, Eq Side
Eq Side =>
(Side -> Side -> Ordering)
-> (Side -> Side -> Bool)
-> (Side -> Side -> Bool)
-> (Side -> Side -> Bool)
-> (Side -> Side -> Bool)
-> (Side -> Side -> Side)
-> (Side -> Side -> Side)
-> Ord Side
Side -> Side -> Bool
Side -> Side -> Ordering
Side -> Side -> Side
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 :: Side -> Side -> Ordering
compare :: Side -> Side -> Ordering
$c< :: Side -> Side -> Bool
< :: Side -> Side -> Bool
$c<= :: Side -> Side -> Bool
<= :: Side -> Side -> Bool
$c> :: Side -> Side -> Bool
> :: Side -> Side -> Bool
$c>= :: Side -> Side -> Bool
>= :: Side -> Side -> Bool
$cmax :: Side -> Side -> Side
max :: Side -> Side -> Side
$cmin :: Side -> Side -> Side
min :: Side -> Side -> Side
Ord, Side
Side -> Side -> Bounded Side
forall a. a -> a -> Bounded a
$cminBound :: Side
minBound :: Side
$cmaxBound :: Side
maxBound :: Side
Bounded, Int -> Side
Side -> Int
Side -> [Side]
Side -> Side
Side -> Side -> [Side]
Side -> Side -> Side -> [Side]
(Side -> Side)
-> (Side -> Side)
-> (Int -> Side)
-> (Side -> Int)
-> (Side -> [Side])
-> (Side -> Side -> [Side])
-> (Side -> Side -> [Side])
-> (Side -> Side -> Side -> [Side])
-> Enum Side
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Side -> Side
succ :: Side -> Side
$cpred :: Side -> Side
pred :: Side -> Side
$ctoEnum :: Int -> Side
toEnum :: Int -> Side
$cfromEnum :: Side -> Int
fromEnum :: Side -> Int
$cenumFrom :: Side -> [Side]
enumFrom :: Side -> [Side]
$cenumFromThen :: Side -> Side -> [Side]
enumFromThen :: Side -> Side -> [Side]
$cenumFromTo :: Side -> Side -> [Side]
enumFromTo :: Side -> Side -> [Side]
$cenumFromThenTo :: Side -> Side -> Side -> [Side]
enumFromThenTo :: Side -> Side -> Side -> [Side]
Enum, Int -> Side -> ShowS
[Side] -> ShowS
Side -> String
(Int -> Side -> ShowS)
-> (Side -> String) -> ([Side] -> ShowS) -> Show Side
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Side -> ShowS
showsPrec :: Int -> Side -> ShowS
$cshow :: Side -> String
show :: Side -> String
$cshowList :: [Side] -> ShowS
showList :: [Side] -> ShowS
Show, ReadPrec [Side]
ReadPrec Side
Int -> ReadS Side
ReadS [Side]
(Int -> ReadS Side)
-> ReadS [Side] -> ReadPrec Side -> ReadPrec [Side] -> Read Side
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Side
readsPrec :: Int -> ReadS Side
$creadList :: ReadS [Side]
readList :: ReadS [Side]
$creadPrec :: ReadPrec Side
readPrec :: ReadPrec Side
$creadListPrec :: ReadPrec [Side]
readListPrec :: ReadPrec [Side]
Read)

instance PrintDot Side where
  unqtDot :: Side -> DotCodeM Doc
unqtDot Side
LeftSide   = Text -> DotCodeM Doc
forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"L"
  unqtDot Side
RightSide  = Text -> DotCodeM Doc
forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"R"
  unqtDot Side
TopSide    = Text -> DotCodeM Doc
forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"T"
  unqtDot Side
BottomSide = Text -> DotCodeM Doc
forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"B"

  unqtListToDot :: [Side] -> DotCodeM Doc
unqtListToDot = DotCodeM [Doc] -> DotCodeM Doc
forall (m :: * -> *). Functor m => m [Doc] -> m Doc
hcat (DotCodeM [Doc] -> DotCodeM Doc)
-> ([Side] -> DotCodeM [Doc]) -> [Side] -> DotCodeM Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Side -> DotCodeM Doc) -> [Side] -> 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 Side -> DotCodeM Doc
forall a. PrintDot a => a -> DotCodeM Doc
unqtDot

  listToDot :: [Side] -> DotCodeM Doc
listToDot = [Side] -> DotCodeM Doc
forall a. PrintDot a => [a] -> DotCodeM Doc
unqtListToDot

instance ParseDot Side where
  parseUnqt :: Parse Side
parseUnqt = [Parse Side] -> Parse Side
forall (p :: * -> *) a. PolyParse p => [p a] -> p a
oneOf [ Side -> String -> Parse Side
forall a. a -> String -> Parse a
stringRep Side
LeftSide   String
"L"
                    , Side -> String -> Parse Side
forall a. a -> String -> Parse a
stringRep Side
RightSide  String
"R"
                    , Side -> String -> Parse Side
forall a. a -> String -> Parse a
stringRep Side
TopSide    String
"T"
                    , Side -> String -> Parse Side
forall a. a -> String -> Parse a
stringRep Side
BottomSide String
"B"
                    ]

  parse :: Parse Side
parse = Parse Side
forall a. ParseDot a => Parse a
parseUnqt

  parseUnqtList :: Parse [Side]
parseUnqtList = Parse Side -> Parse [Side]
forall a. Parser GraphvizState a -> Parser GraphvizState [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parse Side
forall a. ParseDot a => Parse a
parseUnqt

  parseList :: Parse [Side]
parseList = Parse [Side]
forall a. ParseDot a => Parse [a]
parseUnqtList

data Style = Rounded  -- ^ Valid for 'Table'
           | Radial   -- ^ Valid for 'Table', 'Cell'.
           deriving (Style -> Style -> Bool
(Style -> Style -> Bool) -> (Style -> Style -> Bool) -> Eq Style
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Style -> Style -> Bool
== :: Style -> Style -> Bool
$c/= :: Style -> Style -> Bool
/= :: Style -> Style -> Bool
Eq, Eq Style
Eq Style =>
(Style -> Style -> Ordering)
-> (Style -> Style -> Bool)
-> (Style -> Style -> Bool)
-> (Style -> Style -> Bool)
-> (Style -> Style -> Bool)
-> (Style -> Style -> Style)
-> (Style -> Style -> Style)
-> Ord Style
Style -> Style -> Bool
Style -> Style -> Ordering
Style -> Style -> Style
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 :: Style -> Style -> Ordering
compare :: Style -> Style -> Ordering
$c< :: Style -> Style -> Bool
< :: Style -> Style -> Bool
$c<= :: Style -> Style -> Bool
<= :: Style -> Style -> Bool
$c> :: Style -> Style -> Bool
> :: Style -> Style -> Bool
$c>= :: Style -> Style -> Bool
>= :: Style -> Style -> Bool
$cmax :: Style -> Style -> Style
max :: Style -> Style -> Style
$cmin :: Style -> Style -> Style
min :: Style -> Style -> Style
Ord, Style
Style -> Style -> Bounded Style
forall a. a -> a -> Bounded a
$cminBound :: Style
minBound :: Style
$cmaxBound :: Style
maxBound :: Style
Bounded, Int -> Style
Style -> Int
Style -> [Style]
Style -> Style
Style -> Style -> [Style]
Style -> Style -> Style -> [Style]
(Style -> Style)
-> (Style -> Style)
-> (Int -> Style)
-> (Style -> Int)
-> (Style -> [Style])
-> (Style -> Style -> [Style])
-> (Style -> Style -> [Style])
-> (Style -> Style -> Style -> [Style])
-> Enum Style
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Style -> Style
succ :: Style -> Style
$cpred :: Style -> Style
pred :: Style -> Style
$ctoEnum :: Int -> Style
toEnum :: Int -> Style
$cfromEnum :: Style -> Int
fromEnum :: Style -> Int
$cenumFrom :: Style -> [Style]
enumFrom :: Style -> [Style]
$cenumFromThen :: Style -> Style -> [Style]
enumFromThen :: Style -> Style -> [Style]
$cenumFromTo :: Style -> Style -> [Style]
enumFromTo :: Style -> Style -> [Style]
$cenumFromThenTo :: Style -> Style -> Style -> [Style]
enumFromThenTo :: Style -> Style -> Style -> [Style]
Enum, Int -> Style -> ShowS
[Style] -> ShowS
Style -> String
(Int -> Style -> ShowS)
-> (Style -> String) -> ([Style] -> ShowS) -> Show Style
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Style -> ShowS
showsPrec :: Int -> Style -> ShowS
$cshow :: Style -> String
show :: Style -> String
$cshowList :: [Style] -> ShowS
showList :: [Style] -> ShowS
Show, ReadPrec [Style]
ReadPrec Style
Int -> ReadS Style
ReadS [Style]
(Int -> ReadS Style)
-> ReadS [Style]
-> ReadPrec Style
-> ReadPrec [Style]
-> Read Style
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Style
readsPrec :: Int -> ReadS Style
$creadList :: ReadS [Style]
readList :: ReadS [Style]
$creadPrec :: ReadPrec Style
readPrec :: ReadPrec Style
$creadListPrec :: ReadPrec [Style]
readListPrec :: ReadPrec [Style]
Read)

instance PrintDot Style where
  unqtDot :: Style -> DotCodeM Doc
unqtDot Style
Rounded = Text -> DotCodeM Doc
forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"ROUNDED"
  unqtDot Style
Radial  = Text -> DotCodeM Doc
forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"RADIAL"

instance ParseDot Style where
  parseUnqt :: Parse Style
parseUnqt = [Parse Style] -> Parse Style
forall (p :: * -> *) a. PolyParse p => [p a] -> p a
oneOf [ Style -> String -> Parse Style
forall a. a -> String -> Parse a
stringRep Style
Rounded String
"ROUNDED"
                    , Style -> String -> Parse Style
forall a. a -> String -> Parse a
stringRep Style
Radial  String
"RADIAL"
                    ]

  parse :: Parse Style
parse = Parse Style
forall a. ParseDot a => Parse a
parseUnqt

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

escapeAttribute :: T.Text -> DotCode
escapeAttribute :: Text -> DotCodeM Doc
escapeAttribute = Bool -> Text -> DotCodeM Doc
escapeHtml Bool
False

escapeValue :: T.Text -> DotCode
escapeValue :: Text -> DotCodeM Doc
escapeValue = Bool -> Text -> DotCodeM Doc
escapeHtml Bool
True

escapeHtml               :: Bool -> T.Text -> DotCode
escapeHtml :: Bool -> Text -> DotCodeM Doc
escapeHtml Bool
quotesAllowed = DotCodeM [Doc] -> DotCodeM Doc
forall (m :: * -> *). Functor m => m [Doc] -> m Doc
hcat (DotCodeM [Doc] -> DotCodeM Doc)
-> (Text -> DotCodeM [Doc]) -> Text -> DotCodeM Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([[Doc]] -> [Doc]) -> DotCodeM [[Doc]] -> DotCodeM [Doc]
forall a b. (a -> b) -> DotCodeM a -> DotCodeM b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[Doc]] -> [Doc]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
                           (DotCodeM [[Doc]] -> DotCodeM [Doc])
-> (Text -> DotCodeM [[Doc]]) -> Text -> DotCodeM [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> DotCodeM [Doc]) -> [Text] -> 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 (String -> DotCodeM [Doc]
escapeSegment (String -> DotCodeM [Doc])
-> (Text -> String) -> Text -> DotCodeM [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack)
                           ([Text] -> DotCodeM [[Doc]])
-> (Text -> [Text]) -> Text -> DotCodeM [[Doc]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char -> Bool) -> Text -> [Text]
T.groupBy (Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Bool -> Bool -> Bool) -> (Char -> Bool) -> Char -> Char -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Char -> Bool
isSpace)
  where
    -- Note: use numeric version of space rather than nbsp, since this
    -- matches what Graphviz does (since Inkscape apparently can't
    -- cope with nbsp).
    escapeSegment :: String -> DotCodeM [Doc]
escapeSegment (Char
s:String
sps) | Char -> Bool
isSpace Char
s = (Doc -> [Doc] -> [Doc])
-> DotCodeM Doc -> DotCodeM [Doc] -> DotCodeM [Doc]
forall a b c.
(a -> b -> c) -> DotCodeM a -> DotCodeM b -> DotCodeM c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (:) (Char -> DotCodeM Doc
forall (m :: * -> *). Applicative m => Char -> m Doc
char Char
s) (DotCodeM [Doc] -> DotCodeM [Doc])
-> DotCodeM [Doc] -> DotCodeM [Doc]
forall a b. (a -> b) -> a -> b
$ (Char -> DotCodeM Doc) -> String -> 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 Char -> DotCodeM Doc
numEscape String
sps
    escapeSegment String
txt                 = (Char -> DotCodeM Doc) -> String -> 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 Char -> DotCodeM Doc
xmlChar String
txt

    allowQuotes :: Map Char a -> Map Char a
allowQuotes = if Bool
quotesAllowed
                  then Char -> Map Char a -> Map Char a
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete Char
'"'
                  else Map Char a -> Map Char a
forall a. a -> a
id

    escs :: Map Char Text
escs = Map Char Text -> Map Char Text
forall {a}. Map Char a -> Map Char a
allowQuotes (Map Char Text -> Map Char Text) -> Map Char Text -> Map Char Text
forall a b. (a -> b) -> a -> b
$ [(Char, Text)] -> Map Char Text
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Char, Text)]
htmlEscapes
    xmlChar :: Char -> DotCodeM Doc
xmlChar Char
c = DotCodeM Doc
-> (Text -> DotCodeM Doc) -> Maybe Text -> DotCodeM Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Char -> DotCodeM Doc
forall (m :: * -> *). Applicative m => Char -> m Doc
char Char
c) Text -> DotCodeM Doc
escape (Maybe Text -> DotCodeM Doc) -> Maybe Text -> DotCodeM Doc
forall a b. (a -> b) -> a -> b
$ Char
c Char -> Map Char Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
`Map.lookup` Map Char Text
escs

    numEscape :: Char -> DotCodeM Doc
numEscape = DotCodeM Doc -> DotCodeM Doc
forall {m :: * -> *}.
(Semigroup (m Doc), Applicative m) =>
m Doc -> m Doc
escape' (DotCodeM Doc -> DotCodeM Doc)
-> (Char -> DotCodeM Doc) -> Char -> DotCodeM Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DotCodeM Doc -> DotCodeM Doc -> DotCodeM Doc
forall a. Semigroup a => a -> a -> a
(<>) (Char -> DotCodeM Doc
forall (m :: * -> *). Applicative m => Char -> m Doc
char Char
'#') (DotCodeM Doc -> DotCodeM Doc)
-> (Char -> DotCodeM Doc) -> Char -> DotCodeM Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> DotCodeM Doc
forall (m :: * -> *). Applicative m => Int -> m Doc
int (Int -> DotCodeM Doc) -> (Char -> Int) -> Char -> DotCodeM Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord
    escape' :: m Doc -> m Doc
escape' m Doc
e = Char -> m Doc
forall (m :: * -> *). Applicative m => Char -> m Doc
char Char
'&' m Doc -> m Doc -> m Doc
forall a. Semigroup a => a -> a -> a
<> m Doc
e m Doc -> m Doc -> m Doc
forall a. Semigroup a => a -> a -> a
<> Char -> m Doc
forall (m :: * -> *). Applicative m => Char -> m Doc
char Char
';'
    escape :: Text -> DotCodeM Doc
escape = DotCodeM Doc -> DotCodeM Doc
forall {m :: * -> *}.
(Semigroup (m Doc), Applicative m) =>
m Doc -> m Doc
escape' (DotCodeM Doc -> DotCodeM Doc)
-> (Text -> DotCodeM Doc) -> Text -> DotCodeM Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> DotCodeM Doc
forall (m :: * -> *). Applicative m => Text -> m Doc
text

unescapeAttribute :: Parse T.Text
unescapeAttribute :: Parser GraphvizState Text
unescapeAttribute = Bool -> Parser GraphvizState Text
unescapeHtml Bool
False

unescapeValue :: Parse T.Text
unescapeValue :: Parser GraphvizState Text
unescapeValue = Bool -> Parser GraphvizState Text
unescapeHtml Bool
True

-- | Parses an HTML-compatible 'String', de-escaping known characters.
--   Note: this /will/ fail if an unknown non-numeric HTML-escape is
--   used.
unescapeHtml               :: Bool -> Parse T.Text
unescapeHtml :: Bool -> Parser GraphvizState Text
unescapeHtml Bool
quotesAllowed = ([Maybe Char] -> Text)
-> Parser GraphvizState [Maybe Char] -> Parser GraphvizState Text
forall a b.
(a -> b) -> Parser GraphvizState a -> Parser GraphvizState b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> Text
T.pack (String -> Text)
-> ([Maybe Char] -> String) -> [Maybe Char] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe Char] -> String
forall a. [Maybe a] -> [a]
catMaybes)
                             (Parser GraphvizState [Maybe Char] -> Parser GraphvizState Text)
-> ([Parser GraphvizState (Maybe Char)]
    -> Parser GraphvizState [Maybe Char])
-> [Parser GraphvizState (Maybe Char)]
-> Parser GraphvizState Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser GraphvizState (Maybe Char)
-> Parser GraphvizState [Maybe Char]
forall (p :: * -> *) a. PolyParse p => p a -> p [a]
many1 (Parser GraphvizState (Maybe Char)
 -> Parser GraphvizState [Maybe Char])
-> ([Parser GraphvizState (Maybe Char)]
    -> Parser GraphvizState (Maybe Char))
-> [Parser GraphvizState (Maybe Char)]
-> Parser GraphvizState [Maybe Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Parser GraphvizState (Maybe Char)]
-> Parser GraphvizState (Maybe Char)
forall (p :: * -> *) a. PolyParse p => [p a] -> p a
oneOf ([Parser GraphvizState (Maybe Char)] -> Parser GraphvizState Text)
-> [Parser GraphvizState (Maybe Char)] -> Parser GraphvizState Text
forall a b. (a -> b) -> a -> b
$ [ Parser GraphvizState (Maybe Char)
parseEscpd
                                               , Parser GraphvizState (Maybe Char)
forall {s}. Parser s (Maybe Char)
validChars
                                               ]
  where
    parseEscpd :: Parse (Maybe Char)
    parseEscpd :: Parser GraphvizState (Maybe Char)
parseEscpd = do Char -> Parse Char
character Char
'&'
                    Text
esc <- (Char -> Bool) -> Parser GraphvizState Text
forall s. (Char -> Bool) -> Parser s Text
many1Satisfy (Char
';' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=)
                    Char -> Parse Char
character Char
';'
                    let c :: Maybe Char
c = case Text -> Maybe (Char, Text)
T.uncons (Text -> Maybe (Char, Text)) -> Text -> Maybe (Char, Text)
forall a b. (a -> b) -> a -> b
$ Text -> Text
T.toLower Text
esc of
                              Just (Char
'#',Text
dec) | Just (Char
'x',Text
hex) <- Text -> Maybe (Char, Text)
T.uncons Text
dec
                                               -> (String -> [(Int, String)]) -> String -> Maybe Char
forall {t} {a}. (t -> [(Int, [a])]) -> t -> Maybe Char
readMaybe String -> [(Int, String)]
forall a. (Eq a, Num a) => ReadS a
readHex (String -> Maybe Char) -> String -> Maybe Char
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
hex
                                             | Bool
otherwise
                                               -> (String -> [(Int, String)]) -> String -> Maybe Char
forall {t} {a}. (t -> [(Int, [a])]) -> t -> Maybe Char
readMaybe String -> [(Int, String)]
readInt (String -> Maybe Char) -> String -> Maybe Char
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
dec
                              Maybe (Char, Text)
_                -> Text
esc Text -> Map Text Char -> Maybe Char
forall k a. Ord k => k -> Map k a -> Maybe a
`Map.lookup` Map Text Char
escMap
                    Maybe Char -> Parser GraphvizState (Maybe Char)
forall a. a -> Parser GraphvizState a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Char
c

    readMaybe :: (t -> [(Int, [a])]) -> t -> Maybe Char
readMaybe t -> [(Int, [a])]
f t
str = do (Int
n, []) <- [(Int, [a])] -> Maybe (Int, [a])
forall a. [a] -> Maybe a
listToMaybe ([(Int, [a])] -> Maybe (Int, [a]))
-> [(Int, [a])] -> Maybe (Int, [a])
forall a b. (a -> b) -> a -> b
$ t -> [(Int, [a])]
f t
str
                         Char -> Maybe Char
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Char -> Maybe Char) -> Char -> Maybe Char
forall a b. (a -> b) -> a -> b
$ Int -> Char
chr Int
n
    readInt :: ReadS Int
    readInt :: String -> [(Int, String)]
readInt = String -> [(Int, String)]
forall a. Read a => ReadS a
reads

    allowQuotes :: ShowS
allowQuotes = if Bool
quotesAllowed
                  then Char -> ShowS
forall a. Eq a => a -> [a] -> [a]
delete Char
'"'
                  else ShowS
forall a. a -> a
id

    escMap :: Map Text Char
escMap = [(Text, Char)] -> Map Text Char
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Text, Char)]
htmlUnescapes

    validChars :: Parser s (Maybe Char)
validChars = (Char -> Maybe Char) -> Parser s Char -> Parser s (Maybe Char)
forall a b. (a -> b) -> Parser s a -> Parser s b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Maybe Char
forall a. a -> Maybe a
Just (Parser s Char -> Parser s (Maybe Char))
-> Parser s Char -> Parser s (Maybe Char)
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Parser s Char
forall s. (Char -> Bool) -> Parser s Char
satisfy (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` String
needEscaping)
    needEscaping :: String
needEscaping = ShowS
allowQuotes ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ ((Char, Text) -> Char) -> [(Char, Text)] -> String
forall a b. (a -> b) -> [a] -> [b]
map (Char, Text) -> Char
forall a b. (a, b) -> a
fst [(Char, Text)]
htmlEscapes

-- | The characters that need to be escaped and what they need to be
--   replaced with (sans @'&'@).
htmlEscapes :: [(Char, T.Text)]
htmlEscapes :: [(Char, Text)]
htmlEscapes = [ (Char
'"', Text
"quot")
              , (Char
'<', Text
"lt")
              , (Char
'>', Text
"gt")
              , (Char
'&', Text
"amp")
              ]

-- | Flip the order and add extra values that might be escaped.  More
--   specifically, provide the escape code for spaces (@\"nbsp\"@) and
--   apostrophes (@\"apos\"@) since they aren't used for escaping.
htmlUnescapes :: [(T.Text, Char)]
htmlUnescapes :: [(Text, Char)]
htmlUnescapes = [(Text, Char)]
maybeEscaped
                [(Text, Char)] -> [(Text, Char)] -> [(Text, Char)]
forall a. [a] -> [a] -> [a]
++
                ((Char, Text) -> (Text, Char)) -> [(Char, Text)] -> [(Text, Char)]
forall a b. (a -> b) -> [a] -> [b]
map ((Char -> Text -> (Text, Char)) -> (Char, Text) -> (Text, Char)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((Char -> Text -> (Text, Char)) -> (Char, Text) -> (Text, Char))
-> (Char -> Text -> (Text, Char)) -> (Char, Text) -> (Text, Char)
forall a b. (a -> b) -> a -> b
$ (Text -> Char -> (Text, Char)) -> Char -> Text -> (Text, Char)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (,)) [(Char, Text)]
htmlEscapes
  where
    maybeEscaped :: [(Text, Char)]
maybeEscaped = [(Text
"nbsp", Char
' '), (Text
"apos", Char
'\'')]

printBoolHtml :: Bool -> DotCode
printBoolHtml :: Bool -> DotCodeM Doc
printBoolHtml = Text -> DotCodeM Doc
forall (m :: * -> *). Applicative m => Text -> m Doc
text (Text -> DotCodeM Doc) -> (Bool -> Text) -> Bool -> DotCodeM Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Bool -> Text
forall a. a -> a -> Bool -> a
bool Text
"FALSE" Text
"TRUE"

parseBoolHtml :: Parse Bool
parseBoolHtml :: Parse Bool
parseBoolHtml = Bool -> String -> Parse Bool
forall a. a -> String -> Parse a
stringRep Bool
True String
"TRUE"
                Parse Bool -> Parse Bool -> Parse Bool
forall s a. Parser s a -> Parser s a -> Parser s a
`onFail`
                Bool -> String -> Parse Bool
forall a. a -> String -> Parse a
stringRep Bool
False String
"FALSE"

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

-- | Print something like @<FOO ATTR=\"ATTR_VALUE\">value<\/FOO>@
printTag        :: DotCode -> Attributes -> DotCode -> DotCode
printTag :: DotCodeM Doc -> Attributes -> DotCodeM Doc -> DotCodeM Doc
printTag DotCodeM Doc
t Attributes
as DotCodeM Doc
v = DotCodeM Doc -> DotCodeM Doc
angled (DotCodeM Doc
t DotCodeM Doc -> DotCodeM Doc -> DotCodeM Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> Attributes -> DotCodeM Doc
forall a. PrintDot a => a -> DotCodeM Doc
toDot Attributes
as)
                      DotCodeM Doc -> DotCodeM Doc -> DotCodeM Doc
forall a. Semigroup a => a -> a -> a
<> DotCodeM Doc
v
                      DotCodeM Doc -> DotCodeM Doc -> DotCodeM Doc
forall a. Semigroup a => a -> a -> a
<> DotCodeM Doc -> DotCodeM Doc
angled (DotCodeM Doc
fslash DotCodeM Doc -> DotCodeM Doc -> DotCodeM Doc
forall a. Semigroup a => a -> a -> a
<> DotCodeM Doc
t)

printFontTag :: Attributes -> DotCode -> DotCode
printFontTag :: Attributes -> DotCodeM Doc -> DotCodeM Doc
printFontTag = DotCodeM Doc -> Attributes -> DotCodeM Doc -> DotCodeM Doc
printTag (Text -> DotCodeM Doc
forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"FONT")

-- | Print something like @<FOO ATTR=\"ATTR_VALUE\"\/>@
printEmptyTag      :: DotCode -> Attributes -> DotCode
printEmptyTag :: DotCodeM Doc -> Attributes -> DotCodeM Doc
printEmptyTag DotCodeM Doc
t Attributes
as = DotCodeM Doc -> DotCodeM Doc
angled (DotCodeM Doc -> DotCodeM Doc) -> DotCodeM Doc -> DotCodeM Doc
forall a b. (a -> b) -> a -> b
$ DotCodeM Doc
t DotCodeM Doc -> DotCodeM Doc -> DotCodeM Doc
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> Attributes -> DotCodeM Doc
forall a. PrintDot a => a -> DotCodeM Doc
toDot Attributes
as DotCodeM Doc -> DotCodeM Doc -> DotCodeM Doc
forall a. Semigroup a => a -> a -> a
<> DotCodeM Doc
fslash

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

-- Note: can't use bracket here because we're not completely
-- discarding everything from the opening bracket.

-- Not using parseTagRep for parseTag because open/close case
-- is different; worth fixing?

-- | Parse something like @<FOO ATTR=\"ATTR_VALUE\">value<\/FOO>@
parseTag        :: (Attributes -> val -> tag) -> String
                       -> Parse val -> Parse tag
parseTag :: forall val tag.
(Attributes -> val -> tag) -> String -> Parse val -> Parse tag
parseTag Attributes -> val -> tag
c String
t Parse val
pv = Attributes -> val -> tag
c (Attributes -> val -> tag)
-> Parse Attributes -> Parser GraphvizState (val -> tag)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parse Attributes -> Parse Attributes
forall a. Parse a -> Parse a
parseAngled Parse Attributes
openingTag
                    Parser GraphvizState (val -> tag)
-> Parse val -> Parser GraphvizState tag
forall a b.
Parser GraphvizState (a -> b)
-> Parser GraphvizState a -> Parser GraphvizState b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parse val -> Parse val
forall a. Parse a -> Parse a
wrapWhitespace Parse val
pv
                    Parser GraphvizState tag
-> Parser GraphvizState () -> Parser GraphvizState tag
forall a b.
Parser GraphvizState a
-> Parser GraphvizState b -> Parser GraphvizState a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser GraphvizState () -> Parser GraphvizState ()
forall a. Parse a -> Parse a
parseAngled (Char -> Parse Char
character Char
'/' Parse Char -> Parser GraphvizState () -> Parser GraphvizState ()
forall a b.
Parser GraphvizState a
-> Parser GraphvizState b -> Parser GraphvizState b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser GraphvizState ()
t' Parser GraphvizState ()
-> Parser GraphvizState () -> Parser GraphvizState ()
forall a b.
Parser GraphvizState a
-> Parser GraphvizState b -> Parser GraphvizState b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser GraphvizState ()
whitespace)
                  Parser GraphvizState () -> ShowS -> Parser GraphvizState ()
forall a. Parser GraphvizState a -> ShowS -> Parser GraphvizState a
forall (p :: * -> *) a. Commitment p => p a -> ShowS -> p a
`adjustErr`
                  ((String
"Can't parse Html tag: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
t String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n\t")String -> ShowS
forall a. [a] -> [a] -> [a]
++)
  where
    t' :: Parser GraphvizState ()
t' = String -> Parser GraphvizState ()
string String
t
    openingTag :: Parse Attributes
    openingTag :: Parse Attributes
openingTag = Parser GraphvizState ()
t'
                 Parser GraphvizState () -> Parse Attributes -> Parse Attributes
forall a b.
Parser GraphvizState a
-> Parser GraphvizState b -> Parser GraphvizState b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parse Attributes -> Parse Attributes
forall a. Parse [a] -> Parse [a]
tryParseList' (Parser GraphvizState ()
whitespace1 Parser GraphvizState () -> Parse Attributes -> Parse Attributes
forall a b.
Parser GraphvizState a
-> Parser GraphvizState b -> Parser GraphvizState b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parse Attributes
forall a. ParseDot a => Parse a
parse)
                 Parse Attributes -> Parser GraphvizState () -> Parse Attributes
forall a b.
Parser GraphvizState a
-> Parser GraphvizState b -> Parser GraphvizState a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser GraphvizState ()
whitespace

parseFontTag :: (Attributes -> val -> tag) -> Parse val -> Parse tag
parseFontTag :: forall val tag.
(Attributes -> val -> tag) -> Parse val -> Parse tag
parseFontTag = ((Attributes -> val -> tag) -> String -> Parse val -> Parse tag
forall val tag.
(Attributes -> val -> tag) -> String -> Parse val -> Parse tag
`parseTag` String
"FONT")

-- Should this just be specialised for tagName ~ Format ?

-- | Parse something like @<FOO>value<\/FOO>@.
parseTagRep :: (tagName -> val -> tag) -> Parse tagName -> Parse val -> Parse tag
parseTagRep :: forall tagName val tag.
(tagName -> val -> tag) -> Parse tagName -> Parse val -> Parse tag
parseTagRep tagName -> val -> tag
c Parse tagName
pt Parse val
pv = tagName -> val -> tag
c (tagName -> val -> tag)
-> Parse tagName -> Parser GraphvizState (val -> tag)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parse tagName -> Parse tagName
forall a. Parse a -> Parse a
parseAngled (Parse tagName
pt Parse tagName -> Parser GraphvizState () -> Parse tagName
forall (p :: * -> *) a b. PolyParse p => p a -> p b -> p a
`discard` Parser GraphvizState ()
whitespace)
                        Parser GraphvizState (val -> tag)
-> Parse val -> Parser GraphvizState tag
forall a b.
Parser GraphvizState (a -> b)
-> Parser GraphvizState a -> Parser GraphvizState b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parse val
pv
                        Parser GraphvizState tag
-> Parser GraphvizState () -> Parser GraphvizState tag
forall a b.
Parser GraphvizState a
-> Parser GraphvizState b -> Parser GraphvizState a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser GraphvizState () -> Parser GraphvizState ()
forall a. Parse a -> Parse a
parseAngled (Char -> Parse Char
character Char
'/' Parse Char -> Parse tagName -> Parse tagName
forall a b.
Parser GraphvizState a
-> Parser GraphvizState b -> Parser GraphvizState b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parse tagName
pt Parse tagName -> Parser GraphvizState () -> Parser GraphvizState ()
forall a b.
Parser GraphvizState a
-> Parser GraphvizState b -> Parser GraphvizState b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser GraphvizState ()
whitespace)
                    Parser GraphvizState () -> ShowS -> Parser GraphvizState ()
forall a. Parser GraphvizState a -> ShowS -> Parser GraphvizState a
forall (p :: * -> *) a. Commitment p => p a -> ShowS -> p a
`adjustErr`
                    (String
"Can't parse attribute-less Html tag\n\t"String -> ShowS
forall a. [a] -> [a] -> [a]
++)

-- | Parse something like @<FOO ATTR=\"ATTR_VALUE\"\/>@
parseEmptyTag     :: (Attributes -> tag) -> String -> Parse tag
parseEmptyTag :: forall tag. (Attributes -> tag) -> String -> Parse tag
parseEmptyTag Attributes -> tag
c String
t = Attributes -> tag
c (Attributes -> tag) -> Parse Attributes -> Parser GraphvizState tag
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parse Attributes -> Parse Attributes
forall a. Parse a -> Parse a
parseAngled
                        ( String -> Parser GraphvizState ()
string String
t
                          Parser GraphvizState () -> Parse Attributes -> Parse Attributes
forall a b.
Parser GraphvizState a
-> Parser GraphvizState b -> Parser GraphvizState b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parse Attributes -> Parse Attributes
forall a. Parse [a] -> Parse [a]
tryParseList' (Parser GraphvizState ()
whitespace1 Parser GraphvizState () -> Parse Attributes -> Parse Attributes
forall a b.
Parser GraphvizState a
-> Parser GraphvizState b -> Parser GraphvizState b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parse Attributes
forall a. ParseDot a => Parse a
parse)
                          Parse Attributes -> Parser GraphvizState () -> Parse Attributes
forall a b.
Parser GraphvizState a
-> Parser GraphvizState b -> Parser GraphvizState a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser GraphvizState ()
whitespace
                          Parse Attributes -> Parse Char -> Parse Attributes
forall a b.
Parser GraphvizState a
-> Parser GraphvizState b -> Parser GraphvizState a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parse Char
character Char
'/'
                        )
                    Parse Attributes -> ShowS -> Parse Attributes
forall a. Parser GraphvizState a -> ShowS -> Parser GraphvizState a
forall (p :: * -> *) a. Commitment p => p a -> ShowS -> p a
`adjustErr`
                    ((String
"Can't parse empty Html tag: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
t String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n\t")String -> ShowS
forall a. [a] -> [a] -> [a]
++)