module Drasil.Data.Formats.HTML.Core
  ( -- * HTML
    HTML(..), HTMLBody(..), HTMLHead(..), TagType(..), CustomTag(..), customTag,
    Format(..), HLevel(..), Row(..), Cell(..), LItem(..), DItem(..), ListType(..),
    Attr(..), bold, emphasis, subscript, superscript, span, figureImage
  )
where

import Data.Char (isAsciiLower, isAsciiUpper, isDigit)
import Data.Text (Text)
import qualified Data.Text as T
import Prelude hiding (span)

-- | HTML Attrs for tags in the format key="value"
data Attr = Attr
  Text -- ^ Key
  Text -- ^ Value
  deriving (Int -> Attr -> ShowS
[Attr] -> ShowS
Attr -> String
(Int -> Attr -> ShowS)
-> (Attr -> String) -> ([Attr] -> ShowS) -> Show Attr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Attr -> ShowS
showsPrec :: Int -> Attr -> ShowS
$cshow :: Attr -> String
show :: Attr -> String
$cshowList :: [Attr] -> ShowS
showList :: [Attr] -> ShowS
Show, Attr -> Attr -> Bool
(Attr -> Attr -> Bool) -> (Attr -> Attr -> Bool) -> Eq Attr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Attr -> Attr -> Bool
== :: Attr -> Attr -> Bool
$c/= :: Attr -> Attr -> Bool
/= :: Attr -> Attr -> Bool
Eq)

data HTML = HTML [HTMLHead] [HTMLBody]
  deriving (Int -> HTML -> ShowS
[HTML] -> ShowS
HTML -> String
(Int -> HTML -> ShowS)
-> (HTML -> String) -> ([HTML] -> ShowS) -> Show HTML
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HTML -> ShowS
showsPrec :: Int -> HTML -> ShowS
$cshow :: HTML -> String
show :: HTML -> String
$cshowList :: [HTML] -> ShowS
showList :: [HTML] -> ShowS
Show, HTML -> HTML -> Bool
(HTML -> HTML -> Bool) -> (HTML -> HTML -> Bool) -> Eq HTML
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: HTML -> HTML -> Bool
== :: HTML -> HTML -> Bool
$c/= :: HTML -> HTML -> Bool
/= :: HTML -> HTML -> Bool
Eq)

-- | Head elements
data HTMLHead
  = Script [Attr] Text
  | Title Text
  | Meta [Attr]
  | Link Relation File [Attr]
  deriving (Int -> HTMLHead -> ShowS
[HTMLHead] -> ShowS
HTMLHead -> String
(Int -> HTMLHead -> ShowS)
-> (HTMLHead -> String) -> ([HTMLHead] -> ShowS) -> Show HTMLHead
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HTMLHead -> ShowS
showsPrec :: Int -> HTMLHead -> ShowS
$cshow :: HTMLHead -> String
show :: HTMLHead -> String
$cshowList :: [HTMLHead] -> ShowS
showList :: [HTMLHead] -> ShowS
Show, HTMLHead -> HTMLHead -> Bool
(HTMLHead -> HTMLHead -> Bool)
-> (HTMLHead -> HTMLHead -> Bool) -> Eq HTMLHead
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: HTMLHead -> HTMLHead -> Bool
== :: HTMLHead -> HTMLHead -> Bool
$c/= :: HTMLHead -> HTMLHead -> Bool
/= :: HTMLHead -> HTMLHead -> Bool
Eq)

-- | Body elements
data HTMLBody
  = Div [Attr] [HTMLBody]
  | Paragraph [Attr] [HTMLBody]
  | TextFormat Format [Attr] [HTMLBody]
  | Heading HLevel [Attr] [HTMLBody]
  | List ListType [Attr] [LItem]
  | Table [Attr] [Row]
  | DescriptionList [Attr] [DItem]
  | Anchor URL [Attr] [HTMLBody]
  | Figure [Attr] [HTMLBody]
  | FigCaption [Attr] [HTMLBody]
  | Img File Text [Attr]
  | RawText Text
  | Custom CustomTag [Attr] [HTMLBody]
  | Comment Text
  deriving (Int -> HTMLBody -> ShowS
[HTMLBody] -> ShowS
HTMLBody -> String
(Int -> HTMLBody -> ShowS)
-> (HTMLBody -> String) -> ([HTMLBody] -> ShowS) -> Show HTMLBody
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HTMLBody -> ShowS
showsPrec :: Int -> HTMLBody -> ShowS
$cshow :: HTMLBody -> String
show :: HTMLBody -> String
$cshowList :: [HTMLBody] -> ShowS
showList :: [HTMLBody] -> ShowS
Show, HTMLBody -> HTMLBody -> Bool
(HTMLBody -> HTMLBody -> Bool)
-> (HTMLBody -> HTMLBody -> Bool) -> Eq HTMLBody
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: HTMLBody -> HTMLBody -> Bool
== :: HTMLBody -> HTMLBody -> Bool
$c/= :: HTMLBody -> HTMLBody -> Bool
/= :: HTMLBody -> HTMLBody -> Bool
Eq)

