{-# 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
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
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
Ord, Int -> Label -> ShowS
[Label] -> ShowS
Label -> String
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]
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 -> DotCodeM Doc
unqtDot (Text Text
txt)  = forall a. PrintDot a => a -> DotCodeM Doc
unqtDot Text
txt
  unqtDot (Table Table
tbl) = forall a. PrintDot a => a -> DotCodeM Doc
unqtDot Table
tbl

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

  parse :: Parse Label
parse = 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
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
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
Ord, Int -> TextItem -> ShowS
Text -> ShowS
TextItem -> String
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
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 -> DotCodeM Doc
unqtDot (Str Text
str)        = Text -> DotCodeM Doc
escapeValue Text
str
  unqtDot (Newline Attributes
as)     = DotCodeM Doc -> Attributes -> DotCodeM Doc
printEmptyTag (forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"BR") Attributes
as
  unqtDot (Font Attributes
as Text
txt)    = Attributes -> DotCodeM Doc -> DotCodeM Doc
printFontTag Attributes
as forall a b. (a -> b) -> a -> b
$ forall a. PrintDot a => a -> DotCodeM Doc
unqtDot Text
txt
  unqtDot (Format Format
fmt Text
txt) = DotCodeM Doc -> Attributes -> DotCodeM Doc -> DotCodeM Doc
printTag (forall a. PrintDot a => a -> DotCodeM Doc
unqtDot Format
fmt) [] forall a b. (a -> b) -> a -> b
$ forall a. PrintDot a => a -> DotCodeM Doc
unqtDot Text
txt

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

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

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

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

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

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

data Format = Italics
              | Bold
              | Underline
              | Overline -- ^ Requires Graphviz >= 2.38.0.
              | Subscript
              | Superscript
              deriving (Format -> Format -> Bool
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
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
Ord, 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]
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
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]
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 -> DotCodeM Doc
unqtDot Format
Italics     = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"I"
  unqtDot Format
Bold        = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"B"
  unqtDot Format
Underline   = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"U"
  unqtDot Format
Overline    = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"O"
  unqtDot Format
Subscript   = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"SUB"
  unqtDot Format
Superscript = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"SUP"

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

-- | A table in HTML-like labels.  Tables are optionally wrapped in
--   overall @FONT@ tags.
data Table = HTable { -- | Optional @FONT@ attributes.  @'Just'
                      --   []@ denotes empty @FONT@ tags;
                      --   @'Nothing'@ denotes no such tags.
                      Table -> Maybe Attributes
tableFontAttrs :: Maybe Attributes
                    , Table -> Attributes
tableAttrs     :: Attributes
                      -- | This list is assumed to be non-empty.
                    , Table -> [Row]
tableRows      :: [Row]
                    }
               deriving (Table -> Table -> Bool
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
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
Ord, Int -> Table -> ShowS
[Table] -> ShowS
Table -> String
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]
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 -> DotCodeM Doc
unqtDot Table
tbl = case Table -> Maybe Attributes
tableFontAttrs Table
tbl of
                  (Just Attributes
as) -> Attributes -> DotCodeM Doc -> DotCodeM Doc
printFontTag Attributes
as DotCodeM Doc
tbl'
                  Maybe Attributes
Nothing   -> DotCodeM Doc
tbl'
    where
      tbl' :: DotCodeM Doc
tbl' = DotCodeM Doc -> Attributes -> DotCodeM Doc -> DotCodeM Doc
printTag (forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"TABLE")
                          (Table -> Attributes
tableAttrs Table
tbl)
                          (forall a. PrintDot a => a -> DotCodeM Doc
toDot forall a b. (a -> b) -> a -> b
$ Table -> [Row]
tableRows Table
tbl)

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

  parse :: Parse Table
parse = 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
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
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
Ord, Int -> Row -> ShowS
[Row] -> ShowS
Row -> String
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]
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 -> DotCodeM Doc
unqtDot (Cells [Cell]
cs)     = DotCodeM Doc -> Attributes -> DotCodeM Doc -> DotCodeM Doc
printTag (forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"TR") [] forall a b. (a -> b) -> a -> b
$ forall a. PrintDot a => a -> DotCodeM Doc
unqtDot [Cell]
cs
  unqtDot Row
HorizontalRule = DotCodeM Doc -> Attributes -> DotCodeM Doc
printEmptyTag (forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"HR") []

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

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

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

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

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

  parseList :: Parse [Row]
parseList = 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
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
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
Ord, Int -> Cell -> ShowS
[Cell] -> ShowS
Cell -> String
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]
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 -> DotCodeM Doc
unqtDot (LabelCell Attributes
as Label
l) = Attributes -> DotCodeM Doc -> DotCodeM Doc
printCell Attributes
as forall a b. (a -> b) -> a -> b
$ forall a. PrintDot a => a -> DotCodeM Doc
unqtDot Label
l
  unqtDot (ImgCell Attributes
as Img
img) = Attributes -> DotCodeM Doc -> DotCodeM Doc
printCell Attributes
as forall a b. (a -> b) -> a -> b
$ forall a. PrintDot a => a -> DotCodeM Doc
unqtDot Img
img
  unqtDot Cell
