{-# 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
/= :: Label -> Label -> Bool
$c/= :: Label -> Label -> Bool
== :: Label -> Label -> Bool
$c== :: 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
min :: Label -> Label -> Label
$cmin :: Label -> Label -> Label
max :: Label -> Label -> Label
$cmax :: Label -> Label -> Label
>= :: Label -> Label -> Bool
$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
compare :: Label -> Label -> Ordering
$ccompare :: Label -> Label -> Ordering
$cp1Ord :: Eq 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
showList :: [Label] -> ShowS
$cshowList :: [Label] -> ShowS
show :: Label -> String
$cshow :: Label -> String
showsPrec :: Int -> Label -> ShowS
$cshowsPrec :: Int -> 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
readListPrec :: ReadPrec [Label]
$creadListPrec :: ReadPrec [Label]
readPrec :: ReadPrec Label
$creadPrec :: ReadPrec Label
readList :: ReadS [Label]
$creadList :: ReadS [Label]
readsPrec :: Int -> ReadS Label
$creadsPrec :: Int -> ReadS Label
Read)

instance PrintDot Label where
  unqtDot :: Label -> DotCode
unqtDot (Text txt :: Text
txt)  = Text -> DotCode
forall a. PrintDot a => a -> DotCode
unqtDot Text
txt
  unqtDot (Table tbl :: Table
tbl) = Table -> DotCode
forall a. PrintDot a => a -> DotCode
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 (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 (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 (p :: * -> *) a. Commitment p => p a -> ShowS -> p a
`adjustErr`
              ("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
/= :: TextItem -> TextItem -> Bool
$c/= :: TextItem -> TextItem -> Bool
== :: TextItem -> TextItem -> Bool
$c== :: 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
min :: TextItem -> TextItem -> TextItem
$cmin :: TextItem -> TextItem -> TextItem
max :: TextItem -> TextItem -> TextItem
$cmax :: TextItem -> TextItem -> TextItem
>= :: TextItem -> TextItem -> Bool
$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
compare :: TextItem -> TextItem -> Ordering
$ccompare :: TextItem -> TextItem -> Ordering
$cp1Ord :: Eq 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
showList :: Text -> ShowS
$cshowList :: Text -> ShowS
show :: TextItem -> String
$cshow :: TextItem -> String
showsPrec :: Int -> TextItem -> ShowS
$cshowsPrec :: Int -> TextItem -> 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
readListPrec :: ReadPrec Text
$creadListPrec :: ReadPrec Text
readPrec :: ReadPrec TextItem
$creadPrec :: ReadPrec TextItem
readList :: ReadS Text
$creadList :: ReadS Text
readsPrec :: Int -> ReadS TextItem
$creadsPrec :: Int -> ReadS TextItem
Read)

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

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

  listToDot :: Text -> DotCode
listToDot = Text -> DotCode
forall a. PrintDot a => [a] -> DotCode
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 (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 "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 (p :: * -> *) a. Commitment p => p a -> ShowS -> p a
`adjustErr`
              ("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 (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
/= :: Format -> Format -> Bool
$c/= :: Format -> Format -> Bool
== :: Format -> Format -> Bool
$c== :: 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
min :: Format -> Format -> Format
$cmin :: Format -> Format -> Format
max :: Format -> Format -> Format
$cmax :: Format -> Format -> Format
>= :: Format -> Format -> Bool
$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
compare :: Format -> Format -> Ordering
$ccompare :: Format -> Format -> Ordering
$cp1Ord :: Eq Format
Ord, Format
Format -> Format -> Bounded Format
forall a. a -> a -> Bounded a
maxBound :: Format
$cmaxBound :: Format
minBound :: Format
$cminBound :: 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
enumFromThenTo :: Format -> Format -> Format -> [Format]
$cenumFromThenTo :: Format -> Format -> Format -> [Format]
enumFromTo :: Format -> Format -> [Format]
$cenumFromTo :: Format -> Format -> [Format]
enumFromThen :: Format -> Format -> [Format]
$cenumFromThen :: Format -> Format -> [Format]
enumFrom :: Format -> [Format]
$cenumFrom :: Format -> [Format]
fromEnum :: Format -> Int
$cfromEnum :: Format -> Int
toEnum :: Int -> Format
$ctoEnum :: Int -> Format
pred :: Format -> Format
$cpred :: Format -> Format
succ :: Format -> Format
$csucc :: 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
showList :: [Format] -> ShowS
$cshowList :: [Format] -> ShowS
show :: Format -> String
$cshow :: Format -> String
showsPrec :: Int -> Format -> ShowS
$cshowsPrec :: Int -> 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
readListPrec :: ReadPrec [Format]
$creadListPrec :: ReadPrec [Format]
readPrec :: ReadPrec Format
$creadPrec :: ReadPrec Format
readList :: ReadS [Format]
$creadList :: ReadS [Format]
readsPrec :: Int -> ReadS Format
$creadsPrec :: Int -> ReadS Format
Read)

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

instance ParseDot Format where
  parseUnqt :: Parse Format
parseUnqt = [(String, Format)] -> Parse Format
forall a. [(String, a)] -> Parse a
stringValue [ ("I", Format
Italics)
                          , ("B", Format
Bold)
                          , ("U", Format
Underline)
                          , ("O", Format
Overline)
                          , ("SUB", Format
Subscript)
                          , ("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
/= :: Table -> Table -> Bool
$c/= :: Table -> Table -> Bool
== :: Table -> Table -> Bool
$c== :: 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
min :: Table -> Table -> Table
$cmin :: Table -> Table -> Table
max :: Table -> Table -> Table
$cmax :: Table -> Table -> Table
>= :: Table -> Table -> Bool
$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
compare :: Table -> Table -> Ordering
$ccompare :: Table -> Table -> Ordering
$cp1Ord :: Eq 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
showList :: [Table] -> ShowS
$cshowList :: [Table] -> ShowS
show :: Table -> String
$cshow :: Table -> String
showsPrec :: Int -> Table -> ShowS
$cshowsPrec :: Int -> 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
readListPrec :: ReadPrec [Table]
$creadListPrec :: ReadPrec [Table]
readPrec :: ReadPrec Table
$creadPrec :: ReadPrec Table
readList :: ReadS [Table]
$creadList :: ReadS [Table]
readsPrec :: Int -> ReadS Table
$creadsPrec :: Int -> ReadS Table
Read)

instance PrintDot Table where
  unqtDot :: Table -> DotCode
unqtDot tbl :: Table
tbl = case Table -> Maybe Attributes
tableFontAttrs Table
tbl of
                  (Just as :: Attributes
as) -> Attributes -> DotCode -> DotCode
printFontTag Attributes
as DotCode
tbl'
                  Nothing   -> DotCode
tbl'
    where
      tbl' :: DotCode
tbl' = DotCode -> Attributes -> DotCode -> DotCode
printTag (Text -> DotCode
forall (m :: * -> *). Applicative m => Text -> m Doc
text "TABLE")
                          (Table -> Attributes
tableAttrs Table
tbl)
                          ([Row] -> DotCode
forall a. PrintDot a => a -> DotCode
toDot ([Row] -> DotCode) -> [Row] -> DotCode
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 (p :: * -> *) a. Commitment p => p a -> ShowS -> p a
`adjustErr`
              ("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)
                                       "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 fas :: Attributes
fas tbl :: Table
tbl = Table
tbl { tableFontAttrs :: Maybe Attributes
tableFontAttrs = Attributes -> Maybe Attributes
forall a. a -> Maybe a
Just Attributes
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
/= :: Row -> Row -> Bool
$c/= :: Row -> Row -> Bool
== :: Row -> Row -> Bool
$c== :: 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
min :: Row -> Row -> Row
$cmin :: Row -> Row -> Row
max :: Row -> Row -> Row
$cmax :: Row -> Row -> Row
>= :: Row -> Row -> Bool
$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
compare :: Row -> Row -> Ordering
$ccompare :: Row -> Row -> Ordering
$cp1Ord :: Eq 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
showList :: [Row] -> ShowS
$cshowList :: [Row] -> ShowS
show :: Row -> String
$cshow :: Row -> String
showsPrec :: Int -> Row -> ShowS
$cshowsPrec :: Int -> 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
readListPrec :: ReadPrec [Row]
$creadListPrec :: ReadPrec [Row]
readPrec :: ReadPrec Row
$creadPrec :: ReadPrec Row
readList :: ReadS [Row]
$creadList :: ReadS [Row]
readsPrec :: Int -> ReadS Row
$creadsPrec :: Int -> ReadS Row
Read)

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

  unqtListToDot :: [Row] -> DotCode
unqtListToDot = DotCode -> DotCode
forall (m :: * -> *). Functor m => m Doc -> m Doc
align (DotCode -> DotCode) -> ([Row] -> DotCode) -> [Row] -> DotCode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DotCodeM [Doc] -> DotCode
forall (m :: * -> *). Functor m => m [Doc] -> m Doc
cat (DotCodeM [Doc] -> DotCode)
-> ([Row] -> DotCodeM [Doc]) -> [Row] -> DotCode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Row -> DotCode) -> [Row] -> DotCodeM [Doc]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Row -> DotCode
forall a. PrintDot a => a -> DotCode
unqtDot

  listToDot :: [Row] -> DotCode
listToDot = [Row] -> DotCode
forall a. PrintDot a => [a] -> DotCode
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) "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) "HR"
              Parse Row -> ShowS -> Parse Row
forall (p :: * -> *) a. Commitment p => p a -> ShowS -> p a
`adjustErr`
              ("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
/= :: Cell -> Cell -> Bool
$c/= :: Cell -> Cell -> Bool
== :: Cell -> Cell -> Bool
$c== :: 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
min :: Cell -> Cell -> Cell
$cmin :: Cell -> Cell -> Cell
max :: Cell -> Cell -> Cell
$cmax :: Cell -> Cell -> Cell
>= :: Cell -> Cell -> Bool
$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
compare :: Cell -> Cell -> Ordering
$ccompare :: Cell -> Cell -> Ordering
$cp1Ord :: Eq 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
showList :: [Cell] -> ShowS
$cshowList :: [Cell] -> ShowS
show :: Cell -> String
$cshow :: Cell -> String
showsPrec :: Int -> Cell -> ShowS
$cshowsPrec :: Int -> 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
readListPrec :: ReadPrec [Cell]
$creadListPrec :: ReadPrec [Cell]
readPrec :: ReadPrec Cell
$creadPrec :: ReadPrec Cell
readList :: ReadS [Cell]
$creadList :: ReadS [Cell]
readsPrec :: Int -> ReadS Cell
$creadsPrec :: Int -> ReadS Cell
Read)

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

  unqtListToDot :: [Cell] -> DotCode
unqtListToDot = DotCodeM [Doc] -> DotCode
forall (m :: * -> *). Functor m => m [Doc] -> m Doc
hsep (DotCodeM [Doc] -> DotCode)
-> ([Cell] -> DotCodeM [Doc]) -> [Cell] -> DotCode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Cell -> DotCode) -> [Cell] -> DotCodeM [Doc]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Cell -> DotCode
forall a. PrintDot a => a -> DotCode
unqtDot

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

printCell :: Attributes -> DotCode -> DotCode
printCell :: Attributes -> DotCode -> DotCode
printCell = DotCode -> Attributes -> DotCode -> DotCode
printTag (Text -> DotCode
forall (m :: * -> *). Applicative m => Text -> m Doc
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) "VR"
                    ]
              Parse Cell -> ShowS -> Parse Cell
forall (p :: * -> *) a. Commitment p => p a -> ShowS -> p a
`adjustErr`
              ("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` "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
/= :: Img -> Img -> Bool
$c/= :: Img -> Img -> Bool
== :: Img -> Img -> Bool
$c== :: 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
min :: Img -> Img -> Img
$cmin :: Img -> Img -> Img
max :: Img -> Img -> Img
$cmax :: Img -> Img -> Img
>= :: Img -> Img -> Bool
$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
compare :: Img -> Img -> Ordering
$ccompare :: Img -> Img -> Ordering
$cp1Ord :: Eq 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
showList :: [Img] -> ShowS
$cshowList :: [Img] -> ShowS
show :: Img -> String
$cshow :: Img -> String
showsPrec :: Int -> Img -> ShowS
$cshowsPrec :: Int -> 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
readListPrec :: ReadPrec [Img]
$creadListPrec :: ReadPrec [Img]
readPrec :: ReadPrec Img
$creadPrec :: ReadPrec Img
readList :: ReadS [Img]
$creadList :: ReadS [Img]
readsPrec :: Int -> ReadS Img
$creadsPrec :: Int -> ReadS Img
Read)

instance PrintDot Img where
  unqtDot :: Img -> DotCode
unqtDot (Img as :: Attributes
as) = DotCode -> Attributes -> DotCode
printEmptyTag (Text -> DotCode
forall (m :: * -> *). Applicative m => Text -> m Doc
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 "IMG")
              Parse Img -> ShowS -> Parse Img
forall (p :: * -> *) a. Commitment p => p a -> ShowS -> p a
`adjustErr`
              ("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
/= :: Attribute -> Attribute -> Bool
$c/= :: Attribute -> Attribute -> Bool
== :: Attribute -> Attribute -> Bool
$c== :: 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
min :: Attribute -> Attribute -> Attribute
$cmin :: Attribute -> Attribute -> Attribute
max :: Attribute -> Attribute -> Attribute
$cmax :: Attribute -> Attribute -> Attribute
>= :: Attribute -> Attribute -> Bool
$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
compare :: Attribute -> Attribute -> Ordering
$ccompare :: Attribute -> Attribute -> Ordering
$cp1Ord :: Eq 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
showList :: Attributes -> ShowS
$cshowList :: Attributes -> ShowS
show :: Attribute -> String
$cshow :: Attribute -> String
showsPrec :: Int -> Attribute -> ShowS
$cshowsPrec :: Int -> Attribute -> 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
readListPrec :: ReadPrec Attributes
$creadListPrec :: ReadPrec Attributes
readPrec :: ReadPrec Attribute
$creadPrec :: ReadPrec Attribute
readList :: ReadS Attributes
$creadList :: ReadS Attributes
readsPrec :: Int -> ReadS Attribute
$creadsPrec :: Int -> ReadS Attribute
Read)

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

  unqtListToDot :: Attributes -> DotCode
unqtListToDot = DotCodeM [Doc] -> DotCode
forall (m :: * -> *). Functor m => m [Doc] -> m Doc
hsep (DotCodeM [Doc] -> DotCode)
-> (Attributes -> DotCodeM [Doc]) -> Attributes -> DotCode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Attribute -> DotCode) -> Attributes -> DotCodeM [Doc]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Attribute -> DotCode
forall a. PrintDot a => a -> DotCode
unqtDot

  listToDot :: Attributes -> DotCode
listToDot = Attributes -> DotCode
forall a. PrintDot a => [a] -> DotCode
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 :: Text -> a -> DotCode
printHtmlField f :: Text
f = Text -> DotCode -> DotCode
printHtmlField' Text
f (DotCode -> DotCode) -> (a -> DotCode) -> a -> DotCode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> DotCode
forall a. PrintDot a => a -> DotCode
unqtDot

printHtmlField'     :: T.Text -> DotCode -> DotCode
printHtmlField' :: Text -> DotCode -> DotCode
printHtmlField' f :: Text
f v :: DotCode
v = Text -> DotCode
forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
f DotCode -> DotCode -> DotCode
forall a. Semigroup a => a -> a -> a
<> DotCode
forall (m :: * -> *). Applicative m => m Doc
equals DotCode -> DotCode -> DotCode
forall a. Semigroup a => a -> a -> a
<> DotCode -> DotCode
forall (m :: * -> *). Functor m => m Doc -> m Doc
dquotes DotCode
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 "ALIGN"
                    , (Align -> Attribute) -> String -> Parse Attribute
forall a.
ParseDot a =>
(a -> Attribute) -> String -> Parse Attribute
parseHtmlField  Align -> Attribute
BAlign "BALIGN"
                    , (Color -> Attribute) -> String -> Parse Attribute
forall a.
ParseDot a =>
(a -> Attribute) -> String -> Parse Attribute
parseHtmlField  Color -> Attribute
BGColor "BGCOLOR"
                    , (Word8 -> Attribute) -> String -> Parse Attribute
forall a.
ParseDot a =>
(a -> Attribute) -> String -> Parse Attribute
parseHtmlField  Word8 -> Attribute
Border "BORDER"
                    , (Word8 -> Attribute) -> String -> Parse Attribute
forall a.
ParseDot a =>
(a -> Attribute) -> String -> Parse Attribute
parseHtmlField  Word8 -> Attribute
CellBorder "CELLBORDER"
                    , (Word8 -> Attribute) -> String -> Parse Attribute
forall a.
ParseDot a =>
(a -> Attribute) -> String -> Parse Attribute
parseHtmlField  Word8 -> Attribute
CellPadding "CELLPADDING"
                    , (Word8 -> Attribute) -> String -> Parse Attribute
forall a.
ParseDot a =>
(a -> Attribute) -> String -> Parse Attribute
parseHtmlField  Word8 -> Attribute
CellSpacing "CELLSPACING"
                    , (Color -> Attribute) -> String -> Parse Attribute
forall a.
ParseDot a =>
(a -> Attribute) -> String -> Parse Attribute
parseHtmlField  Color -> Attribute
Color "COLOR"
                    , (Word16 -> Attribute) -> String -> Parse Attribute
forall a.
ParseDot a =>
(a -> Attribute) -> String -> Parse Attribute
parseHtmlField  Word16 -> Attribute
ColSpan "COLSPAN"
                    , (CellFormat -> Attribute) -> String -> Parse Attribute
forall a.
ParseDot a =>
(a -> Attribute) -> String -> Parse Attribute
parseHtmlField  CellFormat -> Attribute
Columns "COLUMNS"
                    , (Text -> Attribute)
-> String -> Parser GraphvizState Text -> Parse Attribute
forall a. (a -> Attribute) -> String -> Parse a -> Parse Attribute
parseHtmlField' Text -> Attribute
Face "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 "FIXEDSIZE" Parse Bool
parseBoolHtml
                    , (Int -> Attribute) -> String -> Parse Attribute
forall a.
ParseDot a =>
(a -> Attribute) -> String -> Parse Attribute
parseHtmlField  Int -> Attribute
GradientAngle "GRADIENTANGLE"
                    , (Word16 -> Attribute) -> String -> Parse Attribute
forall a.
ParseDot a =>
(a -> Attribute) -> String -> Parse Attribute
parseHtmlField  Word16 -> Attribute
Height "HEIGHT"
                    , (Text -> Attribute)
-> String -> Parser GraphvizState Text -> Parse Attribute
forall a. (a -> Attribute) -> String -> Parse a -> Parse Attribute
parseHtmlField' Text -> Attribute
HRef "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 "ID" Parser GraphvizState Text
unescapeAttribute
                    , (Double -> Attribute) -> String -> Parse Attribute
forall a.
ParseDot a =>
(a -> Attribute) -> String -> Parse Attribute
parseHtmlField  Double -> Attribute
PointSize "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) "PORT" Parser GraphvizState Text
unescapeAttribute
                    , (CellFormat -> Attribute) -> String -> Parse Attribute
forall a.
ParseDot a =>
(a -> Attribute) -> String -> Parse Attribute
parseHtmlField  CellFormat -> Attribute
Rows "ROWS"
                    , (Word16 -> Attribute) -> String -> Parse Attribute
forall a.
ParseDot a =>
(a -> Attribute) -> String -> Parse Attribute
parseHtmlField  Word16 -> Attribute
RowSpan "ROWSPAN"
                    , (Scale -> Attribute) -> String -> Parse Attribute
forall a.
ParseDot a =>
(a -> Attribute) -> String -> Parse Attribute
parseHtmlField  Scale -> Attribute
Scale "SCALE"
                    , ([Side] -> Attribute) -> String -> Parse Attribute
forall a.
ParseDot a =>
(a -> Attribute) -> String -> Parse Attribute
parseHtmlField  [Side] -> Attribute
Sides "SIDES"
                    , (String -> Attribute) -> String -> Parse String -> Parse Attribute
forall a. (a -> Attribute) -> String -> Parse a -> Parse Attribute
parseHtmlField' String -> Attribute
Src "SRC" (Parse String -> Parse Attribute)
-> Parse String -> Parse Attribute
forall a b. (a -> b) -> a -> b
$ (Text -> String) -> Parser GraphvizState Text -> Parse String
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 "STYLE"
                    , (Text -> Attribute)
-> String -> Parser GraphvizState Text -> Parse Attribute
forall a. (a -> Attribute) -> String -> Parse a -> Parse Attribute
parseHtmlField' Text -> Attribute
Target "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 "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 "TOOLTIP" Parser GraphvizState Text
unescapeAttribute
                    , (VAlign -> Attribute) -> String -> Parse Attribute
forall a.
ParseDot a =>
(a -> Attribute) -> String -> Parse Attribute
parseHtmlField  VAlign -> Attribute
VAlign "VALIGN"
                    , (Word16 -> Attribute) -> String -> Parse Attribute
forall a.
ParseDot a =>
(a -> Attribute) -> String -> Parse Attribute
parseHtmlField  Word16 -> Attribute
Width "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 :: (a -> Attribute) -> String -> Parse Attribute
parseHtmlField c :: a -> Attribute
c f :: 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' :: (a -> Attribute) -> String -> Parse a -> Parse Attribute
parseHtmlField' c :: a -> Attribute
c f :: String
f p :: Parse a
p = String -> Parser GraphvizState ()
string String
f
                        Parser GraphvizState ()
-> Parser GraphvizState () -> Parser GraphvizState ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser GraphvizState ()
parseEq
                        Parser GraphvizState () -> Parse Attribute -> Parse Attribute
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 (p :: * -> *) a. Commitment p => p a -> ShowS -> p a
`adjustErr`
                                      (("Can't parse HTML.Attribute." String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
f String -> ShowS
forall a. [a] -> [a] -> [a]
++ "\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
/= :: Align -> Align -> Bool
$c/= :: Align -> Align -> Bool
== :: Align -> Align -> Bool
$c== :: 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
min :: Align -> Align -> Align
$cmin :: Align -> Align -> Align
max :: Align -> Align -> Align
$cmax :: Align -> Align -> Align
>= :: Align -> Align -> Bool
$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
compare :: Align -> Align -> Ordering
$ccompare :: Align -> Align -> Ordering
$cp1Ord :: Eq Align
Ord, Align
Align -> Align -> Bounded Align
forall a. a -> a -> Bounded a
maxBound :: Align
$cmaxBound :: Align
minBound :: Align
$cminBound :: 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
enumFromThenTo :: Align -> Align -> Align -> [Align]
$cenumFromThenTo :: Align -> Align -> Align -> [Align]
enumFromTo :: Align -> Align -> [Align]
$cenumFromTo :: Align -> Align -> [Align]
enumFromThen :: Align -> Align -> [Align]
$cenumFromThen :: Align -> Align -> [Align]
enumFrom :: Align -> [Align]
$cenumFrom :: Align -> [Align]
fromEnum :: Align -> Int
$cfromEnum :: Align -> Int
toEnum :: Int -> Align
$ctoEnum :: Int -> Align
pred :: Align -> Align
$cpred :: Align -> Align
succ :: Align -> Align
$csucc :: 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
showList :: [Align] -> ShowS
$cshowList :: [Align] -> ShowS
show :: Align -> String
$cshow :: Align -> String
showsPrec :: Int -> Align -> ShowS
$cshowsPrec :: Int -> 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
readListPrec :: ReadPrec [Align]
$creadListPrec :: ReadPrec [Align]
readPrec :: ReadPrec Align
$creadPrec :: ReadPrec Align
readList :: ReadS [Align]
$creadList :: ReadS [Align]
readsPrec :: Int -> ReadS Align
$creadsPrec :: Int -> ReadS Align
Read)

instance PrintDot Align where
  unqtDot :: Align -> DotCode
unqtDot HLeft   = Text -> DotCode
forall (m :: * -> *). Applicative m => Text -> m Doc
text "LEFT"
  unqtDot HCenter = Text -> DotCode
forall (m :: * -> *). Applicative m => Text -> m Doc
text "CENTER"
  unqtDot HRight  = Text -> DotCode
forall (m :: * -> *). Applicative m => Text -> m Doc
text "RIGHT"
  unqtDot HText   = Text -> DotCode
forall (m :: * -> *). Applicative m => Text -> m Doc
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 "LEFT"
                    , Align -> String -> Parse Align
forall a. a -> String -> Parse a
stringRep Align
HCenter "CENTER"
                    , Align -> String -> Parse Align
forall a. a -> String -> Parse a
stringRep Align
HRight "RIGHT"
                    , Align -> String -> Parse Align
forall a. a -> String -> Parse a
stringRep Align
HText "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
/= :: VAlign -> VAlign -> Bool
$c/= :: VAlign -> VAlign -> Bool
== :: VAlign -> VAlign -> Bool
$c== :: 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
min :: VAlign -> VAlign -> VAlign
$cmin :: VAlign -> VAlign -> VAlign
max :: VAlign -> VAlign -> VAlign
$cmax :: VAlign -> VAlign -> VAlign
>= :: VAlign -> VAlign -> Bool
$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
compare :: VAlign -> VAlign -> Ordering
$ccompare :: VAlign -> VAlign -> Ordering
$cp1Ord :: Eq VAlign
Ord, VAlign
VAlign -> VAlign -> Bounded VAlign
forall a. a -> a -> Bounded a
maxBound :: VAlign
$cmaxBound :: VAlign
minBound :: VAlign
$cminBound :: 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
enumFromThenTo :: VAlign -> VAlign -> VAlign -> [VAlign]
$cenumFromThenTo :: VAlign -> VAlign -> VAlign -> [VAlign]
enumFromTo :: VAlign -> VAlign -> [VAlign]
$cenumFromTo :: VAlign -> VAlign -> [VAlign]
enumFromThen :: VAlign -> VAlign -> [VAlign]
$cenumFromThen :: VAlign -> VAlign -> [VAlign]
enumFrom :: VAlign -> [VAlign]
$cenumFrom :: VAlign -> [VAlign]
fromEnum :: VAlign -> Int
$cfromEnum :: VAlign -> Int
toEnum :: Int -> VAlign
$ctoEnum :: Int -> VAlign
pred :: VAlign -> VAlign
$cpred :: VAlign -> VAlign
succ :: VAlign -> VAlign
$csucc :: 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
showList :: [VAlign] -> ShowS
$cshowList :: [VAlign] -> ShowS
show :: VAlign -> String
$cshow :: VAlign -> String
showsPrec :: Int -> VAlign -> ShowS
$cshowsPrec :: Int -> 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
readListPrec :: ReadPrec [VAlign]
$creadListPrec :: ReadPrec [VAlign]
readPrec :: ReadPrec VAlign
$creadPrec :: ReadPrec VAlign
readList :: ReadS [VAlign]
$creadList :: ReadS [VAlign]
readsPrec :: Int -> ReadS VAlign
$creadsPrec :: Int -> ReadS VAlign
Read)

instance PrintDot VAlign where
  unqtDot :: VAlign -> DotCode
unqtDot HTop    = Text -> DotCode
forall (m :: * -> *). Applicative m => Text -> m Doc
text "TOP"
  unqtDot HMiddle = Text -> DotCode
forall (m :: * -> *). Applicative m => Text -> m Doc
text "MIDDLE"
  unqtDot HBottom = Text -> DotCode
forall (m :: * -> *). Applicative m => Text -> m Doc
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 "TOP"
                    , VAlign -> String -> Parse VAlign
forall a. a -> String -> Parse a
stringRep VAlign
HMiddle "MIDDLE"
                    , VAlign -> String -> Parse VAlign
forall a. a -> String -> Parse a
stringRep VAlign
HBottom "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
/= :: CellFormat -> CellFormat -> Bool
$c/= :: CellFormat -> CellFormat -> Bool
== :: CellFormat -> CellFormat -> Bool
$c== :: 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
min :: CellFormat -> CellFormat -> CellFormat
$cmin :: CellFormat -> CellFormat -> CellFormat
max :: CellFormat -> CellFormat -> CellFormat
$cmax :: CellFormat -> CellFormat -> CellFormat
>= :: CellFormat -> CellFormat -> Bool
$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
compare :: CellFormat -> CellFormat -> Ordering
$ccompare :: CellFormat -> CellFormat -> Ordering
$cp1Ord :: Eq CellFormat
Ord, CellFormat
CellFormat -> CellFormat -> Bounded CellFormat
forall a. a -> a -> Bounded a
maxBound :: CellFormat
$cmaxBound :: CellFormat
minBound :: CellFormat
$cminBound :: 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
enumFromThenTo :: CellFormat -> CellFormat -> CellFormat -> [CellFormat]
$cenumFromThenTo :: CellFormat -> CellFormat -> CellFormat -> [CellFormat]
enumFromTo :: CellFormat -> CellFormat -> [CellFormat]
$cenumFromTo :: CellFormat -> CellFormat -> [CellFormat]
enumFromThen :: CellFormat -> CellFormat -> [CellFormat]
$cenumFromThen :: CellFormat -> CellFormat -> [CellFormat]
enumFrom :: CellFormat -> [CellFormat]
$cenumFrom :: CellFormat -> [CellFormat]
fromEnum :: CellFormat -> Int
$cfromEnum :: CellFormat -> Int
toEnum :: Int -> CellFormat
$ctoEnum :: Int -> CellFormat
pred :: CellFormat -> CellFormat
$cpred :: CellFormat -> CellFormat
succ :: CellFormat -> CellFormat
$csucc :: 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
showList :: [CellFormat] -> ShowS
$cshowList :: [CellFormat] -> ShowS
show :: CellFormat -> String
$cshow :: CellFormat -> String
showsPrec :: Int -> CellFormat -> ShowS
$cshowsPrec :: Int -> 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
readListPrec :: ReadPrec [CellFormat]
$creadListPrec :: ReadPrec [CellFormat]
readPrec :: ReadPrec CellFormat
$creadPrec :: ReadPrec CellFormat
readList :: ReadS [CellFormat]
$creadList :: ReadS [CellFormat]
readsPrec :: Int -> ReadS CellFormat
$creadsPrec :: Int -> ReadS CellFormat
Read)

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

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

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