-- TODO: Support more tags
-- https://www.w3schools.com/tags/default.asp

type Relation = Text

-- | Target link
type URL = Text

-- | File name or file path.
type File = Text

-- | Text format
data Format = Bold | Emphasis | Subscript | Superscript | Span
  deriving (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
$cshowsPrec :: Int -> Format -> ShowS
showsPrec :: Int -> Format -> ShowS
$cshow :: Format -> String
show :: Format -> String
$cshowList :: [Format] -> ShowS
showList :: [Format] -> ShowS
Show, Format -> Format -> Bool
(Format -> Format -> Bool)
-> (Format -> Format -> Bool) -> Eq Format
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Format -> Format -> Bool
== :: Format -> Format -> Bool
$c/= :: Format -> Format -> Bool
/= :: Format -> Format -> Bool
Eq)

-- | Heading level
data HLevel = H1 | H2 | H3 | H4 | H5 | H6
  deriving (Int -> HLevel -> ShowS
[HLevel] -> ShowS
HLevel -> String
(Int -> HLevel -> ShowS)
-> (HLevel -> String) -> ([HLevel] -> ShowS) -> Show HLevel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HLevel -> ShowS
showsPrec :: Int -> HLevel -> ShowS
$cshow :: HLevel -> String
show :: HLevel -> String
$cshowList :: [HLevel] -> ShowS
showList :: [HLevel] -> ShowS
Show, HLevel -> HLevel -> Bool
(HLevel -> HLevel -> Bool)
-> (HLevel -> HLevel -> Bool) -> Eq HLevel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: HLevel -> HLevel -> Bool
== :: HLevel -> HLevel -> Bool
$c/= :: HLevel -> HLevel -> Bool
/= :: HLevel -> HLevel -> Bool
Eq)

-- | List type
data ListType = Ordered | Unordered
  deriving (Int -> ListType -> ShowS
[ListType] -> ShowS
ListType -> String
(Int -> ListType -> ShowS)
-> (ListType -> String) -> ([ListType] -> ShowS) -> Show ListType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ListType -> ShowS
showsPrec :: Int -> ListType -> ShowS
$cshow :: ListType -> String
show :: ListType -> String
$cshowList :: [ListType] -> ShowS
showList :: [ListType] -> ShowS
Show, ListType -> ListType -> Bool
(ListType -> ListType -> Bool)
-> (ListType -> ListType -> Bool) -> Eq ListType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ListType -> ListType -> Bool
== :: ListType -> ListType -> Bool
$c/= :: ListType -> ListType -> Bool
/= :: ListType -> ListType -> Bool
Eq)

-- | Ordered/unordered list structure
data LItem = LItem [Attr] [HTMLBody]
  deriving (Int -> LItem -> ShowS
[LItem] -> ShowS
LItem -> String
(Int -> LItem -> ShowS)
-> (LItem -> String) -> ([LItem] -> ShowS) -> Show LItem
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LItem -> ShowS
showsPrec :: Int -> LItem -> ShowS
$cshow :: LItem -> String
show :: LItem -> String
$cshowList :: [LItem] -> ShowS
showList :: [LItem] -> ShowS
Show, LItem -> LItem -> Bool
(LItem -> LItem -> Bool) -> (LItem -> LItem -> Bool) -> Eq LItem
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LItem -> LItem -> Bool
== :: LItem -> LItem -> Bool
$c/= :: LItem -> LItem -> Bool
/= :: LItem -> LItem -> Bool
Eq)