VerticalRule     = DotCodeM Doc -> Attributes -> DotCodeM Doc
printEmptyTag (forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"VR") []

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

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

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

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

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

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

  parseList :: Parse [Cell]
parseList = 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
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
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
Ord, Int -> Img -> ShowS
[Img] -> ShowS
Img -> String
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]
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 -> DotCodeM Doc
unqtDot (Img Attributes
as) = DotCodeM Doc -> Attributes -> DotCodeM Doc
printEmptyTag (forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"IMG") Attributes
as

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

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

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

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

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

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

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

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

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

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



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

parseHtmlField'       :: (a -> Attribute) -> String -> Parse a
                     -> Parse Attribute
parseHtmlField' :: forall a. (a -> Attribute) -> String -> Parse a -> Parse Attribute
parseHtmlField' a -> Attribute
c String
f Parse a
p = String -> Parse ()
string String
f
                        forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parse ()
parseEq
                        forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ( a -> Attribute
c forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ( forall a. Parse a -> Parse a
quotedParse Parse a
p
                                      forall (p :: * -> *) a. Commitment p => p a -> ShowS -> p a
`adjustErr`
                                      ((String
"Can't parse HTML.Attribute." forall a. [a] -> [a] -> [a]
++ String
f forall a. [a] -> [a] -> [a]
++ String
"\n\t")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
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
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
Ord, 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]
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
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]
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 -> DotCodeM Doc
unqtDot Align
HLeft   = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"LEFT"
  unqtDot Align
HCenter = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"CENTER"
  unqtDot Align
HRight  = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"RIGHT"
  unqtDot Align
HText   = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"TEXT"

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

  parse :: Parse Align
parse = 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
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
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
Ord, 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]
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
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]
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 -> DotCodeM Doc
unqtDot VAlign
HTop    = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"TOP"
  unqtDot VAlign
HMiddle = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"MIDDLE"
  unqtDot VAlign
HBottom = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"BOTTOM"

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

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

data CellFormat = RuleBetween
                deriving (CellFormat -> CellFormat -> Bool
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
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
Ord, 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]
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
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]
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 -> DotCodeM Doc
unqtDot CellFormat
RuleBetween = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"*"

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

  parse :: Parse CellFormat
parse = 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
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
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
Ord, 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]
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
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]
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 -> DotCodeM Doc
unqtDot Scale
NaturalSize    = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"FALSE"
  unqtDot Scale
ScaleUniformly = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"TRUE"
  unqtDot Scale
ExpandWidth    = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"WIDTH"
  unqtDot Scale
ExpandHeight   = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"HEIGHT"
  unqtDot Scale
ExpandBoth     = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"BOTH"

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

  parse :: Parse Scale
parse = 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
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
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
Ord, 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]
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
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]
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 -> DotCodeM Doc
unqtDot Side
LeftSide   = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"L"
  unqtDot Side
RightSide  = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"R"
  unqtDot Side
TopSide    = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"T"
  unqtDot Side
BottomSide = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"B"

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

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

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

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

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

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

data Style = Rounded  -- ^ Valid for 'Table'
           | Radial   -- ^ Valid for 'Table', 'Cell'.
           deriving (Style -> Style -> Bool
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
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
Ord, 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]
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
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]
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 -> DotCodeM Doc
unqtDot Style
Rounded = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"ROUNDED"
  unqtDot Style
Radial  = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"RADIAL"

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

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

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

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

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

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

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

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

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

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

unescapeValue :: Parse T.Text
unescapeValue :: Parse Text
unescapeValue = Bool -> Parse 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 -> Parse Text
unescapeHtml Bool
quotesAllowed = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [Maybe a] -> [a]
catMaybes)
                             forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> *) a. PolyParse p => p a -> p [a]
many1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> *) a. PolyParse p => [p a] -> p a
oneOf forall a b. (a -> b) -> a -> b
$ [ Parser GraphvizState (Maybe Char)
parseEscpd
                                               , forall {s}. Parser s (Maybe Char)
validChars
                                               ]
  where
    parseEscpd :: Parse (Maybe Char)
    parseEscpd :: Parser GraphvizState (Maybe Char)
parseEscpd = do Char -> Parse Char
character Char
'&'
                    Text
esc <- forall s. (Char -> Bool) -> Parser s Text
many1Satisfy (Char
';' forall a. Eq a => a -> a -> Bool
/=)
                    Char -> Parse Char
character Char
';'
                    let c :: Maybe Char
c = case Text -> Maybe (Char, Text)
T.uncons forall a b. (a -> b) -> a -> b
$ Text -> Text
T.toLower Text
esc of
                              Just (Char
'#',Text
dec) | Just (Char
'x',Text
hex) <- Text -> Maybe (Char, Text)
T.uncons Text
dec
                                               -> forall {t} {a}. (t -> [(Int, [a])]) -> t -> Maybe Char
readMaybe forall a. (Eq a, Num a) => ReadS a
readHex forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
hex
                                             | Bool
otherwise
                                               -> forall {t} {a}. (t -> [(Int, [a])]) -> t -> Maybe Char
readMaybe ReadS Int
readInt forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
dec
                              Maybe (Char, Text)
_                -> Text
esc forall k a. Ord k => k -> Map k a -> Maybe a
`Map.lookup` Map Text Char
escMap
                    forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Char
c

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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