{-# LANGUAGE CPP, OverloadedStrings, PatternGuards #-}
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
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
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 Text
txt) = Text -> DotCode
forall a. PrintDot a => a -> DotCode
unqtDot Text
txt
unqtDot (Table Table
tbl) = Table -> DotCode
forall a. PrintDot a => a -> DotCode
unqtDot Table
tbl
instance ParseDot Label where
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`
(String
"Can't parse Html.Label\n\t"String -> ShowS
forall a. [a] -> [a] -> [a]
++)
parse :: Parse Label
parse = Parse Label
forall a. ParseDot a => Parse a
parseUnqt
type Text = [TextItem]
data TextItem = Str T.Text
| Newline Attributes
| Font Attributes Text
| 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
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 Text
str) = Text -> DotCode
escapeValue Text
str
unqtDot (Newline Attributes
as) = DotCode -> Attributes -> DotCode
printEmptyTag (Text -> DotCode
forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"BR") Attributes
as
unqtDot (Font Attributes
as 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 Format
fmt 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 String
"BR"
, (Attributes -> Text -> TextItem)
-> Parser GraphvizState Text -> Parse TextItem
forall val tag.
(Attributes -> val -> tag) -> Parse val -> Parse tag
parseFontTag Attributes -> Text -> TextItem
Font Parser GraphvizState Text
forall a. ParseDot a => Parse a
parseUnqt
, (Format -> Text -> TextItem)
-> Parse Format -> Parser GraphvizState Text -> Parse TextItem
forall tagName val tag.
(tagName -> val -> tag) -> Parse tagName -> Parse val -> Parse tag
parseTagRep Format -> Text -> TextItem
Format Parse Format
forall a. ParseDot a => Parse a
parseUnqt Parser GraphvizState Text
forall a. ParseDot a => Parse a
parseUnqt
]
Parse TextItem -> ShowS -> Parse TextItem
forall (p :: * -> *) a. Commitment p => p a -> ShowS -> p a
`adjustErr`
(String
"Can't parse Html.TextItem\n\t"String -> ShowS
forall a. [a] -> [a] -> [a]
++)
parse :: Parse TextItem
parse = Parse TextItem
forall a. ParseDot a => Parse a
parseUnqt
parseUnqtList :: Parser GraphvizState Text
parseUnqtList = Parse TextItem -> Parser GraphvizState Text
forall (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
| 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
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 Format
Italics = Text -> DotCode
forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"I"
unqtDot Format
Bold = Text -> DotCode
forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"B"
unqtDot Format
Underline = Text -> DotCode
forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"U"
unqtDot Format
Overline = Text -> DotCode
forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"O"
unqtDot Format
Subscript = Text -> DotCode
forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"SUB"
unqtDot Format
Superscript = Text -> DotCode
forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"SUP"
instance ParseDot Format where
parseUnqt :: Parse Format
parseUnqt = [(String, Format)] -> Parse Format
forall a. [(String, a)] -> Parse a
stringValue [ (String
"I", Format
Italics)
, (String
"B", Format
Bold)
, (String
"U", Format
Underline)
, (String
"O", Format
Overline)
, (String
"SUB", Format
Subscript)
, (String
"SUP", Format
Superscript)
]
data Table = HTable {
Table -> Maybe Attributes
tableFontAttrs :: Maybe Attributes
, Table -> Attributes
tableAttrs :: Attributes
, 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
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 Table
tbl = case Table -> Maybe Attributes
tableFontAttrs Table
tbl of
(Just Attributes
as) -> Attributes -> DotCode -> DotCode
printFontTag Attributes
as DotCode
tbl'
Maybe Attributes
Nothing -> DotCode
tbl'
where
tbl' :: DotCode
tbl' = DotCode -> Attributes -> DotCode -> DotCode
printTag (Text -> DotCode
forall (m :: * -> *). Applicative m => Text -> m Doc
text 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`
(String
"Can't parse Html.Table\n\t"String -> ShowS
forall a. [a] -> [a] -> [a]
++)
where
pTbl :: Parser GraphvizState Table
pTbl = Parser GraphvizState Table -> Parser GraphvizState Table
forall a. Parse a -> Parse a
wrapWhitespace (Parser GraphvizState Table -> Parser GraphvizState Table)
-> Parser GraphvizState Table -> Parser GraphvizState Table
forall a b. (a -> b) -> a -> b
$ (Attributes -> [Row] -> Table)
-> String -> Parse [Row] -> Parser GraphvizState Table
forall val tag.
(Attributes -> val -> tag) -> String -> Parse val -> Parse tag
parseTag (Maybe Attributes -> Attributes -> [Row] -> Table
HTable Maybe Attributes
forall a. Maybe a
Nothing)
String
"TABLE"
(Parse [Row] -> Parse [Row]
forall a. Parse a -> Parse a
wrapWhitespace Parse [Row]
forall a. ParseDot a => Parse a
parseUnqt)
addFontAttrs :: Attributes -> Table -> Table
addFontAttrs Attributes
fas Table
tbl = Table
tbl { tableFontAttrs :: 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
data Row = Cells [Cell]
| HorizontalRule
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
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 [Cell]
cs) = DotCode -> Attributes -> DotCode -> DotCode
printTag (Text -> DotCode
forall (m :: * -> *). Applicative m => Text -> m Doc
text 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 Row
HorizontalRule = DotCode -> Attributes -> DotCode
printEmptyTag (Text -> DotCode
forall (m :: * -> *). Applicative m => Text -> m Doc
text 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
parseUnqt :: Parse Row
parseUnqt = Parse Row -> Parse Row
forall a. Parse a -> Parse a
wrapWhitespace (Parse Row -> Parse Row) -> Parse Row -> Parse Row
forall a b. (a -> b) -> a -> b
$ (Attributes -> [Cell] -> Row)
-> String -> Parse [Cell] -> Parse Row
forall val tag.
(Attributes -> val -> tag) -> String -> Parse val -> Parse tag
parseTag (([Cell] -> Row) -> Attributes -> [Cell] -> Row
forall a b. a -> b -> a
const [Cell] -> Row
Cells) String
"TR" Parse [Cell]
forall a. ParseDot a => Parse a
parseUnqt
Parse Row -> Parse Row -> Parse Row
forall s a. Parser s a -> Parser s a -> Parser s a
`onFail`
(Attributes -> Row) -> String -> Parse Row
forall tag. (Attributes -> tag) -> String -> Parse tag
parseEmptyTag (Row -> Attributes -> Row
forall a b. a -> b -> a
const Row
HorizontalRule) String
"HR"
Parse Row -> ShowS -> Parse Row
forall (p :: * -> *) a. Commitment p => p a -> ShowS -> p a
`adjustErr`
(String
"Can't parse Html.Row\n\t"String -> ShowS
forall a. [a] -> [a] -> [a]
++)
parse :: Parse Row
parse = Parse Row
forall a. ParseDot a => Parse a
parseUnqt
parseUnqtList :: Parse [Row]
parseUnqtList = Parse [Row] -> Parse [Row]
forall a. Parse a -> Parse a
wrapWhitespace (Parse [Row] -> Parse [Row]) -> Parse [Row] -> Parse [Row]
forall a b. (a -> b) -> a -> b
$ Parse Row -> Parser GraphvizState () -> Parse [Row]
forall (p :: * -> *) a sep. PolyParse p => p a -> p sep -> p [a]
sepBy1 Parse Row
forall a. ParseDot a => Parse a
parseUnqt Parser GraphvizState ()
whitespace
parseList :: Parse [Row]
parseList = Parse [Row]
forall a. ParseDot a => Parse [a]
parseUnqtList
data Cell = LabelCell Attributes Label
| ImgCell Attributes Img
| VerticalRule
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
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 Attributes
as 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 Attributes
as 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 Cell
VerticalRule = DotCode -> Attributes -> DotCode
printEmptyTag (Text -> DotCode
forall (m :: * -> *). Applicative m => Text -> m Doc
text 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 Text
"TD")
instance ParseDot Cell where
parseUnqt :: Parse Cell
parseUnqt = [Parse Cell] -> Parse Cell
forall (p :: * -> *) a. PolyParse p => [p a] -> p a
oneOf [ (Attributes -> Label -> Cell) -> Parse Label -> Parse Cell
forall val tag.
(Attributes -> val -> tag) -> Parse val -> Parse tag
parseCell Attributes -> Label -> Cell
LabelCell Parse Label
forall a. ParseDot a => Parse a
parse
, (Attributes -> Img -> Cell) -> Parse Img -> Parse Cell
forall val tag.
(Attributes -> val -> tag) -> Parse val -> Parse tag
parseCell Attributes -> Img -> Cell
ImgCell (Parse Img -> Parse Cell) -> Parse Img -> Parse Cell
forall a b. (a -> b) -> a -> b
$ Parse Img -> Parse Img
forall a. Parse a -> Parse a
wrapWhitespace Parse Img
forall a. ParseDot a => Parse a
parse
, (Attributes -> Cell) -> String -> Parse Cell
forall tag. (Attributes -> tag) -> String -> Parse tag
parseEmptyTag (Cell -> Attributes -> Cell
forall a b. a -> b -> a
const Cell
VerticalRule) String
"VR"
]
Parse Cell -> ShowS -> Parse Cell
forall (p :: * -> *) a. Commitment p => p a -> ShowS -> p a
`adjustErr`
(String
"Can't parse Html.Cell\n\t"String -> ShowS
forall a. [a] -> [a] -> [a]
++)
where
parseCell :: (Attributes -> val -> tag) -> Parse val -> Parse tag
parseCell = ((Attributes -> val -> tag) -> String -> Parse val -> Parse tag
forall val tag.
(Attributes -> val -> tag) -> String -> Parse val -> Parse tag
`parseTag` String
"TD")
parse :: Parse Cell
parse = Parse Cell
forall a. ParseDot a => Parse a
parseUnqt
parseUnqtList :: Parse [Cell]
parseUnqtList = Parse [Cell] -> Parse [Cell]
forall a. Parse a -> Parse a
wrapWhitespace (Parse [Cell] -> Parse [Cell]) -> Parse [Cell] -> Parse [Cell]
forall a b. (a -> b) -> a -> b
$ Parse Cell -> Parser GraphvizState () -> Parse [Cell]
forall (p :: * -> *) a sep. PolyParse p => p a -> p sep -> p [a]
sepBy1 Parse Cell
forall a. ParseDot a => Parse a
parseUnqt Parser GraphvizState ()
whitespace
parseList :: Parse [Cell]
parseList = Parse [Cell]
forall a. ParseDot a => Parse [a]
parseUnqtList
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
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 Attributes
as) = DotCode -> Attributes -> DotCode
printEmptyTag (Text -> DotCode
forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"IMG") Attributes
as
instance ParseDot Img where
parseUnqt :: Parse Img
parseUnqt = Parse Img -> Parse Img
forall a. Parse a -> Parse a
wrapWhitespace ((Attributes -> Img) -> String -> Parse Img
forall tag. (Attributes -> tag) -> String -> Parse tag
parseEmptyTag Attributes -> Img
Img String
"IMG")
Parse Img -> ShowS -> Parse Img
forall (p :: * -> *) a. Commitment p => p a -> ShowS -> p a
`adjustErr`
(String
"Can't parse Html.Img\n\t"String -> ShowS
forall a. [a] -> [a] -> [a]
++)
parse :: Parse Img
parse = Parse Img
forall a. ParseDot a => Parse a
parseUnqt
type Attributes = [Attribute]
data Attribute = Align Align
| BAlign Align
| BGColor Color
| Border Word8
| CellBorder Word8
| CellPadding Word8
| CellSpacing Word8
| Color Color
| ColSpan Word16
| Columns CellFormat
| Face T.Text
| FixedSize Bool
| GradientAngle Int
| Height Word16
| HRef T.Text
| ID T.Text
| PointSize Double
| Port PortName
| Rows CellFormat
| RowSpan Word16
| Scale Scale
| Sides [Side]
| Src FilePath
| Style Style
| Target T.Text
| Title T.Text
| VAlign VAlign
| Width Word16
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
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 Align
v) = Text -> Align -> DotCode
forall a. PrintDot a => Text -> a -> DotCode
printHtmlField Text
"ALIGN" Align
v
unqtDot (BAlign Align
v) = Text -> Align -> DotCode
forall a. PrintDot a => Text -> a -> DotCode
printHtmlField Text
"BALIGN" Align
v
unqtDot (BGColor Color
v) = Text -> Color -> DotCode
forall a. PrintDot a => Text -> a -> DotCode
printHtmlField Text
"BGCOLOR" Color
v
unqtDot (Border Word8
v) = Text -> Word8 -> DotCode
forall a. PrintDot a => Text -> a -> DotCode
printHtmlField Text
"BORDER" Word8
v
unqtDot (CellBorder Word8
v) = Text -> Word8 -> DotCode
forall a. PrintDot a => Text -> a -> DotCode
printHtmlField Text
"CELLBORDER" Word8
v
unqtDot (CellPadding Word8
v) = Text -> Word8 -> DotCode
forall a. PrintDot a => Text -> a -> DotCode
printHtmlField Text
"CELLPADDING" Word8
v
unqtDot (CellSpacing Word8
v) = Text -> Word8 -> DotCode
forall a. PrintDot a => Text -> a -> DotCode
printHtmlField Text
"CELLSPACING" Word8
v
unqtDot (Color Color
v) = Text -> Color -> DotCode
forall a. PrintDot a => Text -> a -> DotCode
printHtmlField Text
"COLOR" Color
v
unqtDot (ColSpan Word16
v) = Text -> Word16 -> DotCode
forall a. PrintDot a => Text -> a -> DotCode
printHtmlField Text
"COLSPAN" Word16
v
unqtDot (Columns CellFormat
v) = Text -> CellFormat -> DotCode
forall a. PrintDot a => Text -> a -> DotCode
printHtmlField Text
"COLUMNS" CellFormat
v
unqtDot (Face Text
v) = Text -> DotCode -> DotCode
printHtmlField' Text
"FACE" (DotCode -> DotCode) -> DotCode -> DotCode
forall a b. (a -> b) -> a -> b
$ Text -> DotCode
escapeAttribute Text
v
unqtDot (FixedSize Bool
v) = Text -> DotCode -> DotCode
printHtmlField' Text
"FIXEDSIZE" (DotCode -> DotCode) -> DotCode -> DotCode
forall a b. (a -> b) -> a -> b
$ Bool -> DotCode
printBoolHtml Bool
v
unqtDot (GradientAngle Int
v) = Text -> Int -> DotCode
forall a. PrintDot a => Text -> a -> DotCode
printHtmlField Text
"GRADIENTANGLE" Int
v
unqtDot (Height Word16
v) = Text -> Word16 -> DotCode
forall a. PrintDot a => Text -> a -> DotCode
printHtmlField Text
"HEIGHT" Word16
v
unqtDot (HRef Text
v) = Text -> DotCode -> DotCode
printHtmlField' Text
"HREF" (DotCode -> DotCode) -> DotCode -> DotCode
forall a b. (a -> b) -> a -> b
$ Text -> DotCode
escapeAttribute Text
v
unqtDot (ID Text
v) = Text -> DotCode -> DotCode
printHtmlField' Text
"ID" (DotCode -> DotCode) -> DotCode -> DotCode
forall a b. (a -> b) -> a -> b
$ Text -> DotCode
escapeAttribute Text
v
unqtDot (PointSize Double
v) = Text -> Double -> DotCode
forall a. PrintDot a => Text -> a -> DotCode
printHtmlField Text
"POINT-SIZE" Double
v
unqtDot (Port PortName
v) = Text -> DotCode -> DotCode
printHtmlField' Text
"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 CellFormat
v) = Text -> CellFormat -> DotCode
forall a. PrintDot a => Text -> a -> DotCode
printHtmlField Text
"ROWS" CellFormat
v
unqtDot (RowSpan Word16
v) = Text -> Word16 -> DotCode
forall a. PrintDot a => Text -> a -> DotCode
printHtmlField Text
"ROWSPAN" Word16
v
unqtDot (Scale Scale
v) = Text -> Scale -> DotCode
forall a. PrintDot a => Text -> a -> DotCode
printHtmlField Text
"SCALE" Scale
v
unqtDot (Sides [Side]
v) = Text -> [Side] -> DotCode
forall a. PrintDot a => Text -> a -> DotCode
printHtmlField Text
"SIDES" [Side]
v
unqtDot (Src String
v) = Text -> DotCode -> DotCode
printHtmlField' Text
"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 Style
v) = Text -> Style -> DotCode
forall a. PrintDot a => Text -> a -> DotCode
printHtmlField Text
"STYLE" Style
v
unqtDot (Target Text
v) = Text -> DotCode -> DotCode
printHtmlField' Text
"TARGET" (DotCode -> DotCode) -> DotCode -> DotCode
forall a b. (a -> b) -> a -> b
$ Text -> DotCode
escapeAttribute Text
v
unqtDot (Title Text
v) = Text -> DotCode -> DotCode
printHtmlField' Text
"TITLE" (DotCode -> DotCode) -> DotCode -> DotCode
forall a b. (a -> b) -> a -> b
$ Text -> DotCode
escapeAttribute Text
v
unqtDot (VAlign VAlign
v) = Text -> VAlign -> DotCode
forall a. PrintDot a => Text -> a -> DotCode
printHtmlField Text
"VALIGN" VAlign
v
unqtDot (Width Word16
v) = Text -> Word16 -> DotCode
forall a. PrintDot a => Text -> a -> DotCode
printHtmlField Text
"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
printHtmlField :: (PrintDot a) => T.Text -> a -> DotCode
printHtmlField :: forall a. PrintDot a => Text -> a -> DotCode
printHtmlField 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' Text
f 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 String
"ALIGN"
, (Align -> Attribute) -> String -> Parse Attribute
forall a.
ParseDot a =>
(a -> Attribute) -> String -> Parse Attribute
parseHtmlField Align -> Attribute
BAlign String
"BALIGN"
, (Color -> Attribute) -> String -> Parse Attribute
forall a.
ParseDot a =>
(a -> Attribute) -> String -> Parse Attribute
parseHtmlField Color -> Attribute
BGColor String
"BGCOLOR"
, (Word8 -> Attribute) -> String -> Parse Attribute
forall a.
ParseDot a =>
(a -> Attribute) -> String -> Parse Attribute
parseHtmlField Word8 -> Attribute
Border String
"BORDER"
, (Word8 -> Attribute) -> String -> Parse Attribute
forall a.
ParseDot a =>
(a -> Attribute) -> String -> Parse Attribute
parseHtmlField Word8 -> Attribute
CellBorder String
"CELLBORDER"
, (Word8 -> Attribute) -> String -> Parse Attribute
forall a.
ParseDot a =>
(a -> Attribute) -> String -> Parse Attribute
parseHtmlField Word8 -> Attribute
CellPadding String
"CELLPADDING"
, (Word8 -> Attribute) -> String -> Parse Attribute
forall a.
ParseDot a =>
(a -> Attribute) -> String -> Parse Attribute
parseHtmlField Word8 -> Attribute
CellSpacing String
"CELLSPACING"
, (Color -> Attribute) -> String -> Parse Attribute
forall a.
ParseDot a =>
(a -> Attribute) -> String -> Parse Attribute
parseHtmlField Color -> Attribute
Color String
"COLOR"
, (Word16 -> Attribute) -> String -> Parse Attribute
forall a.
ParseDot a =>
(a -> Attribute) -> String -> Parse Attribute
parseHtmlField Word16 -> Attribute
ColSpan String
"COLSPAN"
, (CellFormat -> Attribute) -> String -> Parse Attribute
forall a.
ParseDot a =>
(a -> Attribute) -> String -> Parse Attribute
parseHtmlField CellFormat -> Attribute
Columns String
"COLUMNS"
, (Text -> Attribute)
-> String -> Parser GraphvizState Text -> Parse Attribute
forall a. (a -> Attribute) -> String -> Parse a -> Parse Attribute
parseHtmlField' Text -> Attribute
Face String
"FACE" Parser GraphvizState Text
unescapeAttribute
, (Bool -> Attribute) -> String -> Parse Bool -> Parse Attribute
forall a. (a -> Attribute) -> String -> Parse a -> Parse Attribute
parseHtmlField' Bool -> Attribute
FixedSize String
"FIXEDSIZE" Parse Bool
parseBoolHtml
, (Int -> Attribute) -> String -> Parse Attribute
forall a.
ParseDot a =>
(a -> Attribute) -> String -> Parse Attribute
parseHtmlField Int -> Attribute
GradientAngle String
"GRADIENTANGLE"
, (Word16 -> Attribute) -> String -> Parse Attribute
forall a.
ParseDot a =>
(a -> Attribute) -> String -> Parse Attribute
parseHtmlField Word16 -> Attribute
Height String
"HEIGHT"
, (Text -> Attribute)
-> String -> Parser GraphvizState Text -> Parse Attribute
forall a. (a -> Attribute) -> String -> Parse a -> Parse Attribute
parseHtmlField' Text -> Attribute
HRef String
"HREF" Parser GraphvizState Text
unescapeAttribute
, (Text -> Attribute)
-> String -> Parser GraphvizState Text -> Parse Attribute
forall a. (a -> Attribute) -> String -> Parse a -> Parse Attribute
parseHtmlField' Text -> Attribute
ID String
"ID" Parser GraphvizState Text
unescapeAttribute
, (Double -> Attribute) -> String -> Parse Attribute
forall a.
ParseDot a =>
(a -> Attribute) -> String -> Parse Attribute
parseHtmlField Double -> Attribute
PointSize String
"POINT-SIZE"
, (Text -> Attribute)
-> String -> Parser GraphvizState Text -> Parse Attribute
forall a. (a -> Attribute) -> String -> Parse a -> Parse Attribute
parseHtmlField' (PortName -> Attribute
Port (PortName -> Attribute) -> (Text -> PortName) -> Text -> Attribute
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> PortName
PN) String
"PORT" Parser GraphvizState Text
unescapeAttribute
, (CellFormat -> Attribute) -> String -> Parse Attribute
forall a.
ParseDot a =>
(a -> Attribute) -> String -> Parse Attribute
parseHtmlField CellFormat -> Attribute
Rows String
"ROWS"
, (Word16 -> Attribute) -> String -> Parse Attribute
forall a.
ParseDot a =>
(a -> Attribute) -> String -> Parse Attribute
parseHtmlField Word16 -> Attribute
RowSpan String
"ROWSPAN"
, (Scale -> Attribute) -> String -> Parse Attribute
forall a.
ParseDot a =>
(a -> Attribute) -> String -> Parse Attribute
parseHtmlField Scale -> Attribute
Scale String
"SCALE"
, ([Side] -> Attribute) -> String -> Parse Attribute
forall a.
ParseDot a =>
(a -> Attribute) -> String -> Parse Attribute
parseHtmlField [Side] -> Attribute
Sides String
"SIDES"
, (String -> Attribute) -> String -> Parse String -> Parse Attribute
forall a. (a -> Attribute) -> String -> Parse a -> Parse Attribute
parseHtmlField' String -> Attribute
Src String
"SRC" (Parse String -> Parse Attribute)
-> Parse String -> Parse Attribute
forall a b. (a -> b) -> a -> b
$ (Text -> String) -> Parser GraphvizState Text -> Parse String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> String
T.unpack Parser GraphvizState Text
unescapeAttribute
, (Style -> Attribute) -> String -> Parse Attribute
forall a.
ParseDot a =>
(a -> Attribute) -> String -> Parse Attribute
parseHtmlField Style -> Attribute
Style String
"STYLE"
, (Text -> Attribute)
-> String -> Parser GraphvizState Text -> Parse Attribute
forall a. (a -> Attribute) -> String -> Parse a -> Parse Attribute
parseHtmlField' Text -> Attribute
Target String
"TARGET" Parser GraphvizState Text
unescapeAttribute
, (Text -> Attribute)
-> String -> Parser GraphvizState Text -> Parse Attribute
forall a. (a -> Attribute) -> String -> Parse a -> Parse Attribute
parseHtmlField' Text -> Attribute
Title String
"TITLE" Parser GraphvizState Text
unescapeAttribute
Parse Attribute -> Parse Attribute -> Parse Attribute
forall s a. Parser s a -> Parser s a -> Parser s a
`onFail`
(Text -> Attribute)
-> String -> Parser GraphvizState Text -> Parse Attribute
forall a. (a -> Attribute) -> String -> Parse a -> Parse Attribute
parseHtmlField' Text -> Attribute
Title String
"TOOLTIP" Parser GraphvizState Text
unescapeAttribute
, (VAlign -> Attribute) -> String -> Parse Attribute
forall a.
ParseDot a =>
(a -> Attribute) -> String -> Parse Attribute
parseHtmlField VAlign -> Attribute
VAlign String
"VALIGN"
, (Word16 -> Attribute) -> String -> Parse Attribute
forall a.
ParseDot a =>
(a -> Attribute) -> String -> Parse Attribute
parseHtmlField Word16 -> Attribute
Width String
"WIDTH"
]
parse :: Parse Attribute
parse = Parse Attribute
forall a. ParseDot a => Parse a
parseUnqt
parseUnqtList :: Parse Attributes
parseUnqtList = Parse Attribute -> Parser GraphvizState () -> Parse Attributes
forall (p :: * -> *) a sep. PolyParse p => p a -> p sep -> p [a]
sepBy Parse Attribute
forall a. ParseDot a => Parse a
parseUnqt Parser GraphvizState ()
whitespace1
parseList :: Parse Attributes
parseList = Parse Attributes
forall a. ParseDot a => Parse [a]
parseUnqtList
parseHtmlField :: (ParseDot a) => (a -> Attribute) -> String
-> Parse Attribute
parseHtmlField :: forall a.
ParseDot a =>
(a -> Attribute) -> String -> Parse Attribute
parseHtmlField a -> Attribute
c String
f = (a -> Attribute) -> String -> Parse a -> Parse Attribute
forall a. (a -> Attribute) -> String -> Parse a -> Parse Attribute
parseHtmlField' a -> Attribute
c String
f Parse a
forall a. ParseDot a => Parse a
parseUnqt
parseHtmlField' :: (a -> Attribute) -> String -> Parse a
-> Parse Attribute
parseHtmlField' :: forall a. (a -> Attribute) -> String -> Parse a -> Parse Attribute
parseHtmlField' a -> Attribute
c String
f Parse a
p = String -> Parser GraphvizState ()
string String
f
Parser GraphvizState ()
-> Parser GraphvizState () -> Parser GraphvizState ()
forall (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`
((String
"Can't parse HTML.Attribute." String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
f String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n\t")String -> ShowS
forall a. [a] -> [a] -> [a]
++)
)
)
data Align = HLeft
| HCenter
| HRight
| HText
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
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 Align
HLeft = Text -> DotCode
forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"LEFT"
unqtDot Align
HCenter = Text -> DotCode
forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"CENTER"
unqtDot Align
HRight = Text -> DotCode
forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"RIGHT"
unqtDot Align
HText = Text -> DotCode
forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"TEXT"
instance ParseDot Align where
parseUnqt :: Parse Align
parseUnqt = [Parse Align] -> Parse Align
forall (p :: * -> *) a. PolyParse p => [p a] -> p a
oneOf [ Align -> String -> Parse Align
forall a. a -> String -> Parse a
stringRep Align
HLeft String
"LEFT"
, Align -> String -> Parse Align
forall a. a -> String -> Parse a
stringRep Align
HCenter String
"CENTER"
, Align -> String -> Parse Align
forall a. a -> String -> Parse a
stringRep Align
HRight String
"RIGHT"
, Align -> String -> Parse Align
forall a. a -> String -> Parse a
stringRep Align
HText String
"TEXT"
]
parse :: Parse Align
parse = Parse Align
forall a. ParseDot a => Parse a
parseUnqt
data VAlign = HTop
| HMiddle
| 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
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 VAlign
HTop = Text -> DotCode
forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"TOP"
unqtDot VAlign
HMiddle = Text -> DotCode
forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"MIDDLE"
unqtDot VAlign
HBottom = Text -> DotCode
forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"BOTTOM"
instance ParseDot VAlign where
parseUnqt :: Parse VAlign
parseUnqt = [Parse VAlign] -> Parse VAlign
forall (p :: * -> *) a. PolyParse p => [p a] -> p a
oneOf [ VAlign -> String -> Parse VAlign
forall a. a -> String -> Parse a
stringRep VAlign
HTop String
"TOP"
, VAlign -> String -> Parse VAlign
forall a. a -> String -> Parse a
stringRep VAlign
HMiddle String
"MIDDLE"
, VAlign -> String -> Parse VAlign
forall a. a -> String -> Parse a
stringRep VAlign
HBottom String
"BOTTOM"
]
parse :: Parse VAlign
parse = Parse VAlign
forall a. ParseDot a => Parse a
parseUnqt
data CellFormat = RuleBetween
deriving (CellFormat -> CellFormat -> Bool
(CellFormat -> CellFormat -> Bool)
-> (CellFormat -> CellFormat -> Bool) -> Eq CellFormat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: 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
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 CellFormat
RuleBetween = Text -> DotCode
forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"*"
instance ParseDot CellFormat where
parseUnqt :: Parse CellFormat
parseUnqt = CellFormat -> String -> Parse CellFormat
forall a. a -> String -> Parse a
stringRep CellFormat
RuleBetween String
"*"
parse :: Parse CellFormat
parse = Parse CellFormat
forall a. ParseDot a => Parse a
parseUnqt
data Scale = NaturalSize
| 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
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 Scale
NaturalSize = Text -> DotCode
forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"FALSE"
unqtDot Scale
ScaleUniformly = Text -> DotCode
forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"TRUE"
unqtDot Scale
ExpandWidth = Text -> DotCode
forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"WIDTH"
unqtDot Scale
ExpandHeight = Text -> DotCode
forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"HEIGHT"
unqtDot Scale
ExpandBoth = Text -> DotCode
forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"BOTH"
instance ParseDot Scale where
parseUnqt :: Parse Scale
parseUnqt = [Parse Scale] -> Parse Scale
forall (p :: * -> *) a. PolyParse p => [p a] -> p a
oneOf [ Scale -> String -> Parse Scale
forall a. a -> String -> Parse a
stringRep Scale
NaturalSize String
"FALSE"
, Scale -> String -> Parse Scale
forall a. a -> String -> Parse a
stringRep Scale
ScaleUniformly String
"TRUE"
, Scale -> String -> Parse Scale
forall a. a -> String -> Parse a
stringRep Scale
ExpandWidth String
"WIDTH"
, Scale -> String -> Parse Scale
forall a. a -> String -> Parse a
stringRep Scale
ExpandHeight String
"HEIGHT"
, Scale -> String -> Parse Scale
forall a. a -> String -> Parse a
stringRep Scale
ExpandBoth String
"BOTH"
]
parse :: Parse Scale
parse = Parse Scale
forall a. ParseDot a => Parse a
parseUnqt
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
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 Side
LeftSide = Text -> DotCode
forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"L"
unqtDot Side
RightSide = Text -> DotCode
forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"R"
unqtDot Side
TopSide = Text -> DotCode
forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"T"
unqtDot Side
BottomSide = Text -> DotCode
forall (m :: * -> *). Applicative m => Text -> m Doc
text 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 String
"L"
, Side -> String -> Parse Side
forall a. a -> String -> Parse a
stringRep Side
RightSide String
"R"
, Side -> String -> Parse Side
forall a. a -> String -> Parse a
stringRep Side
TopSide String
"T"
, Side -> String -> Parse Side
forall a. a -> String -> Parse a
stringRep Side
BottomSide String
"B"
]
parse :: Parse Side
parse = Parse Side
forall a. ParseDot a => Parse a
parseUnqt
parseUnqtList :: Parse [Side]
parseUnqtList = Parse Side -> Parse [Side]
forall (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
| Radial
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
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 Style
Rounded = Text -> DotCode
forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"ROUNDED"
unqtDot Style
Radial = Text -> DotCode
forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"RADIAL"
instance ParseDot Style where
parseUnqt :: Parse Style
parseUnqt = [Parse Style] -> Parse Style
forall (p :: * -> *) a. PolyParse p => [p a] -> p a
oneOf [ Style -> String -> Parse Style
forall a. a -> String -> Parse a
stringRep Style
Rounded String
"ROUNDED"
, Style -> String -> Parse Style
forall a. a -> String -> Parse a
stringRep Style
Radial String
"RADIAL"
]
parse :: Parse Style
parse = Parse Style
forall a. ParseDot a => Parse a
parseUnqt
escapeAttribute :: T.Text -> DotCode
escapeAttribute :: Text -> 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 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
escapeSegment :: String -> DotCodeM [Doc]
escapeSegment (Char
s: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 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 Char
'"'
else Map Char a -> Map Char a
forall a. a -> a
id
escs :: Map Char Text
escs = Map Char Text -> Map Char Text
forall {a}. Map Char a -> Map Char a
allowQuotes (Map Char Text -> Map Char Text) -> Map Char Text -> Map Char Text
forall a b. (a -> b) -> a -> b
$ [(Char, Text)] -> Map Char Text
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Char, Text)]
htmlEscapes
xmlChar :: Char -> DotCode
xmlChar 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 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' m Doc
e = Char -> m Doc
forall (m :: * -> *). Applicative m => Char -> m Doc
char Char
'&' m Doc -> m Doc -> m Doc
forall a. Semigroup a => a -> a -> a
<> m Doc
e m Doc -> m Doc -> m Doc
forall a. Semigroup a => a -> a -> a
<> Char -> m Doc
forall (m :: * -> *). Applicative m => Char -> m Doc
char Char
';'
escape :: Text -> 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
unescapeHtml :: Bool -> Parse T.Text
unescapeHtml :: Bool -> Parser GraphvizState Text
unescapeHtml 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 Char
'&'
Text
esc <- (Char -> Bool) -> Parser GraphvizState Text
forall s. (Char -> Bool) -> Parser s Text
many1Satisfy (Char
';' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=)
Char -> Parse Char
character Char
';'
let c :: Maybe Char
c = case Text -> Maybe (Char, Text)
T.uncons (Text -> Maybe (Char, Text)) -> Text -> Maybe (Char, Text)
forall a b. (a -> b) -> a -> b
$ Text -> Text
T.toLower Text
esc of
Just (Char
'#',Text
dec) | Just (Char
'x',Text
hex) <- Text -> Maybe (Char, Text)
T.uncons Text
dec
-> (String -> [(Int, String)]) -> String -> Maybe Char
forall {t} {a}. (t -> [(Int, [a])]) -> t -> Maybe Char
readMaybe String -> [(Int, String)]
forall a. (Eq a, Num a) => ReadS a
readHex (String -> Maybe Char) -> String -> Maybe Char
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
hex
| Bool
otherwise
-> (String -> [(Int, String)]) -> String -> Maybe Char
forall {t} {a}. (t -> [(Int, [a])]) -> t -> Maybe Char
readMaybe String -> [(Int, String)]
readInt (String -> Maybe Char) -> String -> Maybe Char
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
dec
Maybe (Char, Text)
_ -> Text
esc Text -> Map Text Char -> Maybe Char
forall k a. Ord k => k -> Map k a -> Maybe a
`Map.lookup` Map Text Char
escMap
Maybe Char -> Parser GraphvizState (Maybe Char)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Char
c
readMaybe :: (t -> [(Int, [a])]) -> t -> Maybe Char
readMaybe t -> [(Int, [a])]
f t
str = do (Int
n, []) <- [(Int, [a])] -> Maybe (Int, [a])
forall a. [a] -> Maybe a
listToMaybe ([(Int, [a])] -> Maybe (Int, [a]))
-> [(Int, [a])] -> Maybe (Int, [a])
forall a b. (a -> b) -> a -> b
$ t -> [(Int, [a])]
f t
str
Char -> Maybe Char
forall (m :: * -> *) a. Monad m => a -> m a
return (Char -> Maybe Char) -> Char -> Maybe Char
forall a b. (a -> b) -> a -> b
$ Int -> Char
chr Int
n
readInt :: ReadS Int
readInt :: String -> [(Int, String)]
readInt = String -> [(Int, String)]
forall a. Read a => ReadS a
reads
allowQuotes :: ShowS
allowQuotes = if Bool
quotesAllowed
then Char -> ShowS
forall a. Eq a => a -> [a] -> [a]
delete Char
'"'
else ShowS
forall a. a -> a
id
escMap :: Map Text Char
escMap = [(Text, Char)] -> Map Text Char
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Text, Char)]
htmlUnescapes
validChars :: Parser s (Maybe Char)
validChars = (Char -> Maybe Char) -> Parser s Char -> Parser s (Maybe Char)
forall (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
htmlEscapes :: [(Char, T.Text)]
htmlEscapes :: [(Char, Text)]
htmlEscapes = [ (Char
'"', Text
"quot")
, (Char
'<', Text
"lt")
, (Char
'>', Text
"gt")
, (Char
'&', Text
"amp")
]
htmlUnescapes :: [(T.Text, Char)]
htmlUnescapes :: [(Text, Char)]
htmlUnescapes = [(Text, Char)]
maybeEscaped
[(Text, Char)] -> [(Text, Char)] -> [(Text, Char)]
forall a. [a] -> [a] -> [a]
++
((Char, Text) -> (Text, Char)) -> [(Char, Text)] -> [(Text, Char)]
forall a b. (a -> b) -> [a] -> [b]
map ((Char -> Text -> (Text, Char)) -> (Char, Text) -> (Text, Char)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((Char -> Text -> (Text, Char)) -> (Char, Text) -> (Text, Char))
-> (Char -> Text -> (Text, Char)) -> (Char, Text) -> (Text, Char)
forall a b. (a -> b) -> a -> b
$ (Text -> Char -> (Text, Char)) -> Char -> Text -> (Text, Char)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (,)) [(Char, Text)]
htmlEscapes
where
maybeEscaped :: [(Text, Char)]
maybeEscaped = [(Text
"nbsp", Char
' '), (Text
"apos", Char
'\'')]
printBoolHtml :: Bool -> DotCode
printBoolHtml :: Bool -> 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 Text
"FALSE" Text
"TRUE"
parseBoolHtml :: Parse Bool
parseBoolHtml :: Parse Bool
parseBoolHtml = Bool -> String -> Parse Bool
forall a. a -> String -> Parse a
stringRep Bool
True String
"TRUE"
Parse Bool -> Parse Bool -> Parse Bool
forall s a. Parser s a -> Parser s a -> Parser s a
`onFail`
Bool -> String -> Parse Bool
forall a. a -> String -> Parse a
stringRep Bool
False String
"FALSE"
printTag :: DotCode -> Attributes -> DotCode -> DotCode
printTag :: DotCode -> Attributes -> DotCode -> DotCode
printTag DotCode
t Attributes
as 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 Text
"FONT")
printEmptyTag :: DotCode -> Attributes -> DotCode
printEmptyTag :: DotCode -> Attributes -> DotCode
printEmptyTag DotCode
t 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
parseTag :: (Attributes -> val -> tag) -> String
-> Parse val -> Parse tag
parseTag :: forall val tag.
(Attributes -> val -> tag) -> String -> Parse val -> Parse tag
parseTag Attributes -> val -> tag
c String
t Parse val
pv = Attributes -> val -> tag
c (Attributes -> val -> tag)
-> Parse Attributes -> Parser GraphvizState (val -> tag)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parse Attributes -> Parse Attributes
forall a. Parse a -> Parse a
parseAngled Parse Attributes
openingTag
Parser GraphvizState (val -> tag)
-> Parse val -> Parser GraphvizState tag
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parse val -> Parse val
forall a. Parse a -> Parse a
wrapWhitespace Parse val
pv
Parser GraphvizState tag
-> Parser GraphvizState () -> Parser GraphvizState tag
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser GraphvizState () -> Parser GraphvizState ()
forall a. Parse a -> Parse a
parseAngled (Char -> Parse Char
character Char
'/' Parse Char -> Parser GraphvizState () -> Parser GraphvizState ()
forall (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`
((String
"Can't parse Html tag: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
t String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n\t")String -> ShowS
forall a. [a] -> [a] -> [a]
++)
where
t' :: Parser GraphvizState ()
t' = String -> Parser GraphvizState ()
string String
t
openingTag :: Parse Attributes
openingTag :: Parse Attributes
openingTag = Parser GraphvizState ()
t'
Parser GraphvizState () -> Parse Attributes -> Parse Attributes
forall (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 :: forall val tag.
(Attributes -> val -> tag) -> Parse val -> Parse tag
parseFontTag = ((Attributes -> val -> tag) -> String -> Parse val -> Parse tag
forall val tag.
(Attributes -> val -> tag) -> String -> Parse val -> Parse tag
`parseTag` String
"FONT")
parseTagRep :: (tagName -> val -> tag) -> Parse tagName -> Parse val -> Parse tag
parseTagRep :: forall tagName val tag.
(tagName -> val -> tag) -> Parse tagName -> Parse val -> Parse tag
parseTagRep tagName -> val -> tag
c Parse tagName
pt Parse val
pv = tagName -> val -> tag
c (tagName -> val -> tag)
-> Parse tagName -> Parser GraphvizState (val -> tag)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parse tagName -> Parse tagName
forall a. Parse a -> Parse a
parseAngled (Parse tagName
pt Parse tagName -> Parser GraphvizState () -> Parse tagName
forall (p :: * -> *) a b. PolyParse p => p a -> p b -> p a
`discard` Parser GraphvizState ()
whitespace)
Parser GraphvizState (val -> tag)
-> Parse val -> Parser GraphvizState tag
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parse val
pv
Parser GraphvizState tag
-> Parser GraphvizState () -> Parser GraphvizState 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 Char
'/' 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`
(String
"Can't parse attribute-less Html tag\n\t"String -> ShowS
forall a. [a] -> [a] -> [a]
++)
parseEmptyTag :: (Attributes -> tag) -> String -> Parse tag
parseEmptyTag :: forall tag. (Attributes -> tag) -> String -> Parse tag
parseEmptyTag Attributes -> tag
c String
t = Attributes -> tag
c (Attributes -> tag) -> Parse Attributes -> Parser GraphvizState tag
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parse Attributes -> Parse Attributes
forall a. Parse a -> Parse a
parseAngled
( String -> Parser GraphvizState ()
string String
t
Parser GraphvizState () -> Parse Attributes -> Parse Attributes
forall (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 Char
'/'
)
Parse Attributes -> ShowS -> Parse Attributes
forall (p :: * -> *) a. Commitment p => p a -> ShowS -> p a
`adjustErr`
((String
"Can't parse empty Html tag: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
t String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n\t")String -> ShowS
forall a. [a] -> [a] -> [a]
++)