{-# 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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Label -> Label -> Bool
$c/= :: Label -> Label -> Bool
== :: Label -> Label -> Bool
$c== :: Label -> Label -> Bool
Eq, Eq Label
Label -> Label -> Bool
Label -> Label -> Ordering
Label -> Label -> Label
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Label -> Label -> Label
$cmin :: Label -> Label -> Label
max :: Label -> Label -> Label
$cmax :: Label -> Label -> Label
>= :: Label -> Label -> Bool
$c>= :: Label -> Label -> Bool
> :: Label -> Label -> Bool
$c> :: Label -> Label -> Bool
<= :: Label -> Label -> Bool
$c<= :: Label -> Label -> Bool
< :: Label -> Label -> Bool
$c< :: Label -> Label -> Bool
compare :: Label -> Label -> Ordering
$ccompare :: Label -> Label -> Ordering
Ord, Int -> Label -> ShowS
[Label] -> ShowS
Label -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Label] -> ShowS
$cshowList :: [Label] -> ShowS
show :: Label -> String
$cshow :: Label -> String
showsPrec :: Int -> Label -> ShowS
$cshowsPrec :: Int -> Label -> ShowS
Show, ReadPrec [Label]
ReadPrec Label
Int -> ReadS Label
ReadS [Label]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Label]
$creadListPrec :: ReadPrec [Label]
readPrec :: ReadPrec Label
$creadPrec :: ReadPrec Label
readList :: ReadS [Label]
$creadList :: ReadS [Label]
readsPrec :: Int -> ReadS Label
$creadsPrec :: Int -> ReadS Label
Read)
instance PrintDot Label where
unqtDot :: Label -> DotCodeM Doc
unqtDot (Text Text
txt) = forall a. PrintDot a => a -> DotCodeM Doc
unqtDot Text
txt
unqtDot (Table Table
tbl) = forall a. PrintDot a => a -> DotCodeM Doc
unqtDot Table
tbl
instance ParseDot Label where
parseUnqt :: Parse Label
parseUnqt = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Table -> Label
Table forall a. ParseDot a => Parse a
parseUnqt
forall s a. Parser s a -> Parser s a -> Parser s a
`onFail`
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Label
Text forall a. ParseDot a => Parse a
parseUnqt
forall (p :: * -> *) a. Commitment p => p a -> ShowS -> p a
`adjustErr`
(String
"Can't parse Html.Label\n\t"forall a. [a] -> [a] -> [a]
++)
parse :: Parse Label
parse = forall a. ParseDot a => Parse a
parseUnqt
type Text = [TextItem]
data TextItem = Str T.Text
| Newline Attributes
| Font Attributes Text
| Format Format Text
deriving (TextItem -> TextItem -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TextItem -> TextItem -> Bool
$c/= :: TextItem -> TextItem -> Bool
== :: TextItem -> TextItem -> Bool
$c== :: TextItem -> TextItem -> Bool
Eq, Eq TextItem
TextItem -> TextItem -> Bool
TextItem -> TextItem -> Ordering
TextItem -> TextItem -> TextItem
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: TextItem -> TextItem -> TextItem
$cmin :: TextItem -> TextItem -> TextItem
max :: TextItem -> TextItem -> TextItem
$cmax :: TextItem -> TextItem -> TextItem
>= :: TextItem -> TextItem -> Bool
$c>= :: TextItem -> TextItem -> Bool
> :: TextItem -> TextItem -> Bool
$c> :: TextItem -> TextItem -> Bool
<= :: TextItem -> TextItem -> Bool
$c<= :: TextItem -> TextItem -> Bool
< :: TextItem -> TextItem -> Bool
$c< :: TextItem -> TextItem -> Bool
compare :: TextItem -> TextItem -> Ordering
$ccompare :: TextItem -> TextItem -> Ordering
Ord, Int -> TextItem -> ShowS
Text -> ShowS
TextItem -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: Text -> ShowS
$cshowList :: Text -> ShowS
show :: TextItem -> String
$cshow :: TextItem -> String
showsPrec :: Int -> TextItem -> ShowS
$cshowsPrec :: Int -> TextItem -> ShowS
Show, ReadPrec Text
ReadPrec TextItem
Int -> ReadS TextItem
ReadS Text
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec Text
$creadListPrec :: ReadPrec Text
readPrec :: ReadPrec TextItem
$creadPrec :: ReadPrec TextItem
readList :: ReadS Text
$creadList :: ReadS Text
readsPrec :: Int -> ReadS TextItem
$creadsPrec :: Int -> ReadS TextItem
Read)
instance PrintDot TextItem where
unqtDot :: TextItem -> DotCodeM Doc
unqtDot (Str Text
str) = Text -> DotCodeM Doc
escapeValue Text
str
unqtDot (Newline Attributes
as) = DotCodeM Doc -> Attributes -> DotCodeM Doc
printEmptyTag (forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"BR") Attributes
as
unqtDot (Font Attributes
as Text
txt) = Attributes -> DotCodeM Doc -> DotCodeM Doc
printFontTag Attributes
as forall a b. (a -> b) -> a -> b
$ forall a. PrintDot a => a -> DotCodeM Doc
unqtDot Text
txt
unqtDot (Format Format
fmt Text
txt) = DotCodeM Doc -> Attributes -> DotCodeM Doc -> DotCodeM Doc
printTag (forall a. PrintDot a => a -> DotCodeM Doc
unqtDot Format
fmt) [] forall a b. (a -> b) -> a -> b
$ forall a. PrintDot a => a -> DotCodeM Doc
unqtDot Text
txt
unqtListToDot :: Text -> DotCodeM Doc
unqtListToDot = forall (m :: * -> *). Functor m => m [Doc] -> m Doc
hcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall a. PrintDot a => a -> DotCodeM Doc
unqtDot
listToDot :: Text -> DotCodeM Doc
listToDot = forall a. PrintDot a => [a] -> DotCodeM Doc
unqtListToDot
instance ParseDot TextItem where
parseUnqt :: Parse TextItem
parseUnqt = forall (p :: * -> *) a. PolyParse p => [p a] -> p a
oneOf [ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> TextItem
Str Parse Text
unescapeValue
, forall tag. (Attributes -> tag) -> String -> Parse tag
parseEmptyTag Attributes -> TextItem
Newline String
"BR"
, forall val tag.
(Attributes -> val -> tag) -> Parse val -> Parse tag
parseFontTag Attributes -> Text -> TextItem
Font forall a. ParseDot a => Parse a
parseUnqt
, forall tagName val tag.
(tagName -> val -> tag) -> Parse tagName -> Parse val -> Parse tag
parseTagRep Format -> Text -> TextItem
Format forall a. ParseDot a => Parse a
parseUnqt forall a. ParseDot a => Parse a
parseUnqt
]
forall (p :: * -> *) a. Commitment p => p a -> ShowS -> p a
`adjustErr`
(String
"Can't parse Html.TextItem\n\t"forall a. [a] -> [a] -> [a]
++)
parse :: Parse TextItem
parse = forall a. ParseDot a => Parse a
parseUnqt
parseUnqtList :: Parse Text
parseUnqtList = forall (f :: * -> *) a. Alternative f => f a -> f [a]
many forall a. ParseDot a => Parse a
parseUnqt
parseList :: Parse Text
parseList = forall a. ParseDot a => Parse [a]
parseUnqtList
data Format = Italics
| Bold
| Underline
| Overline
| Subscript
| Superscript
deriving (Format -> Format -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Format -> Format -> Bool
$c/= :: Format -> Format -> Bool
== :: Format -> Format -> Bool
$c== :: Format -> Format -> Bool
Eq, Eq Format
Format -> Format -> Bool
Format -> Format -> Ordering
Format -> Format -> Format
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Format -> Format -> Format
$cmin :: Format -> Format -> Format
max :: Format -> Format -> Format
$cmax :: Format -> Format -> Format
>= :: Format -> Format -> Bool
$c>= :: Format -> Format -> Bool
> :: Format -> Format -> Bool
$c> :: Format -> Format -> Bool
<= :: Format -> Format -> Bool
$c<= :: Format -> Format -> Bool
< :: Format -> Format -> Bool
$c< :: Format -> Format -> Bool
compare :: Format -> Format -> Ordering
$ccompare :: Format -> Format -> Ordering
Ord, Format
forall a. a -> a -> Bounded a
maxBound :: Format
$cmaxBound :: Format
minBound :: Format
$cminBound :: Format
Bounded, Int -> Format
Format -> Int
Format -> [Format]
Format -> Format
Format -> Format -> [Format]
Format -> Format -> Format -> [Format]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Format -> Format -> Format -> [Format]
$cenumFromThenTo :: Format -> Format -> Format -> [Format]
enumFromTo :: Format -> Format -> [Format]
$cenumFromTo :: Format -> Format -> [Format]
enumFromThen :: Format -> Format -> [Format]
$cenumFromThen :: Format -> Format -> [Format]
enumFrom :: Format -> [Format]
$cenumFrom :: Format -> [Format]
fromEnum :: Format -> Int
$cfromEnum :: Format -> Int
toEnum :: Int -> Format
$ctoEnum :: Int -> Format
pred :: Format -> Format
$cpred :: Format -> Format
succ :: Format -> Format
$csucc :: Format -> Format
Enum, Int -> Format -> ShowS
[Format] -> ShowS
Format -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Format] -> ShowS
$cshowList :: [Format] -> ShowS
show :: Format -> String
$cshow :: Format -> String
showsPrec :: Int -> Format -> ShowS
$cshowsPrec :: Int -> Format -> ShowS
Show, ReadPrec [Format]
ReadPrec Format
Int -> ReadS Format
ReadS [Format]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Format]
$creadListPrec :: ReadPrec [Format]
readPrec :: ReadPrec Format
$creadPrec :: ReadPrec Format
readList :: ReadS [Format]
$creadList :: ReadS [Format]
readsPrec :: Int -> ReadS Format
$creadsPrec :: Int -> ReadS Format
Read)
instance PrintDot Format where
unqtDot :: Format -> DotCodeM Doc
unqtDot Format
Italics = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"I"
unqtDot Format
Bold = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"B"
unqtDot Format
Underline = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"U"
unqtDot Format
Overline = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"O"
unqtDot Format
Subscript = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"SUB"
unqtDot Format
Superscript = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"SUP"
instance ParseDot Format where
parseUnqt :: Parse Format
parseUnqt = forall a. [(String, a)] -> Parse a
stringValue [ (String
"I", Format
Italics)
, (String
"B", Format
Bold)
, (String
"U", Format
Underline)
, (String
"O", Format
Overline)
, (String
"SUB", Format
Subscript)
, (String
"SUP", Format
Superscript)
]
data Table = HTable {
Table -> Maybe Attributes
tableFontAttrs :: Maybe Attributes
, Table -> Attributes
tableAttrs :: Attributes
, Table -> [Row]
tableRows :: [Row]
}
deriving (Table -> Table -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Table -> Table -> Bool
$c/= :: Table -> Table -> Bool
== :: Table -> Table -> Bool
$c== :: Table -> Table -> Bool
Eq, Eq Table
Table -> Table -> Bool
Table -> Table -> Ordering
Table -> Table -> Table
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Table -> Table -> Table
$cmin :: Table -> Table -> Table
max :: Table -> Table -> Table
$cmax :: Table -> Table -> Table
>= :: Table -> Table -> Bool
$c>= :: Table -> Table -> Bool
> :: Table -> Table -> Bool
$c> :: Table -> Table -> Bool
<= :: Table -> Table -> Bool
$c<= :: Table -> Table -> Bool
< :: Table -> Table -> Bool
$c< :: Table -> Table -> Bool
compare :: Table -> Table -> Ordering
$ccompare :: Table -> Table -> Ordering
Ord, Int -> Table -> ShowS
[Table] -> ShowS
Table -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Table] -> ShowS
$cshowList :: [Table] -> ShowS
show :: Table -> String
$cshow :: Table -> String
showsPrec :: Int -> Table -> ShowS
$cshowsPrec :: Int -> Table -> ShowS
Show, ReadPrec [Table]
ReadPrec Table
Int -> ReadS Table
ReadS [Table]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Table]
$creadListPrec :: ReadPrec [Table]
readPrec :: ReadPrec Table
$creadPrec :: ReadPrec Table
readList :: ReadS [Table]
$creadList :: ReadS [Table]
readsPrec :: Int -> ReadS Table
$creadsPrec :: Int -> ReadS Table
Read)
instance PrintDot Table where
unqtDot :: Table -> DotCodeM Doc
unqtDot Table
tbl = case Table -> Maybe Attributes
tableFontAttrs Table
tbl of
(Just Attributes
as) -> Attributes -> DotCodeM Doc -> DotCodeM Doc
printFontTag Attributes
as DotCodeM Doc
tbl'
Maybe Attributes
Nothing -> DotCodeM Doc
tbl'
where
tbl' :: DotCodeM Doc
tbl' = DotCodeM Doc -> Attributes -> DotCodeM Doc -> DotCodeM Doc
printTag (forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"TABLE")
(Table -> Attributes
tableAttrs Table
tbl)
(forall a. PrintDot a => a -> DotCodeM Doc
toDot forall a b. (a -> b) -> a -> b
$ Table -> [Row]
tableRows Table
tbl)
instance ParseDot Table where
parseUnqt :: Parse Table
parseUnqt = forall a. Parse a -> Parse a
wrapWhitespace (forall val tag.
(Attributes -> val -> tag) -> Parse val -> Parse tag
parseFontTag Attributes -> Table -> Table
addFontAttrs Parse Table
pTbl)
forall s a. Parser s a -> Parser s a -> Parser s a
`onFail`
Parse Table
pTbl
forall (p :: * -> *) a. Commitment p => p a -> ShowS -> p a
`adjustErr`
(String
"Can't parse Html.Table\n\t"forall a. [a] -> [a] -> [a]
++)
where
pTbl :: Parse Table
pTbl = forall a. Parse a -> Parse a
wrapWhitespace forall a b. (a -> b) -> a -> b
$ forall val tag.
(Attributes -> val -> tag) -> String -> Parse val -> Parse tag
parseTag (Maybe Attributes -> Attributes -> [Row] -> Table
HTable forall a. Maybe a
Nothing)
String
"TABLE"
(forall a. Parse a -> Parse a
wrapWhitespace forall a. ParseDot a => Parse a
parseUnqt)
addFontAttrs :: Attributes -> Table -> Table
addFontAttrs Attributes
fas Table
tbl = Table
tbl { tableFontAttrs :: Maybe Attributes
tableFontAttrs = forall a. a -> Maybe a
Just Attributes
fas }
parse :: Parse Table
parse = forall a. ParseDot a => Parse a
parseUnqt
data Row = Cells [Cell]
| HorizontalRule
deriving (Row -> Row -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Row -> Row -> Bool
$c/= :: Row -> Row -> Bool
== :: Row -> Row -> Bool
$c== :: Row -> Row -> Bool
Eq, Eq Row
Row -> Row -> Bool
Row -> Row -> Ordering
Row -> Row -> Row
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Row -> Row -> Row
$cmin :: Row -> Row -> Row
max :: Row -> Row -> Row
$cmax :: Row -> Row -> Row
>= :: Row -> Row -> Bool
$c>= :: Row -> Row -> Bool
> :: Row -> Row -> Bool
$c> :: Row -> Row -> Bool
<= :: Row -> Row -> Bool
$c<= :: Row -> Row -> Bool
< :: Row -> Row -> Bool
$c< :: Row -> Row -> Bool
compare :: Row -> Row -> Ordering
$ccompare :: Row -> Row -> Ordering
Ord, Int -> Row -> ShowS
[Row] -> ShowS
Row -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Row] -> ShowS
$cshowList :: [Row] -> ShowS
show :: Row -> String
$cshow :: Row -> String
showsPrec :: Int -> Row -> ShowS
$cshowsPrec :: Int -> Row -> ShowS
Show, ReadPrec [Row]
ReadPrec Row
Int -> ReadS Row
ReadS [Row]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Row]
$creadListPrec :: ReadPrec [Row]
readPrec :: ReadPrec Row
$creadPrec :: ReadPrec Row
readList :: ReadS [Row]
$creadList :: ReadS [Row]
readsPrec :: Int -> ReadS Row
$creadsPrec :: Int -> ReadS Row
Read)
instance PrintDot Row where
unqtDot :: Row -> DotCodeM Doc
unqtDot (Cells [Cell]
cs) = DotCodeM Doc -> Attributes -> DotCodeM Doc -> DotCodeM Doc
printTag (forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"TR") [] forall a b. (a -> b) -> a -> b
$ forall a. PrintDot a => a -> DotCodeM Doc
unqtDot [Cell]
cs
unqtDot Row
HorizontalRule = DotCodeM Doc -> Attributes -> DotCodeM Doc
printEmptyTag (forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"HR") []
unqtListToDot :: [Row] -> DotCodeM Doc
unqtListToDot = forall (m :: * -> *). Functor m => m Doc -> m Doc
align forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). Functor m => m [Doc] -> m Doc
cat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall a. PrintDot a => a -> DotCodeM Doc
unqtDot
listToDot :: [Row] -> DotCodeM Doc
listToDot = forall a. PrintDot a => [a] -> DotCodeM Doc
unqtListToDot
instance ParseDot Row where
parseUnqt :: Parse Row
parseUnqt = forall a. Parse a -> Parse a
wrapWhitespace forall a b. (a -> b) -> a -> b
$ forall val tag.
(Attributes -> val -> tag) -> String -> Parse val -> Parse tag
parseTag (forall a b. a -> b -> a
const [Cell] -> Row
Cells) String
"TR" forall a. ParseDot a => Parse a
parseUnqt
forall s a. Parser s a -> Parser s a -> Parser s a
`onFail`
forall tag. (Attributes -> tag) -> String -> Parse tag
parseEmptyTag (forall a b. a -> b -> a
const Row
HorizontalRule) String
"HR"
forall (p :: * -> *) a. Commitment p => p a -> ShowS -> p a
`adjustErr`
(String
"Can't parse Html.Row\n\t"forall a. [a] -> [a] -> [a]
++)
parse :: Parse Row
parse = forall a. ParseDot a => Parse a
parseUnqt
parseUnqtList :: Parse [Row]
parseUnqtList = forall a. Parse a -> Parse a
wrapWhitespace forall a b. (a -> b) -> a -> b
$ forall (p :: * -> *) a sep. PolyParse p => p a -> p sep -> p [a]
sepBy1 forall a. ParseDot a => Parse a
parseUnqt Parse ()
whitespace
parseList :: Parse [Row]
parseList = forall a. ParseDot a => Parse [a]
parseUnqtList
data Cell = LabelCell Attributes Label
| ImgCell Attributes Img
| VerticalRule
deriving (Cell -> Cell -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Cell -> Cell -> Bool
$c/= :: Cell -> Cell -> Bool
== :: Cell -> Cell -> Bool
$c== :: Cell -> Cell -> Bool
Eq, Eq Cell
Cell -> Cell -> Bool
Cell -> Cell -> Ordering
Cell -> Cell -> Cell
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Cell -> Cell -> Cell
$cmin :: Cell -> Cell -> Cell
max :: Cell -> Cell -> Cell
$cmax :: Cell -> Cell -> Cell
>= :: Cell -> Cell -> Bool
$c>= :: Cell -> Cell -> Bool
> :: Cell -> Cell -> Bool
$c> :: Cell -> Cell -> Bool
<= :: Cell -> Cell -> Bool
$c<= :: Cell -> Cell -> Bool
< :: Cell -> Cell -> Bool
$c< :: Cell -> Cell -> Bool
compare :: Cell -> Cell -> Ordering
$ccompare :: Cell -> Cell -> Ordering
Ord, Int -> Cell -> ShowS
[Cell] -> ShowS
Cell -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Cell] -> ShowS
$cshowList :: [Cell] -> ShowS
show :: Cell -> String
$cshow :: Cell -> String
showsPrec :: Int -> Cell -> ShowS
$cshowsPrec :: Int -> Cell -> ShowS
Show, ReadPrec [Cell]
ReadPrec Cell
Int -> ReadS Cell
ReadS [Cell]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Cell]
$creadListPrec :: ReadPrec [Cell]
readPrec :: ReadPrec Cell
$creadPrec :: ReadPrec Cell
readList :: ReadS [Cell]
$creadList :: ReadS [Cell]
readsPrec :: Int -> ReadS Cell
$creadsPrec :: Int -> ReadS Cell
Read)
instance PrintDot Cell where
unqtDot :: Cell -> DotCodeM Doc
unqtDot (LabelCell Attributes
as Label
l) = Attributes -> DotCodeM Doc -> DotCodeM Doc
printCell Attributes
as forall a b. (a -> b) -> a -> b
$ forall a. PrintDot a => a -> DotCodeM Doc
unqtDot Label
l
unqtDot (ImgCell Attributes
as Img
img) = Attributes -> DotCodeM Doc -> DotCodeM Doc
printCell Attributes
as forall a b. (a -> b) -> a -> b
$ forall a. PrintDot a => a -> DotCodeM Doc
unqtDot Img
img
unqtDot Cell
VerticalRule = DotCodeM Doc -> Attributes -> DotCodeM Doc
printEmptyTag (forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"VR") []
unqtListToDot :: [Cell] -> DotCodeM Doc
unqtListToDot = forall (m :: * -> *). Functor m => m [Doc] -> m Doc
hsep forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall a. PrintDot a => a -> DotCodeM Doc
unqtDot
listToDot :: [Cell] -> DotCodeM Doc
listToDot = forall a. PrintDot a => [a] -> DotCodeM Doc
unqtListToDot
printCell :: Attributes -> DotCode -> DotCode
printCell :: Attributes -> DotCodeM Doc -> DotCodeM Doc
printCell = DotCodeM Doc -> Attributes -> DotCodeM Doc -> DotCodeM Doc
printTag (forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"TD")
instance ParseDot Cell where
parseUnqt :: Parse Cell
parseUnqt = forall (p :: * -> *) a. PolyParse p => [p a] -> p a
oneOf [ forall val tag.
(Attributes -> val -> tag) -> Parse val -> Parse tag
parseCell Attributes -> Label -> Cell
LabelCell forall a. ParseDot a => Parse a
parse
, forall val tag.
(Attributes -> val -> tag) -> Parse val -> Parse tag
parseCell Attributes -> Img -> Cell
ImgCell forall a b. (a -> b) -> a -> b
$ forall a. Parse a -> Parse a
wrapWhitespace forall a. ParseDot a => Parse a
parse
, forall tag. (Attributes -> tag) -> String -> Parse tag
parseEmptyTag (forall a b. a -> b -> a
const Cell
VerticalRule) String
"VR"
]
forall (p :: * -> *) a. Commitment p => p a -> ShowS -> p a
`adjustErr`
(String
"Can't parse Html.Cell\n\t"forall a. [a] -> [a] -> [a]
++)
where
parseCell :: (Attributes -> val -> tag) -> Parse val -> Parse tag
parseCell = (forall val tag.
(Attributes -> val -> tag) -> String -> Parse val -> Parse tag
`parseTag` String
"TD")
parse :: Parse Cell
parse = forall a. ParseDot a => Parse a
parseUnqt
parseUnqtList :: Parse [Cell]
parseUnqtList = forall a. Parse a -> Parse a
wrapWhitespace forall a b. (a -> b) -> a -> b
$ forall (p :: * -> *) a sep. PolyParse p => p a -> p sep -> p [a]
sepBy1 forall a. ParseDot a => Parse a
parseUnqt Parse ()
whitespace
parseList :: Parse [Cell]
parseList = forall a. ParseDot a => Parse [a]
parseUnqtList
newtype Img = Img Attributes
deriving (Img -> Img -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Img -> Img -> Bool
$c/= :: Img -> Img -> Bool
== :: Img -> Img -> Bool
$c== :: Img -> Img -> Bool
Eq, Eq Img
Img -> Img -> Bool
Img -> Img -> Ordering
Img -> Img -> Img
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Img -> Img -> Img
$cmin :: Img -> Img -> Img
max :: Img -> Img -> Img
$cmax :: Img -> Img -> Img
>= :: Img -> Img -> Bool
$c>= :: Img -> Img -> Bool
> :: Img -> Img -> Bool
$c> :: Img -> Img -> Bool
<= :: Img -> Img -> Bool
$c<= :: Img -> Img -> Bool
< :: Img -> Img -> Bool
$c< :: Img -> Img -> Bool
compare :: Img -> Img -> Ordering
$ccompare :: Img -> Img -> Ordering
Ord, Int -> Img -> ShowS
[Img] -> ShowS
Img -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Img] -> ShowS
$cshowList :: [Img] -> ShowS
show :: Img -> String
$cshow :: Img -> String
showsPrec :: Int -> Img -> ShowS
$cshowsPrec :: Int -> Img -> ShowS
Show, ReadPrec [Img]
ReadPrec Img
Int -> ReadS Img
ReadS [Img]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Img]
$creadListPrec :: ReadPrec [Img]
readPrec :: ReadPrec Img
$creadPrec :: ReadPrec Img
readList :: ReadS [Img]
$creadList :: ReadS [Img]
readsPrec :: Int -> ReadS Img
$creadsPrec :: Int -> ReadS Img
Read)
instance PrintDot Img where
unqtDot :: Img -> DotCodeM Doc
unqtDot (Img Attributes
as) = DotCodeM Doc -> Attributes -> DotCodeM Doc
printEmptyTag (forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"IMG") Attributes
as
instance ParseDot Img where
parseUnqt :: Parse Img
parseUnqt = forall a. Parse a -> Parse a
wrapWhitespace (forall tag. (Attributes -> tag) -> String -> Parse tag
parseEmptyTag Attributes -> Img
Img String
"IMG")
forall (p :: * -> *) a. Commitment p => p a -> ShowS -> p a
`adjustErr`
(String
"Can't parse Html.Img\n\t"forall a. [a] -> [a] -> [a]
++)
parse :: Parse Img
parse = forall a. ParseDot a => Parse a
parseUnqt
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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Attribute -> Attribute -> Bool
$c/= :: Attribute -> Attribute -> Bool
== :: Attribute -> Attribute -> Bool
$c== :: Attribute -> Attribute -> Bool
Eq, Eq Attribute
Attribute -> Attribute -> Bool
Attribute -> Attribute -> Ordering
Attribute -> Attribute -> Attribute
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Attribute -> Attribute -> Attribute
$cmin :: Attribute -> Attribute -> Attribute
max :: Attribute -> Attribute -> Attribute
$cmax :: Attribute -> Attribute -> Attribute
>= :: Attribute -> Attribute -> Bool
$c>= :: Attribute -> Attribute -> Bool
> :: Attribute -> Attribute -> Bool
$c> :: Attribute -> Attribute -> Bool
<= :: Attribute -> Attribute -> Bool
$c<= :: Attribute -> Attribute -> Bool
< :: Attribute -> Attribute -> Bool
$c< :: Attribute -> Attribute -> Bool
compare :: Attribute -> Attribute -> Ordering
$ccompare :: Attribute -> Attribute -> Ordering
Ord, Int -> Attribute -> ShowS
Attributes -> ShowS
Attribute -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: Attributes -> ShowS
$cshowList :: Attributes -> ShowS
show :: Attribute -> String
$cshow :: Attribute -> String
showsPrec :: Int -> Attribute -> ShowS
$cshowsPrec :: Int -> Attribute -> ShowS
Show, ReadPrec Attributes
ReadPrec Attribute
Int -> ReadS Attribute
ReadS Attributes
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec Attributes
$creadListPrec :: ReadPrec Attributes
readPrec :: ReadPrec Attribute
$creadPrec :: ReadPrec Attribute
readList :: ReadS Attributes
$creadList :: ReadS Attributes
readsPrec :: Int -> ReadS Attribute
$creadsPrec :: Int -> ReadS Attribute
Read)
instance PrintDot Attribute where
unqtDot :: Attribute -> DotCodeM Doc
unqtDot (Align Align
v) = forall a. PrintDot a => Text -> a -> DotCodeM Doc
printHtmlField Text
"ALIGN" Align
v
unqtDot (BAlign Align
v) = forall a. PrintDot a => Text -> a -> DotCodeM Doc
printHtmlField Text
"BALIGN" Align
v
unqtDot (BGColor Color
v) = forall a. PrintDot a => Text -> a -> DotCodeM Doc
printHtmlField Text
"BGCOLOR" Color
v
unqtDot (Border Word8
v) = forall a. PrintDot a => Text -> a -> DotCodeM Doc
printHtmlField Text
"BORDER" Word8
v
unqtDot (CellBorder Word8
v) = forall a. PrintDot a => Text -> a -> DotCodeM Doc
printHtmlField Text
"CELLBORDER" Word8
v
unqtDot (CellPadding Word8
v) = forall a. PrintDot a => Text -> a -> DotCodeM Doc
printHtmlField Text
"CELLPADDING" Word8
v
unqtDot (CellSpacing Word8
v) = forall a. PrintDot a => Text -> a -> DotCodeM Doc
printHtmlField Text
"CELLSPACING" Word8
v
unqtDot (Color Color
v) = forall a. PrintDot a => Text -> a -> DotCodeM Doc
printHtmlField Text
"COLOR" Color
v
unqtDot (ColSpan Word16
v) = forall a. PrintDot a => Text -> a -> DotCodeM Doc
printHtmlField Text
"COLSPAN" Word16
v
unqtDot (Columns CellFormat
v) = forall a. PrintDot a => Text -> a -> DotCodeM Doc
printHtmlField Text
"COLUMNS" CellFormat
v
unqtDot (Face Text
v) = Text -> DotCodeM Doc -> DotCodeM Doc
printHtmlField' Text
"FACE" forall a b. (a -> b) -> a -> b
$ Text -> DotCodeM Doc
escapeAttribute Text
v
unqtDot (FixedSize Bool
v) = Text -> DotCodeM Doc -> DotCodeM Doc
printHtmlField' Text
"FIXEDSIZE" forall a b. (a -> b) -> a -> b
$ Bool -> DotCodeM Doc
printBoolHtml Bool
v
unqtDot (GradientAngle Int
v) = forall a. PrintDot a => Text -> a -> DotCodeM Doc
printHtmlField Text
"GRADIENTANGLE" Int
v
unqtDot (Height Word16
v) = forall a. PrintDot a => Text -> a -> DotCodeM Doc
printHtmlField Text
"HEIGHT" Word16
v
unqtDot (HRef Text
v) = Text -> DotCodeM Doc -> DotCodeM Doc
printHtmlField' Text
"HREF" forall a b. (a -> b) -> a -> b
$ Text -> DotCodeM Doc
escapeAttribute Text
v
unqtDot (ID Text
v) = Text -> DotCodeM Doc -> DotCodeM Doc
printHtmlField' Text
"ID" forall a b. (a -> b) -> a -> b
$ Text -> DotCodeM Doc
escapeAttribute Text
v
unqtDot (PointSize Double
v) = forall a. PrintDot a => Text -> a -> DotCodeM Doc
printHtmlField Text
"POINT-SIZE" Double
v
unqtDot (Port PortName
v) = Text -> DotCodeM Doc -> DotCodeM Doc
printHtmlField' Text
"PORT" forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> DotCodeM Doc
escapeAttribute forall a b. (a -> b) -> a -> b
$ PortName -> Text
portName PortName
v
unqtDot (Rows CellFormat
v) = forall a. PrintDot a => Text -> a -> DotCodeM Doc
printHtmlField Text
"ROWS" CellFormat
v
unqtDot (RowSpan Word16
v) = forall a. PrintDot a => Text -> a -> DotCodeM Doc
printHtmlField Text
"ROWSPAN" Word16
v
unqtDot (Scale Scale
v) = forall a. PrintDot a => Text -> a -> DotCodeM Doc
printHtmlField Text
"SCALE" Scale
v
unqtDot (Sides [Side]
v) = forall a. PrintDot a => Text -> a -> DotCodeM Doc
printHtmlField Text
"SIDES" [Side]
v
unqtDot (Src String
v) = Text -> DotCodeM Doc -> DotCodeM Doc
printHtmlField' Text
"SRC" forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> DotCodeM Doc
escapeAttribute forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
v
unqtDot (Style Style
v) = forall a. PrintDot a => Text -> a -> DotCodeM Doc
printHtmlField Text
"STYLE" Style
v
unqtDot (Target Text
v) = Text -> DotCodeM Doc -> DotCodeM Doc
printHtmlField' Text
"TARGET" forall a b. (a -> b) -> a -> b
$ Text -> DotCodeM Doc
escapeAttribute Text
v
unqtDot (Title Text
v) = Text -> DotCodeM Doc -> DotCodeM Doc
printHtmlField' Text
"TITLE" forall a b. (a -> b) -> a -> b
$ Text -> DotCodeM Doc
escapeAttribute Text
v
unqtDot (VAlign VAlign
v) = forall a. PrintDot a => Text -> a -> DotCodeM Doc
printHtmlField Text
"VALIGN" VAlign
v
unqtDot (Width Word16
v) = forall a. PrintDot a => Text -> a -> DotCodeM Doc
printHtmlField Text
"WIDTH" Word16
v
unqtListToDot :: Attributes -> DotCodeM Doc
unqtListToDot = forall (m :: * -> *). Functor m => m [Doc] -> m Doc
hsep forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall a. PrintDot a => a -> DotCodeM Doc
unqtDot
listToDot :: Attributes -> DotCodeM Doc
listToDot = forall a. PrintDot a => [a] -> DotCodeM Doc
unqtListToDot
printHtmlField :: (PrintDot a) => T.Text -> a -> DotCode
printHtmlField :: forall a. PrintDot a => Text -> a -> DotCodeM Doc
printHtmlField Text
f = Text -> DotCodeM Doc -> DotCodeM Doc
printHtmlField' Text
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. PrintDot a => a -> DotCodeM Doc
unqtDot
printHtmlField' :: T.Text -> DotCode -> DotCode
printHtmlField' :: Text -> DotCodeM Doc -> DotCodeM Doc
printHtmlField' Text
f DotCodeM Doc
v = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
f forall a. Semigroup a => a -> a -> a
<> forall (m :: * -> *). Applicative m => m Doc
equals forall a. Semigroup a => a -> a -> a
<> forall (m :: * -> *). Functor m => m Doc -> m Doc
dquotes DotCodeM Doc
v
instance ParseDot Attribute where
parseUnqt :: Parse Attribute
parseUnqt = forall (p :: * -> *) a. PolyParse p => [p a] -> p a
oneOf [ forall a.
ParseDot a =>
(a -> Attribute) -> String -> Parse Attribute
parseHtmlField Align -> Attribute
Align String
"ALIGN"
, forall a.
ParseDot a =>
(a -> Attribute) -> String -> Parse Attribute
parseHtmlField Align -> Attribute
BAlign String
"BALIGN"
, forall a.
ParseDot a =>
(a -> Attribute) -> String -> Parse Attribute
parseHtmlField Color -> Attribute
BGColor String
"BGCOLOR"
, forall a.
ParseDot a =>
(a -> Attribute) -> String -> Parse Attribute
parseHtmlField Word8 -> Attribute
Border String
"BORDER"
, forall a.
ParseDot a =>
(a -> Attribute) -> String -> Parse Attribute
parseHtmlField Word8 -> Attribute
CellBorder String
"CELLBORDER"
, forall a.
ParseDot a =>
(a -> Attribute) -> String -> Parse Attribute
parseHtmlField Word8 -> Attribute
CellPadding String
"CELLPADDING"
, forall a.
ParseDot a =>
(a -> Attribute) -> String -> Parse Attribute
parseHtmlField Word8 -> Attribute
CellSpacing String
"CELLSPACING"
, forall a.
ParseDot a =>
(a -> Attribute) -> String -> Parse Attribute
parseHtmlField Color -> Attribute
Color String
"COLOR"
, forall a.
ParseDot a =>
(a -> Attribute) -> String -> Parse Attribute
parseHtmlField Word16 -> Attribute
ColSpan String
"COLSPAN"
, forall a.
ParseDot a =>
(a -> Attribute) -> String -> Parse Attribute
parseHtmlField CellFormat -> Attribute
Columns String
"COLUMNS"
, forall a. (a -> Attribute) -> String -> Parse a -> Parse Attribute
parseHtmlField' Text -> Attribute
Face String
"FACE" Parse Text
unescapeAttribute
, forall a. (a -> Attribute) -> String -> Parse a -> Parse Attribute
parseHtmlField' Bool -> Attribute
FixedSize String
"FIXEDSIZE" Parse Bool
parseBoolHtml
, forall a.
ParseDot a =>
(a -> Attribute) -> String -> Parse Attribute
parseHtmlField Int -> Attribute
GradientAngle String
"GRADIENTANGLE"
, forall a.
ParseDot a =>
(a -> Attribute) -> String -> Parse Attribute
parseHtmlField Word16 -> Attribute
Height String
"HEIGHT"
, forall a. (a -> Attribute) -> String -> Parse a -> Parse Attribute
parseHtmlField' Text -> Attribute
HRef String
"HREF" Parse Text
unescapeAttribute
, forall a. (a -> Attribute) -> String -> Parse a -> Parse Attribute
parseHtmlField' Text -> Attribute
ID String
"ID" Parse Text
unescapeAttribute
, forall a.
ParseDot a =>
(a -> Attribute) -> String -> Parse Attribute
parseHtmlField Double -> Attribute
PointSize String
"POINT-SIZE"
, forall a. (a -> Attribute) -> String -> Parse a -> Parse Attribute
parseHtmlField' (PortName -> Attribute
Port forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> PortName
PN) String
"PORT" Parse Text
unescapeAttribute
, forall a.
ParseDot a =>
(a -> Attribute) -> String -> Parse Attribute
parseHtmlField CellFormat -> Attribute
Rows String
"ROWS"
, forall a.
ParseDot a =>
(a -> Attribute) -> String -> Parse Attribute
parseHtmlField Word16 -> Attribute
RowSpan String
"ROWSPAN"
, forall a.
ParseDot a =>
(a -> Attribute) -> String -> Parse Attribute
parseHtmlField Scale -> Attribute
Scale String
"SCALE"
, forall a.
ParseDot a =>
(a -> Attribute) -> String -> Parse Attribute
parseHtmlField [Side] -> Attribute
Sides String
"SIDES"
, forall a. (a -> Attribute) -> String -> Parse a -> Parse Attribute
parseHtmlField' String -> Attribute
Src String
"SRC" forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> String
T.unpack Parse Text
unescapeAttribute
, forall a.
ParseDot a =>
(a -> Attribute) -> String -> Parse Attribute
parseHtmlField Style -> Attribute
Style String
"STYLE"
, forall a. (a -> Attribute) -> String -> Parse a -> Parse Attribute
parseHtmlField' Text -> Attribute
Target String
"TARGET" Parse Text
unescapeAttribute
, forall a. (a -> Attribute) -> String -> Parse a -> Parse Attribute
parseHtmlField' Text -> Attribute
Title String
"TITLE" Parse Text
unescapeAttribute
forall s a. Parser s a -> Parser s a -> Parser s a
`onFail`
forall a. (a -> Attribute) -> String -> Parse a -> Parse Attribute
parseHtmlField' Text -> Attribute
Title String
"TOOLTIP" Parse Text
unescapeAttribute
, forall a.
ParseDot a =>
(a -> Attribute) -> String -> Parse Attribute
parseHtmlField VAlign -> Attribute
VAlign String
"VALIGN"
, forall a.
ParseDot a =>
(a -> Attribute) -> String -> Parse Attribute
parseHtmlField Word16 -> Attribute
Width String
"WIDTH"
]
parse :: Parse Attribute
parse = forall a. ParseDot a => Parse a
parseUnqt
parseUnqtList :: Parse Attributes
parseUnqtList = forall (p :: * -> *) a sep. PolyParse p => p a -> p sep -> p [a]
sepBy forall a. ParseDot a => Parse a
parseUnqt Parse ()
whitespace1
parseList :: Parse Attributes
parseList = forall a. ParseDot a => Parse [a]
parseUnqtList
parseHtmlField :: (ParseDot a) => (a -> Attribute) -> String
-> Parse Attribute
parseHtmlField :: forall a.
ParseDot a =>
(a -> Attribute) -> String -> Parse Attribute
parseHtmlField a -> Attribute
c String
f = forall a. (a -> Attribute) -> String -> Parse a -> Parse Attribute
parseHtmlField' a -> Attribute
c String
f forall a. ParseDot a => Parse a
parseUnqt
parseHtmlField' :: (a -> Attribute) -> String -> Parse a
-> Parse Attribute
parseHtmlField' :: forall a. (a -> Attribute) -> String -> Parse a -> Parse Attribute
parseHtmlField' a -> Attribute
c String
f Parse a
p = String -> Parse ()
string String
f
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parse ()
parseEq
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ( a -> Attribute
c forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ( forall a. Parse a -> Parse a
quotedParse Parse a
p
forall (p :: * -> *) a. Commitment p => p a -> ShowS -> p a
`adjustErr`
((String
"Can't parse HTML.Attribute." forall a. [a] -> [a] -> [a]
++ String
f forall a. [a] -> [a] -> [a]
++ String
"\n\t")forall a. [a] -> [a] -> [a]
++)
)
)
data Align = HLeft
| HCenter
| HRight
| HText
deriving (Align -> Align -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Align -> Align -> Bool
$c/= :: Align -> Align -> Bool
== :: Align -> Align -> Bool
$c== :: Align -> Align -> Bool
Eq, Eq Align
Align -> Align -> Bool
Align -> Align -> Ordering
Align -> Align -> Align
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Align -> Align -> Align
$cmin :: Align -> Align -> Align
max :: Align -> Align -> Align
$cmax :: Align -> Align -> Align
>= :: Align -> Align -> Bool
$c>= :: Align -> Align -> Bool
> :: Align -> Align -> Bool
$c> :: Align -> Align -> Bool
<= :: Align -> Align -> Bool
$c<= :: Align -> Align -> Bool
< :: Align -> Align -> Bool
$c< :: Align -> Align -> Bool
compare :: Align -> Align -> Ordering
$ccompare :: Align -> Align -> Ordering
Ord, Align
forall a. a -> a -> Bounded a
maxBound :: Align
$cmaxBound :: Align
minBound :: Align
$cminBound :: Align
Bounded, Int -> Align
Align -> Int
Align -> [Align]
Align -> Align
Align -> Align -> [Align]
Align -> Align -> Align -> [Align]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Align -> Align -> Align -> [Align]
$cenumFromThenTo :: Align -> Align -> Align -> [Align]
enumFromTo :: Align -> Align -> [Align]
$cenumFromTo :: Align -> Align -> [Align]
enumFromThen :: Align -> Align -> [Align]
$cenumFromThen :: Align -> Align -> [Align]
enumFrom :: Align -> [Align]
$cenumFrom :: Align -> [Align]
fromEnum :: Align -> Int
$cfromEnum :: Align -> Int
toEnum :: Int -> Align
$ctoEnum :: Int -> Align
pred :: Align -> Align
$cpred :: Align -> Align
succ :: Align -> Align
$csucc :: Align -> Align
Enum, Int -> Align -> ShowS
[Align] -> ShowS
Align -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Align] -> ShowS
$cshowList :: [Align] -> ShowS
show :: Align -> String
$cshow :: Align -> String
showsPrec :: Int -> Align -> ShowS
$cshowsPrec :: Int -> Align -> ShowS
Show, ReadPrec [Align]
ReadPrec Align
Int -> ReadS Align
ReadS [Align]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Align]
$creadListPrec :: ReadPrec [Align]
readPrec :: ReadPrec Align
$creadPrec :: ReadPrec Align
readList :: ReadS [Align]
$creadList :: ReadS [Align]
readsPrec :: Int -> ReadS Align
$creadsPrec :: Int -> ReadS Align
Read)
instance PrintDot Align where
unqtDot :: Align -> DotCodeM Doc
unqtDot Align
HLeft = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"LEFT"
unqtDot Align
HCenter = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"CENTER"
unqtDot Align
HRight = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"RIGHT"
unqtDot Align
HText = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"TEXT"
instance ParseDot Align where
parseUnqt :: Parse Align
parseUnqt = forall (p :: * -> *) a. PolyParse p => [p a] -> p a
oneOf [ forall a. a -> String -> Parse a
stringRep Align
HLeft String
"LEFT"
, forall a. a -> String -> Parse a
stringRep Align
HCenter String
"CENTER"
, forall a. a -> String -> Parse a
stringRep Align
HRight String
"RIGHT"
, forall a. a -> String -> Parse a
stringRep Align
HText String
"TEXT"
]
parse :: Parse Align
parse = forall a. ParseDot a => Parse a
parseUnqt
data VAlign = HTop
| HMiddle
| HBottom
deriving (VAlign -> VAlign -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VAlign -> VAlign -> Bool
$c/= :: VAlign -> VAlign -> Bool
== :: VAlign -> VAlign -> Bool
$c== :: VAlign -> VAlign -> Bool
Eq, Eq VAlign
VAlign -> VAlign -> Bool
VAlign -> VAlign -> Ordering
VAlign -> VAlign -> VAlign
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: VAlign -> VAlign -> VAlign
$cmin :: VAlign -> VAlign -> VAlign
max :: VAlign -> VAlign -> VAlign
$cmax :: VAlign -> VAlign -> VAlign
>= :: VAlign -> VAlign -> Bool
$c>= :: VAlign -> VAlign -> Bool
> :: VAlign -> VAlign -> Bool
$c> :: VAlign -> VAlign -> Bool
<= :: VAlign -> VAlign -> Bool
$c<= :: VAlign -> VAlign -> Bool
< :: VAlign -> VAlign -> Bool
$c< :: VAlign -> VAlign -> Bool
compare :: VAlign -> VAlign -> Ordering
$ccompare :: VAlign -> VAlign -> Ordering
Ord, VAlign
forall a. a -> a -> Bounded a
maxBound :: VAlign
$cmaxBound :: VAlign
minBound :: VAlign
$cminBound :: VAlign
Bounded, Int -> VAlign
VAlign -> Int
VAlign -> [VAlign]
VAlign -> VAlign
VAlign -> VAlign -> [VAlign]
VAlign -> VAlign -> VAlign -> [VAlign]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: VAlign -> VAlign -> VAlign -> [VAlign]
$cenumFromThenTo :: VAlign -> VAlign -> VAlign -> [VAlign]
enumFromTo :: VAlign -> VAlign -> [VAlign]
$cenumFromTo :: VAlign -> VAlign -> [VAlign]
enumFromThen :: VAlign -> VAlign -> [VAlign]
$cenumFromThen :: VAlign -> VAlign -> [VAlign]
enumFrom :: VAlign -> [VAlign]
$cenumFrom :: VAlign -> [VAlign]
fromEnum :: VAlign -> Int
$cfromEnum :: VAlign -> Int
toEnum :: Int -> VAlign
$ctoEnum :: Int -> VAlign
pred :: VAlign -> VAlign
$cpred :: VAlign -> VAlign
succ :: VAlign -> VAlign
$csucc :: VAlign -> VAlign
Enum, Int -> VAlign -> ShowS
[VAlign] -> ShowS
VAlign -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VAlign] -> ShowS
$cshowList :: [VAlign] -> ShowS
show :: VAlign -> String
$cshow :: VAlign -> String
showsPrec :: Int -> VAlign -> ShowS
$cshowsPrec :: Int -> VAlign -> ShowS
Show, ReadPrec [VAlign]
ReadPrec VAlign
Int -> ReadS VAlign
ReadS [VAlign]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [VAlign]
$creadListPrec :: ReadPrec [VAlign]
readPrec :: ReadPrec VAlign
$creadPrec :: ReadPrec VAlign
readList :: ReadS [VAlign]
$creadList :: ReadS [VAlign]
readsPrec :: Int -> ReadS VAlign
$creadsPrec :: Int -> ReadS VAlign
Read)
instance PrintDot VAlign where
unqtDot :: VAlign -> DotCodeM Doc
unqtDot VAlign
HTop = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"TOP"
unqtDot VAlign
HMiddle = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"MIDDLE"
unqtDot VAlign
HBottom = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"BOTTOM"
instance ParseDot VAlign where
parseUnqt :: Parse VAlign
parseUnqt = forall (p :: * -> *) a. PolyParse p => [p a] -> p a
oneOf [ forall a. a -> String -> Parse a
stringRep VAlign
HTop String
"TOP"
, forall a. a -> String -> Parse a
stringRep VAlign
HMiddle String
"MIDDLE"
, forall a. a -> String -> Parse a
stringRep VAlign
HBottom String
"BOTTOM"
]
parse :: Parse VAlign
parse = forall a. ParseDot a => Parse a
parseUnqt
data CellFormat = RuleBetween
deriving (CellFormat -> CellFormat -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CellFormat -> CellFormat -> Bool
$c/= :: CellFormat -> CellFormat -> Bool
== :: CellFormat -> CellFormat -> Bool
$c== :: CellFormat -> CellFormat -> Bool
Eq, Eq CellFormat
CellFormat -> CellFormat -> Bool
CellFormat -> CellFormat -> Ordering
CellFormat -> CellFormat -> CellFormat
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: CellFormat -> CellFormat -> CellFormat
$cmin :: CellFormat -> CellFormat -> CellFormat
max :: CellFormat -> CellFormat -> CellFormat
$cmax :: CellFormat -> CellFormat -> CellFormat
>= :: CellFormat -> CellFormat -> Bool
$c>= :: CellFormat -> CellFormat -> Bool
> :: CellFormat -> CellFormat -> Bool
$c> :: CellFormat -> CellFormat -> Bool
<= :: CellFormat -> CellFormat -> Bool
$c<= :: CellFormat -> CellFormat -> Bool
< :: CellFormat -> CellFormat -> Bool
$c< :: CellFormat -> CellFormat -> Bool
compare :: CellFormat -> CellFormat -> Ordering
$ccompare :: CellFormat -> CellFormat -> Ordering
Ord, CellFormat
forall a. a -> a -> Bounded a
maxBound :: CellFormat
$cmaxBound :: CellFormat
minBound :: CellFormat
$cminBound :: CellFormat
Bounded, Int -> CellFormat
CellFormat -> Int
CellFormat -> [CellFormat]
CellFormat -> CellFormat
CellFormat -> CellFormat -> [CellFormat]
CellFormat -> CellFormat -> CellFormat -> [CellFormat]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: CellFormat -> CellFormat -> CellFormat -> [CellFormat]
$cenumFromThenTo :: CellFormat -> CellFormat -> CellFormat -> [CellFormat]
enumFromTo :: CellFormat -> CellFormat -> [CellFormat]
$cenumFromTo :: CellFormat -> CellFormat -> [CellFormat]
enumFromThen :: CellFormat -> CellFormat -> [CellFormat]
$cenumFromThen :: CellFormat -> CellFormat -> [CellFormat]
enumFrom :: CellFormat -> [CellFormat]
$cenumFrom :: CellFormat -> [CellFormat]
fromEnum :: CellFormat -> Int
$cfromEnum :: CellFormat -> Int
toEnum :: Int -> CellFormat
$ctoEnum :: Int -> CellFormat
pred :: CellFormat -> CellFormat
$cpred :: CellFormat -> CellFormat
succ :: CellFormat -> CellFormat
$csucc :: CellFormat -> CellFormat
Enum, Int -> CellFormat -> ShowS
[CellFormat] -> ShowS
CellFormat -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CellFormat] -> ShowS
$cshowList :: [CellFormat] -> ShowS
show :: CellFormat -> String
$cshow :: CellFormat -> String
showsPrec :: Int -> CellFormat -> ShowS
$cshowsPrec :: Int -> CellFormat -> ShowS
Show, ReadPrec [CellFormat]
ReadPrec CellFormat
Int -> ReadS CellFormat
ReadS [CellFormat]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CellFormat]
$creadListPrec :: ReadPrec [CellFormat]
readPrec :: ReadPrec CellFormat
$creadPrec :: ReadPrec CellFormat
readList :: ReadS [CellFormat]
$creadList :: ReadS [CellFormat]
readsPrec :: Int -> ReadS CellFormat
$creadsPrec :: Int -> ReadS CellFormat
Read)
instance PrintDot CellFormat where
unqtDot :: CellFormat -> DotCodeM Doc
unqtDot CellFormat
RuleBetween = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"*"
instance ParseDot CellFormat where
parseUnqt :: Parse CellFormat
parseUnqt = forall a. a -> String -> Parse a
stringRep CellFormat
RuleBetween String
"*"
parse :: Parse CellFormat
parse = forall a. ParseDot a => Parse a
parseUnqt
data Scale = NaturalSize
| ScaleUniformly
| ExpandWidth
| ExpandHeight
| ExpandBoth
deriving (Scale -> Scale -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Scale -> Scale -> Bool
$c/= :: Scale -> Scale -> Bool
== :: Scale -> Scale -> Bool
$c== :: Scale -> Scale -> Bool
Eq, Eq Scale
Scale -> Scale -> Bool
Scale -> Scale -> Ordering
Scale -> Scale -> Scale
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Scale -> Scale -> Scale
$cmin :: Scale -> Scale -> Scale
max :: Scale -> Scale -> Scale
$cmax :: Scale -> Scale -> Scale
>= :: Scale -> Scale -> Bool
$c>= :: Scale -> Scale -> Bool
> :: Scale -> Scale -> Bool
$c> :: Scale -> Scale -> Bool
<= :: Scale -> Scale -> Bool
$c<= :: Scale -> Scale -> Bool
< :: Scale -> Scale -> Bool
$c< :: Scale -> Scale -> Bool
compare :: Scale -> Scale -> Ordering
$ccompare :: Scale -> Scale -> Ordering
Ord, Scale
forall a. a -> a -> Bounded a
maxBound :: Scale
$cmaxBound :: Scale
minBound :: Scale
$cminBound :: Scale
Bounded, Int -> Scale
Scale -> Int
Scale -> [Scale]
Scale -> Scale
Scale -> Scale -> [Scale]
Scale -> Scale -> Scale -> [Scale]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Scale -> Scale -> Scale -> [Scale]
$cenumFromThenTo :: Scale -> Scale -> Scale -> [Scale]
enumFromTo :: Scale -> Scale -> [Scale]
$cenumFromTo :: Scale -> Scale -> [Scale]
enumFromThen :: Scale -> Scale -> [Scale]
$cenumFromThen :: Scale -> Scale -> [Scale]
enumFrom :: Scale -> [Scale]
$cenumFrom :: Scale -> [Scale]
fromEnum :: Scale -> Int
$cfromEnum :: Scale -> Int
toEnum :: Int -> Scale
$ctoEnum :: Int -> Scale
pred :: Scale -> Scale
$cpred :: Scale -> Scale
succ :: Scale -> Scale
$csucc :: Scale -> Scale
Enum, Int -> Scale -> ShowS
[Scale] -> ShowS
Scale -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Scale] -> ShowS
$cshowList :: [Scale] -> ShowS
show :: Scale -> String
$cshow :: Scale -> String
showsPrec :: Int -> Scale -> ShowS
$cshowsPrec :: Int -> Scale -> ShowS
Show, ReadPrec [Scale]
ReadPrec Scale
Int -> ReadS Scale
ReadS [Scale]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Scale]
$creadListPrec :: ReadPrec [Scale]
readPrec :: ReadPrec Scale
$creadPrec :: ReadPrec Scale
readList :: ReadS [Scale]
$creadList :: ReadS [Scale]
readsPrec :: Int -> ReadS Scale
$creadsPrec :: Int -> ReadS Scale
Read)
instance PrintDot Scale where
unqtDot :: Scale -> DotCodeM Doc
unqtDot Scale
NaturalSize = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"FALSE"
unqtDot Scale
ScaleUniformly = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"TRUE"
unqtDot Scale
ExpandWidth = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"WIDTH"
unqtDot Scale
ExpandHeight = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"HEIGHT"
unqtDot Scale
ExpandBoth = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"BOTH"
instance ParseDot Scale where
parseUnqt :: Parse Scale
parseUnqt = forall (p :: * -> *) a. PolyParse p => [p a] -> p a
oneOf [ forall a. a -> String -> Parse a
stringRep Scale
NaturalSize String
"FALSE"
, forall a. a -> String -> Parse a
stringRep Scale
ScaleUniformly String
"TRUE"
, forall a. a -> String -> Parse a
stringRep Scale
ExpandWidth String
"WIDTH"
, forall a. a -> String -> Parse a
stringRep Scale
ExpandHeight String
"HEIGHT"
, forall a. a -> String -> Parse a
stringRep Scale
ExpandBoth String
"BOTH"
]
parse :: Parse Scale
parse = forall a. ParseDot a => Parse a
parseUnqt
data Side = LeftSide
| RightSide
| TopSide
| BottomSide
deriving (Side -> Side -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Side -> Side -> Bool
$c/= :: Side -> Side -> Bool
== :: Side -> Side -> Bool
$c== :: Side -> Side -> Bool
Eq, Eq Side
Side -> Side -> Bool
Side -> Side -> Ordering
Side -> Side -> Side
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Side -> Side -> Side
$cmin :: Side -> Side -> Side
max :: Side -> Side -> Side
$cmax :: Side -> Side -> Side
>= :: Side -> Side -> Bool
$c>= :: Side -> Side -> Bool
> :: Side -> Side -> Bool
$c> :: Side -> Side -> Bool
<= :: Side -> Side -> Bool
$c<= :: Side -> Side -> Bool
< :: Side -> Side -> Bool
$c< :: Side -> Side -> Bool
compare :: Side -> Side -> Ordering
$ccompare :: Side -> Side -> Ordering
Ord, Side
forall a. a -> a -> Bounded a
maxBound :: Side
$cmaxBound :: Side
minBound :: Side
$cminBound :: Side
Bounded, Int -> Side
Side -> Int
Side -> [Side]
Side -> Side
Side -> Side -> [Side]
Side -> Side -> Side -> [Side]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Side -> Side -> Side -> [Side]
$cenumFromThenTo :: Side -> Side -> Side -> [Side]
enumFromTo :: Side -> Side -> [Side]
$cenumFromTo :: Side -> Side -> [Side]
enumFromThen :: Side -> Side -> [Side]
$cenumFromThen :: Side -> Side -> [Side]
enumFrom :: Side -> [Side]
$cenumFrom :: Side -> [Side]
fromEnum :: Side -> Int
$cfromEnum :: Side -> Int
toEnum :: Int -> Side
$ctoEnum :: Int -> Side
pred :: Side -> Side
$cpred :: Side -> Side
succ :: Side -> Side
$csucc :: Side -> Side
Enum, Int -> Side -> ShowS
[Side] -> ShowS
Side -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Side] -> ShowS
$cshowList :: [Side] -> ShowS
show :: Side -> String
$cshow :: Side -> String
showsPrec :: Int -> Side -> ShowS
$cshowsPrec :: Int -> Side -> ShowS
Show, ReadPrec [Side]
ReadPrec Side
Int -> ReadS Side
ReadS [Side]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Side]
$creadListPrec :: ReadPrec [Side]
readPrec :: ReadPrec Side
$creadPrec :: ReadPrec Side
readList :: ReadS [Side]
$creadList :: ReadS [Side]
readsPrec :: Int -> ReadS Side
$creadsPrec :: Int -> ReadS Side
Read)
instance PrintDot Side where
unqtDot :: Side -> DotCodeM Doc
unqtDot Side
LeftSide = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"L"
unqtDot Side
RightSide = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"R"
unqtDot Side
TopSide = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"T"
unqtDot Side
BottomSide = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"B"
unqtListToDot :: [Side] -> DotCodeM Doc
unqtListToDot = forall (m :: * -> *). Functor m => m [Doc] -> m Doc
hcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall a. PrintDot a => a -> DotCodeM Doc
unqtDot
listToDot :: [Side] -> DotCodeM Doc
listToDot = forall a. PrintDot a => [a] -> DotCodeM Doc
unqtListToDot
instance ParseDot Side where
parseUnqt :: Parse Side
parseUnqt = forall (p :: * -> *) a. PolyParse p => [p a] -> p a
oneOf [ forall a. a -> String -> Parse a
stringRep Side
LeftSide String
"L"
, forall a. a -> String -> Parse a
stringRep Side
RightSide String
"R"
, forall a. a -> String -> Parse a
stringRep Side
TopSide String
"T"
, forall a. a -> String -> Parse a
stringRep Side
BottomSide String
"B"
]
parse :: Parse Side
parse = forall a. ParseDot a => Parse a
parseUnqt
parseUnqtList :: Parse [Side]
parseUnqtList = forall (f :: * -> *) a. Alternative f => f a -> f [a]
many forall a. ParseDot a => Parse a
parseUnqt
parseList :: Parse [Side]
parseList = forall a. ParseDot a => Parse [a]
parseUnqtList
data Style = Rounded
| Radial
deriving (Style -> Style -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Style -> Style -> Bool
$c/= :: Style -> Style -> Bool
== :: Style -> Style -> Bool
$c== :: Style -> Style -> Bool
Eq, Eq Style
Style -> Style -> Bool
Style -> Style -> Ordering
Style -> Style -> Style
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Style -> Style -> Style
$cmin :: Style -> Style -> Style
max :: Style -> Style -> Style
$cmax :: Style -> Style -> Style
>= :: Style -> Style -> Bool
$c>= :: Style -> Style -> Bool
> :: Style -> Style -> Bool
$c> :: Style -> Style -> Bool
<= :: Style -> Style -> Bool
$c<= :: Style -> Style -> Bool
< :: Style -> Style -> Bool
$c< :: Style -> Style -> Bool
compare :: Style -> Style -> Ordering
$ccompare :: Style -> Style -> Ordering
Ord, Style
forall a. a -> a -> Bounded a
maxBound :: Style
$cmaxBound :: Style
minBound :: Style
$cminBound :: Style
Bounded, Int -> Style
Style -> Int
Style -> [Style]
Style -> Style
Style -> Style -> [Style]
Style -> Style -> Style -> [Style]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Style -> Style -> Style -> [Style]
$cenumFromThenTo :: Style -> Style -> Style -> [Style]
enumFromTo :: Style -> Style -> [Style]
$cenumFromTo :: Style -> Style -> [Style]
enumFromThen :: Style -> Style -> [Style]
$cenumFromThen :: Style -> Style -> [Style]
enumFrom :: Style -> [Style]
$cenumFrom :: Style -> [Style]
fromEnum :: Style -> Int
$cfromEnum :: Style -> Int
toEnum :: Int -> Style
$ctoEnum :: Int -> Style
pred :: Style -> Style
$cpred :: Style -> Style
succ :: Style -> Style
$csucc :: Style -> Style
Enum, Int -> Style -> ShowS
[Style] -> ShowS
Style -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Style] -> ShowS
$cshowList :: [Style] -> ShowS
show :: Style -> String
$cshow :: Style -> String
showsPrec :: Int -> Style -> ShowS
$cshowsPrec :: Int -> Style -> ShowS
Show, ReadPrec [Style]
ReadPrec Style
Int -> ReadS Style
ReadS [Style]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Style]
$creadListPrec :: ReadPrec [Style]
readPrec :: ReadPrec Style
$creadPrec :: ReadPrec Style
readList :: ReadS [Style]
$creadList :: ReadS [Style]
readsPrec :: Int -> ReadS Style
$creadsPrec :: Int -> ReadS Style
Read)
instance PrintDot Style where
unqtDot :: Style -> DotCodeM Doc
unqtDot Style
Rounded = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"ROUNDED"
unqtDot Style
Radial = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"RADIAL"
instance ParseDot Style where
parseUnqt :: Parse Style
parseUnqt = forall (p :: * -> *) a. PolyParse p => [p a] -> p a
oneOf [ forall a. a -> String -> Parse a
stringRep Style
Rounded String
"ROUNDED"
, forall a. a -> String -> Parse a
stringRep Style
Radial String
"RADIAL"
]
parse :: Parse Style
parse = forall a. ParseDot a => Parse a
parseUnqt
escapeAttribute :: T.Text -> DotCode
escapeAttribute :: Text -> DotCodeM Doc
escapeAttribute = Bool -> Text -> DotCodeM Doc
escapeHtml Bool
False
escapeValue :: T.Text -> DotCode
escapeValue :: Text -> DotCodeM Doc
escapeValue = Bool -> Text -> DotCodeM Doc
escapeHtml Bool
True
escapeHtml :: Bool -> T.Text -> DotCode
escapeHtml :: Bool -> Text -> DotCodeM Doc
escapeHtml Bool
quotesAllowed = forall (m :: * -> *). Functor m => m [Doc] -> m Doc
hcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (String -> DotCodeM [Doc]
escapeSegment forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char -> Bool) -> Text -> [Text]
T.groupBy (forall a. Eq a => a -> a -> Bool
(==) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Char -> Bool
isSpace)
where
escapeSegment :: String -> DotCodeM [Doc]
escapeSegment (Char
s:String
sps) | Char -> Bool
isSpace Char
s = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (:) (forall (m :: * -> *). Applicative m => Char -> m Doc
char Char
s) forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Char -> DotCodeM Doc
numEscape String
sps
escapeSegment String
txt = forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Char -> DotCodeM Doc
xmlChar String
txt
allowQuotes :: Map Char a -> Map Char a
allowQuotes = if Bool
quotesAllowed
then forall k a. Ord k => k -> Map k a -> Map k a
Map.delete Char
'"'
else forall a. a -> a
id
escs :: Map Char Text
escs = forall {a}. Map Char a -> Map Char a
allowQuotes forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Char, Text)]
htmlEscapes
xmlChar :: Char -> DotCodeM Doc
xmlChar Char
c = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *). Applicative m => Char -> m Doc
char Char
c) Text -> DotCodeM Doc
escape forall a b. (a -> b) -> a -> b
$ Char
c forall k a. Ord k => k -> Map k a -> Maybe a
`Map.lookup` Map Char Text
escs
numEscape :: Char -> DotCodeM Doc
numEscape = forall {m :: * -> *}.
(Semigroup (m Doc), Applicative m) =>
m Doc -> m Doc
escape' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Semigroup a => a -> a -> a
(<>) (forall (m :: * -> *). Applicative m => Char -> m Doc
char Char
'#') forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). Applicative m => Int -> m Doc
int forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord
escape' :: m Doc -> m Doc
escape' m Doc
e = forall (m :: * -> *). Applicative m => Char -> m Doc
char Char
'&' forall a. Semigroup a => a -> a -> a
<> m Doc
e forall a. Semigroup a => a -> a -> a
<> forall (m :: * -> *). Applicative m => Char -> m Doc
char Char
';'
escape :: Text -> DotCodeM Doc
escape = forall {m :: * -> *}.
(Semigroup (m Doc), Applicative m) =>
m Doc -> m Doc
escape' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). Applicative m => Text -> m Doc
text
unescapeAttribute :: Parse T.Text
unescapeAttribute :: Parse Text
unescapeAttribute = Bool -> Parse Text
unescapeHtml Bool
False
unescapeValue :: Parse T.Text
unescapeValue :: Parse Text
unescapeValue = Bool -> Parse Text
unescapeHtml Bool
True
unescapeHtml :: Bool -> Parse T.Text
unescapeHtml :: Bool -> Parse Text
unescapeHtml Bool
quotesAllowed = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [Maybe a] -> [a]
catMaybes)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> *) a. PolyParse p => p a -> p [a]
many1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> *) a. PolyParse p => [p a] -> p a
oneOf forall a b. (a -> b) -> a -> b
$ [ Parser GraphvizState (Maybe Char)
parseEscpd
, forall {s}. Parser s (Maybe Char)
validChars
]
where
parseEscpd :: Parse (Maybe Char)
parseEscpd :: Parser GraphvizState (Maybe Char)
parseEscpd = do Char -> Parse Char
character Char
'&'
Text
esc <- forall s. (Char -> Bool) -> Parser s Text
many1Satisfy (Char
';' forall a. Eq a => a -> a -> Bool
/=)
Char -> Parse Char
character Char
';'
let c :: Maybe Char
c = case Text -> Maybe (Char, Text)
T.uncons forall a b. (a -> b) -> a -> b
$ Text -> Text
T.toLower Text
esc of
Just (Char
'#',Text
dec) | Just (Char
'x',Text
hex) <- Text -> Maybe (Char, Text)
T.uncons Text
dec
-> forall {t} {a}. (t -> [(Int, [a])]) -> t -> Maybe Char
readMaybe forall a. (Eq a, Num a) => ReadS a
readHex forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
hex
| Bool
otherwise
-> forall {t} {a}. (t -> [(Int, [a])]) -> t -> Maybe Char
readMaybe ReadS Int
readInt forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
dec
Maybe (Char, Text)
_ -> Text
esc forall k a. Ord k => k -> Map k a -> Maybe a
`Map.lookup` Map Text Char
escMap
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Char
c
readMaybe :: (t -> [(Int, [a])]) -> t -> Maybe Char
readMaybe t -> [(Int, [a])]
f t
str = do (Int
n, []) <- forall a. [a] -> Maybe a
listToMaybe forall a b. (a -> b) -> a -> b
$ t -> [(Int, [a])]
f t
str
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Int -> Char
chr Int
n
readInt :: ReadS Int
readInt :: ReadS Int
readInt = forall a. Read a => ReadS a
reads
allowQuotes :: ShowS
allowQuotes = if Bool
quotesAllowed
then forall a. Eq a => a -> [a] -> [a]
delete Char
'"'
else forall a. a -> a
id
escMap :: Map Text Char
escMap = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Text, Char)]
htmlUnescapes
validChars :: Parser s (Maybe Char)
validChars = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall s. (Char -> Bool) -> Parser s Char
satisfy (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` String
needEscaping)
needEscaping :: String
needEscaping = ShowS
allowQuotes forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(Char, Text)]
htmlEscapes
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
forall a. [a] -> [a] -> [a]
++
forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip (,)) [(Char, Text)]
htmlEscapes
where
maybeEscaped :: [(Text, Char)]
maybeEscaped = [(Text
"nbsp", Char
' '), (Text
"apos", Char
'\'')]
printBoolHtml :: Bool -> DotCode
printBoolHtml :: Bool -> DotCodeM Doc
printBoolHtml = forall (m :: * -> *). Applicative m => Text -> m Doc
text forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> a -> Bool -> a
bool Text
"FALSE" Text
"TRUE"
parseBoolHtml :: Parse Bool
parseBoolHtml :: Parse Bool
parseBoolHtml = forall a. a -> String -> Parse a
stringRep Bool
True String
"TRUE"
forall s a. Parser s a -> Parser s a -> Parser s a
`onFail`
forall a. a -> String -> Parse a
stringRep Bool
False String
"FALSE"
printTag :: DotCode -> Attributes -> DotCode -> DotCode
printTag :: DotCodeM Doc -> Attributes -> DotCodeM Doc -> DotCodeM Doc
printTag DotCodeM Doc
t Attributes
as DotCodeM Doc
v = DotCodeM Doc -> DotCodeM Doc
angled (DotCodeM Doc
t forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> forall a. PrintDot a => a -> DotCodeM Doc
toDot Attributes
as)
forall a. Semigroup a => a -> a -> a
<> DotCodeM Doc
v
forall a. Semigroup a => a -> a -> a
<> DotCodeM Doc -> DotCodeM Doc
angled (DotCodeM Doc
fslash forall a. Semigroup a => a -> a -> a
<> DotCodeM Doc
t)
printFontTag :: Attributes -> DotCode -> DotCode
printFontTag :: Attributes -> DotCodeM Doc -> DotCodeM Doc
printFontTag = DotCodeM Doc -> Attributes -> DotCodeM Doc -> DotCodeM Doc
printTag (forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"FONT")
printEmptyTag :: DotCode -> Attributes -> DotCode
printEmptyTag :: DotCodeM Doc -> Attributes -> DotCodeM Doc
printEmptyTag DotCodeM Doc
t Attributes
as = DotCodeM Doc -> DotCodeM Doc
angled forall a b. (a -> b) -> a -> b
$ DotCodeM Doc
t forall (m :: * -> *). Applicative m => m Doc -> m Doc -> m Doc
<+> forall a. PrintDot a => a -> DotCodeM Doc
toDot Attributes
as forall a. Semigroup a => a -> a -> a
<> DotCodeM Doc
fslash
parseTag :: (Attributes -> val -> tag) -> String
-> Parse val -> Parse tag
parseTag :: forall val tag.
(Attributes -> val -> tag) -> String -> Parse val -> Parse tag
parseTag Attributes -> val -> tag
c String
t Parse val
pv = Attributes -> val -> tag
c forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Parse a -> Parse a
parseAngled Parse Attributes
openingTag
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Parse a -> Parse a
wrapWhitespace Parse val
pv
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall a. Parse a -> Parse a
parseAngled (Char -> Parse Char
character Char
'/' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parse ()
t' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parse ()
whitespace)
forall (p :: * -> *) a. Commitment p => p a -> ShowS -> p a
`adjustErr`
((String
"Can't parse Html tag: " forall a. [a] -> [a] -> [a]
++ String
t forall a. [a] -> [a] -> [a]
++ String
"\n\t")forall a. [a] -> [a] -> [a]
++)
where
t' :: Parse ()
t' = String -> Parse ()
string String
t
openingTag :: Parse Attributes
openingTag :: Parse Attributes
openingTag = Parse ()
t'
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a. Parse [a] -> Parse [a]
tryParseList' (Parse ()
whitespace1 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. ParseDot a => Parse a
parse)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parse ()
whitespace
parseFontTag :: (Attributes -> val -> tag) -> Parse val -> Parse tag
parseFontTag :: forall val tag.
(Attributes -> val -> tag) -> Parse val -> Parse tag
parseFontTag = (forall val tag.
(Attributes -> val -> tag) -> String -> Parse val -> Parse tag
`parseTag` String
"FONT")
parseTagRep :: (tagName -> val -> tag) -> Parse tagName -> Parse val -> Parse tag
parseTagRep :: forall tagName val tag.
(tagName -> val -> tag) -> Parse tagName -> Parse val -> Parse tag
parseTagRep tagName -> val -> tag
c Parse tagName
pt Parse val
pv = tagName -> val -> tag
c forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Parse a -> Parse a
parseAngled (Parse tagName
pt forall (p :: * -> *) a b. PolyParse p => p a -> p b -> p a
`discard` Parse ()
whitespace)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parse val
pv
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall a. Parse a -> Parse a
parseAngled (Char -> Parse Char
character Char
'/' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parse tagName
pt forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parse ()
whitespace)
forall (p :: * -> *) a. Commitment p => p a -> ShowS -> p a
`adjustErr`
(String
"Can't parse attribute-less Html tag\n\t"forall a. [a] -> [a] -> [a]
++)
parseEmptyTag :: (Attributes -> tag) -> String -> Parse tag
parseEmptyTag :: forall tag. (Attributes -> tag) -> String -> Parse tag
parseEmptyTag Attributes -> tag
c String
t = Attributes -> tag
c forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Parse a -> Parse a
parseAngled
( String -> Parse ()
string String
t
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a. Parse [a] -> Parse [a]
tryParseList' (Parse ()
whitespace1 forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a. ParseDot a => Parse a
parse)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parse ()
whitespace
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parse Char
character Char
'/'
)
forall (p :: * -> *) a. Commitment p => p a -> ShowS -> p a
`adjustErr`
((String
"Can't parse empty Html tag: " forall a. [a] -> [a] -> [a]
++ String
t forall a. [a] -> [a] -> [a]
++ String
"\n\t")forall a. [a] -> [a] -> [a]
++)