instance PrintDot Scale where
  unqtDot :: Scale -> DotCode
unqtDot NaturalSize    = Text -> DotCode
forall (m :: * -> *). Applicative m => Text -> m Doc
text "FALSE"
  unqtDot ScaleUniformly = Text -> DotCode
forall (m :: * -> *). Applicative m => Text -> m Doc
text "TRUE"
  unqtDot ExpandWidth    = Text -> DotCode
forall (m :: * -> *). Applicative m => Text -> m Doc
text "WIDTH"
  unqtDot ExpandHeight   = Text -> DotCode
forall (m :: * -> *). Applicative m => Text -> m Doc
text "HEIGHT"
  unqtDot ExpandBoth     = Text -> DotCode
forall (m :: * -> *). Applicative m => Text -> m Doc
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 "FALSE"
                    , Scale -> String -> Parse Scale
forall a. a -> String -> Parse a
stringRep Scale
ScaleUniformly "TRUE"
                    , Scale -> String -> Parse Scale
forall a. a -> String -> Parse a
stringRep Scale
ExpandWidth "WIDTH"
                    , Scale -> String -> Parse Scale
forall a. a -> String -> Parse a
stringRep Scale
ExpandHeight "HEIGHT"
                    , Scale -> String -> Parse Scale
forall a. a -> String -> Parse a
stringRep Scale
ExpandBoth "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
/= :: Side -> Side -> Bool
$c/= :: Side -> Side -> Bool
== :: Side -> Side -> Bool
$c== :: 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
min :: Side -> Side -> Side
$cmin :: Side -> Side -> Side
max :: Side -> Side -> Side
$cmax :: Side -> Side -> Side
>= :: Side -> Side -> Bool
$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
compare :: Side -> Side -> Ordering
$ccompare :: Side -> Side -> Ordering
$cp1Ord :: Eq Side
Ord, Side
Side -> Side -> Bounded Side
forall a. a -> a -> Bounded a
maxBound :: Side
$cmaxBound :: Side
minBound :: Side
$cminBound :: 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
enumFromThenTo :: Side -> Side -> Side -> [Side]
$cenumFromThenTo :: Side -> Side -> Side -> [Side]
enumFromTo :: Side -> Side -> [Side]
$cenumFromTo :: Side -> Side -> [Side]
enumFromThen :: Side -> Side -> [Side]
$cenumFromThen :: Side -> Side -> [Side]
enumFrom :: Side -> [Side]
$cenumFrom :: Side -> [Side]
fromEnum :: Side -> Int
$cfromEnum :: Side -> Int
toEnum :: Int -> Side
$ctoEnum :: Int -> Side
pred :: Side -> Side
$cpred :: Side -> Side
succ :: Side -> Side
$csucc :: 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
showList :: [Side] -> ShowS
$cshowList :: [Side] -> ShowS
show :: Side -> String
$cshow :: Side -> String
showsPrec :: Int -> Side -> ShowS
$cshowsPrec :: Int -> 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
readListPrec :: ReadPrec [Side]
$creadListPrec :: ReadPrec [Side]
readPrec :: ReadPrec Side
$creadPrec :: ReadPrec Side
readList :: ReadS [Side]
$creadList :: ReadS [Side]
readsPrec :: Int -> ReadS Side
$creadsPrec :: Int -> ReadS Side
Read)

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

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

  listToDot :: [Side] -> DotCode
