{-# LANGUAGE LambdaCase #-}
module Text.Seonbi.Html.Tag
    ( HtmlTag (..)
    , HtmlTagKind (..)
    , headingLevel
    , headingTag
    , headingTag'
    , htmlTagKind
    , htmlTagName
    , htmlTagNames
    , htmlTags
    ) where

import Data.Maybe
import Data.Map.Strict
import Data.Set
import Data.Text

-- $setup
-- >>> import Control.Applicative
-- >>> import Test.QuickCheck
-- >>> import Test.QuickCheck.Gen
-- >>> :{
-- instance Arbitrary HtmlTag where
--     arbitrary = elements $ Data.Set.toList htmlTags
-- :}

-- | The six [kinds of HTML elements
-- ](https://www.w3.org/TR/html5/syntax.html#writing-html-documents-elements).
data HtmlTagKind
    = Void
    | Template'
    | RawText
    | EscapableRawText
    | Foreign
    | Normal
    deriving (HtmlTagKind -> HtmlTagKind -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HtmlTagKind -> HtmlTagKind -> Bool
$c/= :: HtmlTagKind -> HtmlTagKind -> Bool
== :: HtmlTagKind -> HtmlTagKind -> Bool
$c== :: HtmlTagKind -> HtmlTagKind -> Bool
Eq, Eq HtmlTagKind
HtmlTagKind -> HtmlTagKind -> Bool
HtmlTagKind -> HtmlTagKind -> Ordering
HtmlTagKind -> HtmlTagKind -> HtmlTagKind
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 :: HtmlTagKind -> HtmlTagKind -> HtmlTagKind
$cmin :: HtmlTagKind -> HtmlTagKind -> HtmlTagKind
max :: HtmlTagKind -> HtmlTagKind -> HtmlTagKind
$cmax :: HtmlTagKind -> HtmlTagKind -> HtmlTagKind
>= :: HtmlTagKind -> HtmlTagKind -> Bool
$c>= :: HtmlTagKind -> HtmlTagKind -> Bool
> :: HtmlTagKind -> HtmlTagKind -> Bool
$c> :: HtmlTagKind -> HtmlTagKind -> Bool
<= :: HtmlTagKind -> HtmlTagKind -> Bool
$c<= :: HtmlTagKind -> HtmlTagKind -> Bool
< :: HtmlTagKind -> HtmlTagKind -> Bool
$c< :: HtmlTagKind -> HtmlTagKind -> Bool
compare :: HtmlTagKind -> HtmlTagKind -> Ordering
$ccompare :: HtmlTagKind -> HtmlTagKind -> Ordering
Ord, Int -> HtmlTagKind -> ShowS
[HtmlTagKind] -> ShowS
HtmlTagKind -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HtmlTagKind] -> ShowS
$cshowList :: [HtmlTagKind] -> ShowS
show :: HtmlTagKind -> String
$cshow :: HtmlTagKind -> String
showsPrec :: Int -> HtmlTagKind -> ShowS
$cshowsPrec :: Int -> HtmlTagKind -> ShowS
Show)

-- | HTML tags.  This enumeration type contains both HTML 5 and 4 tags for
-- maximum compatibility.
data HtmlTag
    -- CHECK: When a new tag is added, add it into the list of htmlTags (see
    -- below).
    = A
    | Abbr
    | Acronym
    | Address
    | Area
    | Article
    | Aside
    | Audio
    | B
    | Base
    | Bdi
    | Bdo
    | Big
    | BlockQuote
    | Body
    | BR
    | Button
    | Canvas
    | Caption
    | Center
    | Cite
    | Code
    | Col
    | ColGroup
    | Data
    | DataList
    | DD
    | Del
    | Details
    | Dfn
    | Dialog
    | Div
    | DL
    | DT
    | Em
    | Embed
    | FieldSet
    | FigCaption
    | Figure
    | Footer
    | Font
    | Form
    | H1
    | H2
    | H3
    | H4
    | H5
    | H6
    | Head
    | Header
    | HR
    | Html
    | I
    | IFrame
    | Img
    | Input
    | Ins
    | Kbd
    | Label
    | Legend
    | LI
    | Link
    | Main
    | Map
    | Mark
    | Meta
    | Meter
    | Nav
    | NoBR
    | NoScript
    | Object
    | OL
    | OptGroup
    | Option
    | Output
    | P
    | Param
    | Picture
    | Pre
    | Progress
    | Q
    | RB
    | RP
    | RT
    | RTC
    | Ruby
    | S
    | Samp
    | Script
    | Select
    | Section
    | Small
    | Source
    | Span
    | Strike
    | Strong
    | Style
    | Sub
    | Summary
    | Sup
    | Table
    | TBody
    | TD
    | Template
    | TFoot
    | TextArea
    | TH
    | THead
    | Time
    | Title
    | TR
    | Track
    | TT
    | U
    | UL
    | Var
    | Video
    | WBR
    | XMP
    deriving (HtmlTag -> HtmlTag -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HtmlTag -> HtmlTag -> Bool
$c/= :: HtmlTag -> HtmlTag -> Bool
== :: HtmlTag -> HtmlTag -> Bool
$c== :: HtmlTag -> HtmlTag -> Bool
Eq, Eq HtmlTag
HtmlTag -> HtmlTag -> Bool
HtmlTag -> HtmlTag -> Ordering
HtmlTag -> HtmlTag -> HtmlTag
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 :: HtmlTag -> HtmlTag -> HtmlTag
$cmin :: HtmlTag -> HtmlTag -> HtmlTag
max :: HtmlTag -> HtmlTag -> HtmlTag
$cmax :: HtmlTag -> HtmlTag -> HtmlTag
>= :: HtmlTag -> HtmlTag -> Bool
$c>= :: HtmlTag -> HtmlTag -> Bool
> :: HtmlTag -> HtmlTag -> Bool
$c> :: HtmlTag -> HtmlTag -> Bool
<= :: HtmlTag -> HtmlTag -> Bool
$c<= :: HtmlTag -> HtmlTag -> Bool
< :: HtmlTag -> HtmlTag -> Bool
$c< :: HtmlTag -> HtmlTag -> Bool
compare :: HtmlTag -> HtmlTag -> Ordering
$ccompare :: HtmlTag -> HtmlTag -> Ordering
Ord, Int -> HtmlTag -> ShowS
[HtmlTag] -> ShowS
HtmlTag -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HtmlTag] -> ShowS
$cshowList :: [HtmlTag] -> ShowS
show :: HtmlTag -> String
$cshow :: HtmlTag -> String
showsPrec :: Int -> HtmlTag -> ShowS
$cshowsPrec :: Int -> HtmlTag -> ShowS
Show)