-- | Description list elements
data DItem
  = DTerm [Attr] [HTMLBody]
  | DDetails [Attr] [HTMLBody]
  deriving (Int -> DItem -> ShowS
[DItem] -> ShowS
DItem -> String
(Int -> DItem -> ShowS)
-> (DItem -> String) -> ([DItem] -> ShowS) -> Show DItem
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DItem -> ShowS
showsPrec :: Int -> DItem -> ShowS
$cshow :: DItem -> String
show :: DItem -> String
$cshowList :: [DItem] -> ShowS
showList :: [DItem] -> ShowS
Show, DItem -> DItem -> Bool
(DItem -> DItem -> Bool) -> (DItem -> DItem -> Bool) -> Eq DItem
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DItem -> DItem -> Bool
== :: DItem -> DItem -> Bool
$c/= :: DItem -> DItem -> Bool
/= :: DItem -> DItem -> Bool
Eq)

-- | Table structure
data Row = Row [Attr] [Cell]
  deriving (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
$cshowsPrec :: Int -> Row -> ShowS
showsPrec :: Int -> Row -> ShowS
$cshow :: Row -> String
show :: Row -> String
$cshowList :: [Row] -> ShowS
showList :: [Row] -> ShowS
Show, Row -> Row -> Bool
(Row -> Row -> Bool) -> (Row -> Row -> Bool) -> Eq Row
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Row -> Row -> Bool
== :: Row -> Row -> Bool
$c/= :: Row -> Row -> Bool
/= :: Row -> Row -> Bool
Eq)

data Cell
  = THeader [Attr] [HTMLBody]
  | TData [Attr] [HTMLBody]
  deriving (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
$cshowsPrec :: Int -> Cell -> ShowS
showsPrec :: Int -> Cell -> ShowS
$cshow :: Cell -> String
show :: Cell -> String
$cshowList :: [Cell] -> ShowS
showList :: [Cell] -> ShowS
Show, Cell -> Cell -> Bool
(Cell -> Cell -> Bool) -> (Cell -> Cell -> Bool) -> Eq Cell
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Cell -> Cell -> Bool
== :: Cell -> Cell -> Bool
$c/= :: Cell -> Cell -> Bool
/= :: Cell -> Cell -> Bool
Eq)

-- | A 'CustomTag' is either (a) an ill-supported HTML-spec. node (ill-supported
-- by 'HTMLBody', that is) or (b) a purely custom one.
newtype CustomTag = CT Text
  deriving (Int -> CustomTag -> ShowS
[CustomTag] -> ShowS
CustomTag -> String
(Int -> CustomTag -> ShowS)
-> (CustomTag -> String)
-> ([CustomTag] -> ShowS)
-> Show CustomTag
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CustomTag -> ShowS
showsPrec :: Int -> CustomTag -> ShowS
$cshow :: CustomTag -> String
show :: CustomTag -> String
$cshowList :: [CustomTag] -> ShowS
showList :: [CustomTag] -> ShowS
Show, CustomTag -> CustomTag -> Bool
(CustomTag -> CustomTag -> Bool)
-> (CustomTag -> CustomTag -> Bool) -> Eq CustomTag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CustomTag -> CustomTag -> Bool
== :: CustomTag -> CustomTag -> Bool
$c/= :: CustomTag -> CustomTag -> Bool
/= :: CustomTag -> CustomTag -> Bool
Eq, Eq CustomTag
Eq CustomTag =>
(CustomTag -> CustomTag -> Ordering)
-> (CustomTag -> CustomTag -> Bool)
-> (CustomTag -> CustomTag -> Bool)
-> (CustomTag -> CustomTag -> Bool)
-> (CustomTag -> CustomTag -> Bool)
-> (CustomTag -> CustomTag -> CustomTag)
-> (CustomTag -> CustomTag -> CustomTag)
-> Ord CustomTag
CustomTag -> CustomTag -> Bool
CustomTag -> CustomTag -> Ordering
CustomTag -> CustomTag -> CustomTag
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
$ccompare :: CustomTag -> CustomTag -> Ordering
compare :: CustomTag -> CustomTag -> Ordering
$c< :: CustomTag -> CustomTag -> Bool
< :: CustomTag -> CustomTag -> Bool
$c<= :: CustomTag -> CustomTag -> Bool
<= :: CustomTag -> CustomTag -> Bool
$c> :: CustomTag -> CustomTag -> Bool
> :: CustomTag -> CustomTag -> Bool
$c>= :: CustomTag -> CustomTag -> Bool
>= :: CustomTag -> CustomTag -> Bool
$cmax :: CustomTag -> CustomTag -> CustomTag
max :: CustomTag -> CustomTag -> CustomTag
$cmin :: CustomTag -> CustomTag -> CustomTag
min :: CustomTag -> CustomTag -> CustomTag
Ord)