listToDot = [Side] -> DotCode
forall a. PrintDot a => [a] -> DotCode
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   "L"
                    , Side -> String -> Parse Side
forall a. a -> String -> Parse a
stringRep Side
RightSide  "R"
                    , Side -> String -> Parse Side
forall a. a -> String -> Parse a
stringRep Side
TopSide    "T"
                    , Side -> String -> Parse Side
forall a. a -> String -> Parse a
stringRep Side
BottomSide "B"
                    ]

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

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

instance PrintDot Style where
  unqtDot :: Style -> DotCode
unqtDot Rounded = Text -> DotCode
forall (m :: * -> *). Applicative m => Text -> m Doc
text "ROUNDED"
  unqtDot Radial  = Text -> DotCode
forall (m :: * -> *). Applicative m => Text -> m Doc
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 "ROUNDED"
                    , Style -> String -> Parse Style
forall a. a -> String -> Parse a
stringRep Style
Radial  "RADIAL"
                    ]

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

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

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

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

escapeHtml               :: Bool -> T.Text -> DotCode
escapeHtml :: Bool -> Text -> DotCode
escapeHtml quotesAllowed :: Bool
quotesAllowed = DotCodeM [Doc] -> DotCode
forall (m :: * -> *). Functor m => m [Doc] -> m Doc
hcat (DotCodeM [Doc] -> DotCode)
-> (Text -> DotCodeM [Doc]) -> Text -> DotCode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([[Doc]] -> [Doc]) -> DotCodeM [[Doc]] -> DotCodeM [Doc]
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)
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 (s :: Char
s:sps :: String
sps) | Char -> Bool
isSpace Char
s = (Doc -> [Doc] -> [Doc])
-> DotCode -> DotCodeM [Doc] -> DotCodeM [Doc]
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (:) (Char -> DotCode
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 -> DotCode) -> String -> DotCodeM [Doc]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Char -> DotCode
numEscape String
sps
    escapeSegment txt :: String