-- | List all supported HTML tags.
--
-- >>> htmlTags
-- fromList [A,Abbr,Acronym,Address,...,UL,Var,Video,WBR,XMP]
htmlTags :: Set HtmlTag
htmlTags :: Set HtmlTag
htmlTags = forall a. Ord a => [a] -> Set a
Data.Set.fromList
    [ HtmlTag
A, HtmlTag
Abbr, HtmlTag
Acronym, HtmlTag
Address, HtmlTag
Area, HtmlTag
Article, HtmlTag
Aside, HtmlTag
Audio
    , HtmlTag
B, HtmlTag
Base, HtmlTag
Bdi, HtmlTag
Bdo, HtmlTag
Big, HtmlTag
BlockQuote, HtmlTag
Body, HtmlTag
BR, HtmlTag
Button
    , HtmlTag
Canvas, HtmlTag
Caption, HtmlTag
Center, HtmlTag
Cite, HtmlTag
Code, HtmlTag
Col, HtmlTag
ColGroup
    , HtmlTag
Data, HtmlTag
DataList, HtmlTag
DD, HtmlTag
Del, HtmlTag
Details, HtmlTag
Dfn, HtmlTag
Dialog, HtmlTag
Div, HtmlTag
DL, HtmlTag
DT
    , HtmlTag
Em, HtmlTag
Embed
    , HtmlTag
FieldSet, HtmlTag
FigCaption, HtmlTag
Figure, HtmlTag
Font, HtmlTag
Footer, HtmlTag
Form
    , HtmlTag
H1, HtmlTag
H2, HtmlTag
H3, HtmlTag
H4, HtmlTag
H5, HtmlTag
H6, HtmlTag
Head, HtmlTag
Header, HtmlTag
HR, HtmlTag
Html
    , HtmlTag
I, HtmlTag
IFrame, HtmlTag
Img, HtmlTag
Input, HtmlTag
Ins
    , HtmlTag
Kbd
    , HtmlTag
Label, HtmlTag
Legend, HtmlTag
LI, HtmlTag
Link
    , HtmlTag
Main, HtmlTag
Map, HtmlTag
Mark, HtmlTag
Meta, HtmlTag
Meter
    , HtmlTag
Nav, HtmlTag
NoBR, HtmlTag
NoScript
    , HtmlTag
Object, HtmlTag
OL, HtmlTag
OptGroup, HtmlTag
Option, HtmlTag
Output
    , HtmlTag
P, HtmlTag
Param, HtmlTag
Picture, HtmlTag
Pre, HtmlTag
Progress
    , HtmlTag
Q
    , HtmlTag
RB, HtmlTag
RP, HtmlTag
RT, HtmlTag
RTC, HtmlTag
Ruby
    , HtmlTag
S, HtmlTag
Samp, HtmlTag
Script, HtmlTag
Select, HtmlTag
Section, HtmlTag
Small, HtmlTag
Source
    , HtmlTag
Span, HtmlTag
Strike, HtmlTag
Strong, HtmlTag
Style, HtmlTag
Sub, HtmlTag
Summary, HtmlTag
Sup
    , HtmlTag
Table, HtmlTag
TBody, HtmlTag
TD, HtmlTag
Template, HtmlTag
TFoot, HtmlTag
TextArea
    , HtmlTag
TH, HtmlTag
THead, HtmlTag
Time, HtmlTag
Title, HtmlTag
TR, HtmlTag
Track, HtmlTag
TT
    , HtmlTag
U, HtmlTag
UL
    , HtmlTag
Var, HtmlTag
Video
    , HtmlTag
WBR
    , HtmlTag
XMP
    ]