data TagType = Standard | Void
  deriving (Int -> TagType -> ShowS
[TagType] -> ShowS
TagType -> String
(Int -> TagType -> ShowS)
-> (TagType -> String) -> ([TagType] -> ShowS) -> Show TagType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TagType -> ShowS
showsPrec :: Int -> TagType -> ShowS
$cshow :: TagType -> String
show :: TagType -> String
$cshowList :: [TagType] -> ShowS
showList :: [TagType] -> ShowS
Show, TagType -> TagType -> Bool
(TagType -> TagType -> Bool)
-> (TagType -> TagType -> Bool) -> Eq TagType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TagType -> TagType -> Bool
== :: TagType -> TagType -> Bool
$c/= :: TagType -> TagType -> Bool
/= :: TagType -> TagType -> Bool
Eq)

-- | Tag names are used within element start tags and end tags to give the
-- element’s name. HTML elements all have names that only use characters in
-- the range 0–9, a–z, and A–Z.
customTag :: Text -> CustomTag
customTag :: Text -> CustomTag
customTag Text
t
  | Text -> Bool
isSanitary Text
t = Text -> CustomTag
CT Text
t
  | Bool
otherwise = String -> CustomTag
forall a. HasCallStack => String -> a
error String
"Bad custom tag name"

isSanitary :: Text -> Bool
isSanitary :: Text -> Bool
isSanitary Text
t = Bool -> Bool
not (Text -> Bool
T.null Text
t) Bool -> Bool -> Bool
&& Char -> Bool
isAsciiLetter (HasCallStack => Text -> Char
Text -> Char
T.head Text
t) Bool -> Bool -> Bool
&& (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isAllowedChar Text
t
  where
    -- The first character must be a letter
    isAsciiLetter :: Char -> Bool
isAsciiLetter Char
c = Char -> Bool
isAsciiLower Char
c Bool -> Bool -> Bool
|| Char -> Bool
isAsciiUpper Char
c
    isAllowedChar :: Char -> Bool
isAllowedChar Char
c = Char -> Bool
isAsciiLetter Char
c Bool -> Bool -> Bool
|| Char -> Bool
isDigit Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-'

-- | Smart Constructors
bold :: [Attr] -> Text -> HTMLBody
bold :: [Attr] -> Text -> HTMLBody
bold [Attr]
attrs Text
txt = Format -> [Attr] -> [HTMLBody] -> HTMLBody
TextFormat Format
Bold [Attr]
attrs [Text -> HTMLBody
RawText Text
txt]

emphasis :: [Attr] -> Text -> HTMLBody
emphasis :: [Attr] -> Text -> HTMLBody
emphasis [Attr]
attrs Text
txt = Format -> [Attr] -> [HTMLBody] -> HTMLBody
TextFormat Format
Emphasis [Attr]
attrs [Text -> HTMLBody
RawText Text
txt]

subscript :: [Attr] -> Text -> HTMLBody
subscript :: [Attr] -> Text -> HTMLBody
subscript [Attr]
attrs Text
txt = Format -> [Attr] -> [HTMLBody] -> HTMLBody
TextFormat Format
Subscript [Attr]
attrs [Text -> HTMLBody
RawText Text
txt]

superscript :: [Attr] -> Text -> HTMLBody
superscript :: [Attr] -> Text -> HTMLBody
superscript [Attr]
attrs Text
txt = Format -> [Attr] -> [HTMLBody] -> HTMLBody
TextFormat Format
Superscript [Attr]
attrs [Text -> HTMLBody
RawText Text
txt]

span :: [Attr] -> Text -> HTMLBody
span :: [Attr] -> Text -> HTMLBody
span [Attr]
attrs Text
txt = Format -> [Attr] -> [HTMLBody] -> HTMLBody
TextFormat Format
Span [Attr]
attrs [Text -> HTMLBody
RawText Text
txt]

-- | Creates a figure containing an image and a caption.
-- The provided attributes are applied to the Figure
figureImage :: [Attr] -> File -> Text -> Text -> HTMLBody
figureImage :: [Attr] -> Text -> Text -> Text -> HTMLBody
figureImage [Attr]
attrs Text
src Text
altText Text
captionTxt =
  [Attr] -> [HTMLBody] -> HTMLBody
Figure [Attr]
attrs [Text -> Text -> [Attr] -> HTMLBody
Img Text
src Text
altText [], [Attr] -> [HTMLBody] -> HTMLBody
FigCaption [] [Text -> HTMLBody
RawText Text
captionTxt]]