txt                 = (Char -> DotCode) -> String -> DotCodeM [Doc]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Char -> DotCode
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 '"'
                  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 -> DotCode
xmlChar c :: Char
c = DotCode -> (Text -> DotCode) -> Maybe Text -> DotCode
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Char -> DotCode
forall (m :: * -> *). Applicative m => Char -> m Doc
char Char
c) Text -> DotCode
escape (Maybe Text -> DotCode) -> Maybe Text -> DotCode
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 -> DotCode
numEscape = DotCode -> DotCode
forall (m :: * -> *).
(Semigroup (m Doc), Applicative m) =>
m Doc -> m Doc
escape' (DotCode -> DotCode) -> (Char -> DotCode) -> Char -> DotCode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DotCode -> DotCode -> DotCode
forall a. Semigroup a => a -> a -> a
(<>) (Char -> DotCode
forall (m :: * -> *). Applicative m => Char -> m Doc
char '#') (DotCode -> DotCode) -> (Char -> DotCode) -> Char -> DotCode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> DotCode
forall (m :: * -> *). Applicative m => Int -> m Doc
int (Int -> DotCode) -> (Char -> Int) -> Char -> DotCode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord
    escape' :: m Doc -> m Doc
escape' e :: m Doc
e = Char -> m Doc
forall (m :: * -> *). Applicative m => Char -> m Doc
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 ';'
    escape :: Text -> DotCode