-- | The name of an 'HtmlTag' in lowercase.
--
-- >>> htmlTagName TextArea
-- "textarea"
--
-- prop> \ t -> htmlTagName t == (toLower $ pack $ show (t :: HtmlTag))
htmlTagName :: HtmlTag -> Text
htmlTagName :: HtmlTag -> Text
htmlTagName = Text -> Text
toLower forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show

-- | The map of tag names to 'HtmlTag' values.
--
-- >>> :set -XOverloadedStrings
-- >>> Data.Map.Strict.lookup "blockquote" htmlTagNames
-- Just BlockQuote
--
-- prop> \ t -> Data.Map.Strict.lookup (htmlTagName t) htmlTagNames == Just t
htmlTagNames :: Map Text HtmlTag
htmlTagNames :: Map Text HtmlTag
htmlTagNames =
    forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.Strict.fromList
        [(HtmlTag -> Text
htmlTagName HtmlTag
t, HtmlTag
t) | HtmlTag
t <- forall a. Set a -> [a]
Data.Set.toList Set HtmlTag
htmlTags]

-- | The kind of an 'HtmlTag'.
--
-- >>> Data.Set.filter ((== EscapableRawText) . htmlTagKind) htmlTags
-- fromList [TextArea,Title]
htmlTagKind :: HtmlTag -> HtmlTagKind
htmlTagKind :: HtmlTag -> HtmlTagKind
htmlTagKind = \ case
    HtmlTag
A -> HtmlTagKind
Normal
    HtmlTag
Abbr -> HtmlTagKind
Normal
    HtmlTag
Acronym -> HtmlTagKind
Normal
    HtmlTag
Address -> HtmlTagKind
Normal
    HtmlTag
Area -> HtmlTagKind
Void
    HtmlTag
Article -> HtmlTagKind
Normal
    HtmlTag
Aside -> HtmlTagKind
Normal
    HtmlTag
Audio -> HtmlTagKind
Normal
    HtmlTag
B -> HtmlTagKind
Normal
    HtmlTag
Base -> HtmlTagKind
Void
    HtmlTag
Bdi -> HtmlTagKind
Normal
    HtmlTag
Bdo -> HtmlTagKind
Normal
    HtmlTag
Big -> HtmlTagKind
Normal
    HtmlTag
BlockQuote -> HtmlTagKind
Normal
    HtmlTag
Body -> HtmlTagKind
Normal
    HtmlTag
BR -> HtmlTagKind
Void
    HtmlTag
Button -> HtmlTagKind
Normal
    HtmlTag
Canvas -> HtmlTagKind
Foreign
    HtmlTag
Caption -> HtmlTagKind
Normal
    HtmlTag
Center -> HtmlTagKind
Normal
    HtmlTag
Cite -> HtmlTagKind
Normal
    HtmlTag
Code -> HtmlTagKind
Normal
    HtmlTag
Col -> HtmlTagKind
Void
    HtmlTag