escape = DotCode -> DotCode
forall (m :: * -> *).
(Semigroup (m Doc), Applicative m) =>
m Doc -> m Doc
escape' (DotCode -> DotCode) -> (Text -> DotCode) -> Text -> DotCode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> DotCode
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 quotesAllowed :: Bool
quotesAllowed = ([Maybe Char] -> Text)
-> Parser GraphvizState [Maybe Char] -> Parser GraphvizState Text
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 '&'
                    Text
esc <- (Char -> Bool) -> Parser GraphvizState Text
forall s. (Char -> Bool) -> Parser s Text
many1Satisfy (';' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=)
                    Char -> Parse Char
character ';'
                    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 ('#',dec :: Text
dec) | Just ('x',hex :: 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
                              _                -> 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 (m :: * -> *) a. Monad m => a -> m a
return Maybe Char
c

    readMaybe :: (t -> [(Int, [a])]) -> t -> Maybe Char
readMaybe f :: t -> [(Int, [a])]
f str :: t
str = do (n :: 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 (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 '"'
                  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 (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 = [ ('"', "quot")
              , ('<', "lt")
              , ('>', "gt")
              , ('&', "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 = [("nbsp", ' '), ("apos", '\'')]

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

parseBoolHtml :: Parse Bool
parseBoolHtml :: Parse Bool
parseBoolHtml = Bool -> String -> Parse Bool
forall a. a -> String -> Parse a
stringRep Bool
True "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 "FALSE"

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

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

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

-- | Print something like @<FOO ATTR=\"ATTR_VALUE\"\/>@
printEmptyTag      :: DotCode -> Attributes -> DotCode
printEmptyTag :: DotCode -> Attributes -> DotCode
printEmptyTag t :: DotCode
t as :: Attributes
as = DotCode -> DotCode
angled (DotCode -> DotCode) -> DotCode -> DotCode
forall a b. (a -> b) -> a -> b
$ DotCode
t DotCode -> DotCode -> DotCode
forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> Attributes -> DotCode
forall a. PrintDot a => a -> DotCode
toDot Attributes
as DotCode -> DotCode -> DotCode
forall a. Semigroup a => a -> a -> a
<> DotCode
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 :: (Attributes -> val -> tag) -> String -> Parse val -> Parse tag
parseTag c :: Attributes -> val -> tag
c t :: String
t pv :: 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 -> Parse tag
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
                    Parse tag -> Parser GraphvizState () -> Parse tag
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 '/' Parse Char -> Parser GraphvizState () -> Parser GraphvizState ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser GraphvizState ()
t' Parser GraphvizState ()
-> Parser GraphvizState () -> Parser GraphvizState ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser GraphvizState ()
whitespace)
                  Parser GraphvizState () -> ShowS -> Parser GraphvizState ()
forall (p :: * -> *) a. Commitment p => p a -> ShowS -> p a
`adjustErr`
                  (("Can't parse Html tag: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
t String -> ShowS
forall a. [a] -> [a] -> [a]
++ "\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 (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 (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 (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser GraphvizState ()
whitespace

parseFontTag :: (Attributes -> val -> tag) -> Parse val -> Parse tag
parseFontTag :: (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` "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 :: (tagName -> val -> tag) -> Parse tagName -> Parse val -> Parse tag
parseTagRep c :: tagName -> val -> tag
c pt :: Parse tagName
pt pv :: 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 -> Parse tag
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parse val
pv
                        Parse tag -> Parser GraphvizState () -> Parse tag
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 '/' Parse Char -> Parse tagName -> Parse tagName
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parse tagName
pt Parse tagName -> Parser GraphvizState () -> Parser GraphvizState ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser GraphvizState ()
whitespace)
                    Parser GraphvizState () -> ShowS -> Parser GraphvizState ()
forall (p :: * -> *) a. Commitment p => p a -> ShowS -> p a
`adjustErr`
                    ("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 :: (Attributes -> tag) -> String -> Parse tag
parseEmptyTag c :: Attributes -> tag
c t :: String
t = Attributes -> tag
c (Attributes -> tag) -> Parse Attributes -> Parse 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 (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 (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 (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser GraphvizState ()
whitespace
                          Parse Attributes -> Parse Char -> Parse Attributes
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parse Char
character '/'
                        )
                    Parse Attributes -> ShowS -> Parse Attributes
forall (p :: * -> *) a. Commitment p => p a -> ShowS -> p a
`adjustErr`
                    (("Can't parse empty Html tag: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
t String -> ShowS
forall a. [a] -> [a] -> [a]
++ "\n\t")String -> ShowS
forall a. [a] -> [a] -> [a]
++)