ColGroup -> HtmlTagKind
Normal
    HtmlTag
Data -> HtmlTagKind
Normal
    HtmlTag
DataList -> HtmlTagKind
Normal
    HtmlTag
DD -> HtmlTagKind
Normal
    HtmlTag
Del -> HtmlTagKind
Normal
    HtmlTag
Details -> HtmlTagKind
Normal
    HtmlTag
Dfn -> HtmlTagKind
Normal
    HtmlTag
Dialog -> HtmlTagKind
Normal
    HtmlTag
Div -> HtmlTagKind
Normal
    HtmlTag
DL -> HtmlTagKind
Normal
    HtmlTag
DT -> HtmlTagKind
Normal
    HtmlTag
Em -> HtmlTagKind
Normal
    HtmlTag
Embed -> HtmlTagKind
Void
    HtmlTag
FieldSet -> HtmlTagKind
Normal
    HtmlTag
FigCaption -> HtmlTagKind
Normal
    HtmlTag
Figure -> HtmlTagKind
Normal
    HtmlTag
Font -> HtmlTagKind
Normal
    HtmlTag
Footer -> HtmlTagKind
Normal
    HtmlTag
Form -> HtmlTagKind
Normal
    HtmlTag
H1 -> HtmlTagKind
Normal
    HtmlTag
H2 -> HtmlTagKind
Normal
    HtmlTag
H3 -> HtmlTagKind
Normal
    HtmlTag
H4 -> HtmlTagKind
Normal
    HtmlTag
H5 -> HtmlTagKind
Normal
    HtmlTag
H6 -> HtmlTagKind
Normal
    HtmlTag
Head -> HtmlTagKind
Normal
    HtmlTag
Header -> HtmlTagKind
Normal
    HtmlTag
HR -> HtmlTagKind
Void
    HtmlTag
Html -> HtmlTagKind
Normal
    HtmlTag
I -> HtmlTagKind
Normal
    HtmlTag
IFrame -> HtmlTagKind
Normal
    HtmlTag
Img -> HtmlTagKind
Void
    HtmlTag
Input -> HtmlTagKind
Void
    HtmlTag
Ins -> HtmlTagKind
Normal
    HtmlTag
Kbd -> HtmlTagKind
Normal
    HtmlTag
Label -> HtmlTagKind
Normal
    HtmlTag
Legend -> HtmlTagKind
Normal
    HtmlTag
LI -> HtmlTagKind
Normal
    HtmlTag
Link -> HtmlTagKind
Void
    HtmlTag
Main -> HtmlTagKind
Normal
    HtmlTag
Map -> HtmlTagKind
Normal
    HtmlTag
Mark -> HtmlTagKind
Normal
    HtmlTag
Meta -> HtmlTagKind
Void
    HtmlTag
Meter -> HtmlTagKind
Normal
    HtmlTag
Nav -> HtmlTagKind
Normal
    HtmlTag
NoBR -> HtmlTagKind
Normal
    HtmlTag
NoScript -> HtmlTagKind
Normal
    HtmlTag
Object -> HtmlTagKind
Normal
    HtmlTag
OL -> HtmlTagKind
Normal
    HtmlTag
OptGroup -> HtmlTagKind
Normal
    HtmlTag
Option -> HtmlTagKind
Normal
    HtmlTag
Output -> HtmlTagKind
Normal
    HtmlTag
P -> HtmlTagKind
Normal
    HtmlTag
Param -> HtmlTagKind
Void
    HtmlTag
Picture -> HtmlTagKind
Normal
    HtmlTag
Pre -> HtmlTagKind
Normal
    HtmlTag
Progress -> HtmlTagKind
Normal
    HtmlTag
Q -> HtmlTagKind
Normal
    HtmlTag
RB -> HtmlTagKind
Normal
    HtmlTag
RP -> HtmlTagKind
Normal
    HtmlTag
RT -> HtmlTagKind
Normal
    HtmlTag
RTC -> HtmlTagKind
Normal
    HtmlTag
Ruby -> HtmlTagKind
Normal
    HtmlTag
S -> HtmlTagKind
Normal
    HtmlTag
Samp -> HtmlTagKind
Normal
    HtmlTag
Script -> HtmlTagKind
RawText
    HtmlTag
Select -> HtmlTagKind
Normal
    HtmlTag
Section -> HtmlTagKind
Normal
    HtmlTag
Small -> HtmlTagKind
Normal
    HtmlTag
Source -> HtmlTagKind
Void
    HtmlTag
Span -> HtmlTagKind
Normal
    HtmlTag
Strike -> HtmlTagKind
Normal
    HtmlTag
Strong -> HtmlTagKind
Normal
    HtmlTag
Style -> HtmlTagKind
RawText
    HtmlTag
Sub -> HtmlTagKind
Normal
    HtmlTag
Summary -> HtmlTagKind
Normal
    HtmlTag
Sup -> HtmlTagKind
Normal
    HtmlTag
Table -> HtmlTagKind
Normal
    HtmlTag
TBody -> HtmlTagKind
Normal
    HtmlTag
TD -> HtmlTagKind
Normal
    HtmlTag
Template -> HtmlTagKind
Template'
    HtmlTag
TFoot -> HtmlTagKind
Normal
    HtmlTag
TextArea -> HtmlTagKind
EscapableRawText
    HtmlTag
TH -> HtmlTagKind
Normal
    HtmlTag
THead -> HtmlTagKind
Normal
    HtmlTag
Time -> HtmlTagKind
Normal
    HtmlTag
Title -> HtmlTagKind
EscapableRawText
    HtmlTag
TR -> HtmlTagKind
Normal
    HtmlTag
Track -> HtmlTagKind
Void
    HtmlTag
TT -> HtmlTagKind
Normal
    HtmlTag
U -> HtmlTagKind
Normal
    HtmlTag
UL -> HtmlTagKind
Normal
    HtmlTag
Var -> HtmlTagKind
Normal
    HtmlTag
Video -> HtmlTagKind
Normal
    HtmlTag
WBR -> HtmlTagKind
Void
    HtmlTag
XMP -> HtmlTagKind
RawText

-- | Get the heading level of an 'HtmlTag', if it is a heading tag
-- ('H1' to 'H6').
--
-- >>> headingLevel H1
-- Just 1
-- >>> headingLevel H6
-- Just 6
-- >>> headingLevel P
-- Nothing
headingLevel :: HtmlTag -> Maybe Int
headingLevel :: HtmlTag -> Maybe Int
headingLevel = \ case
    HtmlTag
H1 -> forall a. a -> Maybe a
Just Int
1
    HtmlTag
H2 -> forall a. a -> Maybe a
Just Int
2
    HtmlTag
H3 -> forall a. a -> Maybe a
Just Int
3
    HtmlTag
H4 -> forall a. a -> Maybe a
Just Int
4
    HtmlTag
H5 -> forall a. a -> Maybe a
Just Int
5
    HtmlTag
H6 -> forall a. a -> Maybe a
Just Int
6
    HtmlTag
_ -> forall a. Maybe a
Nothing

-- | Get the heading tag with the given heading level.  If the level is
-- invalid, then 'Nothing' is returned.
--
-- >>> headingTag 1
-- Just H1
-- >>> headingTag 6
-- Just H6
-- >>> headingTag 7
-- Nothing
headingTag :: Int -> Maybe HtmlTag
headingTag :: Int -> Maybe HtmlTag
headingTag = \ case
    Int
1 -> forall a. a -> Maybe a
Just HtmlTag
H1
    Int
2 -> forall a. a -> Maybe a
Just HtmlTag
H2
    Int
3 -> forall a. a -> Maybe a
Just HtmlTag
H3
    Int
4 -> forall a. a -> Maybe a
Just HtmlTag
H4
    Int
5 -> forall a. a -> Maybe a
Just HtmlTag
H5
    Int
6 -> forall a. a -> Maybe a
Just HtmlTag
H6
    Int
_ -> forall a. Maybe a
Nothing

-- | Get the heading tag with the given heading level.  If the level is
-- greater than 6, then 'H6' is returned.  If the level is less than 1,
-- then 'H1' is returned.
--
-- >>> headingTag' 1
-- H1
-- >>> headingTag' 6
-- H6
-- >>> headingTag' 0
-- H1
-- >>> headingTag' 7
-- H6
headingTag' :: Int -> HtmlTag
headingTag' :: Int -> HtmlTag
headingTag' Int
level =
    forall a. a -> Maybe a -> a
fromMaybe (if Int
level forall a. Ord a => a -> a -> Bool
> Int
6 then HtmlTag
H6 else HtmlTag
H1) forall a b. (a -> b) -> a -> b
$ Int -> Maybe HtmlTag
headingTag Int
level