module Ondim.Targets.HTML.Instances where

import Data.Bitraversable (bimapM)
import Data.Map qualified as Map
import Data.Set qualified as Set
import Data.Text qualified as T
import Data.Typeable (eqT, (:~:) (..))
import Lucid qualified as T
import Lucid.Base qualified as L
import Lucid.Html5 qualified as L
import Ondim
import Ondim.Advanced
import Ondim.Targets.Whiskers (WAttribute, WNode (Textual), parseWhiskers, renderWhiskers)
import Text.XML qualified as X
import Data.Char (isSpace)
import Data.Foldable (foldrM)

newtype HtmlDocument = HtmlDocument {HtmlDocument -> HtmlElement
documentRoot :: HtmlElement}
  deriving (HtmlDocument -> HtmlDocument -> Bool
(HtmlDocument -> HtmlDocument -> Bool)
-> (HtmlDocument -> HtmlDocument -> Bool) -> Eq HtmlDocument
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: HtmlDocument -> HtmlDocument -> Bool
== :: HtmlDocument -> HtmlDocument -> Bool
$c/= :: HtmlDocument -> HtmlDocument -> Bool
/= :: HtmlDocument -> HtmlDocument -> Bool
Eq, Eq HtmlDocument
Eq HtmlDocument =>
(HtmlDocument -> HtmlDocument -> Ordering)
-> (HtmlDocument -> HtmlDocument -> Bool)
-> (HtmlDocument -> HtmlDocument -> Bool)
-> (HtmlDocument -> HtmlDocument -> Bool)
-> (HtmlDocument -> HtmlDocument -> Bool)
-> (HtmlDocument -> HtmlDocument -> HtmlDocument)
-> (HtmlDocument -> HtmlDocument -> HtmlDocument)
-> Ord HtmlDocument
HtmlDocument -> HtmlDocument -> Bool
HtmlDocument -> HtmlDocument -> Ordering
HtmlDocument -> HtmlDocument -> HtmlDocument
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 :: HtmlDocument -> HtmlDocument -> Ordering
compare :: HtmlDocument -> HtmlDocument -> Ordering
$c< :: HtmlDocument -> HtmlDocument -> Bool
< :: HtmlDocument -> HtmlDocument -> Bool
$c<= :: HtmlDocument -> HtmlDocument -> Bool
<= :: HtmlDocument -> HtmlDocument -> Bool
$c> :: HtmlDocument -> HtmlDocument -> Bool
> :: HtmlDocument -> HtmlDocument -> Bool
$c>= :: HtmlDocument -> HtmlDocument -> Bool
>= :: HtmlDocument -> HtmlDocument -> Bool
$cmax :: HtmlDocument -> HtmlDocument -> HtmlDocument
max :: HtmlDocument -> HtmlDocument -> HtmlDocument
$cmin :: HtmlDocument -> HtmlDocument -> HtmlDocument
min :: HtmlDocument -> HtmlDocument -> HtmlDocument
Ord, Int -> HtmlDocument -> ShowS
[HtmlDocument] -> ShowS
HtmlDocument -> String
(Int -> HtmlDocument -> ShowS)
-> (HtmlDocument -> String)
-> ([HtmlDocument] -> ShowS)
-> Show HtmlDocument
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HtmlDocument -> ShowS
showsPrec :: Int -> HtmlDocument -> ShowS
$cshow :: HtmlDocument -> String
show :: HtmlDocument -> String
$cshowList :: [HtmlDocument] -> ShowS
showList :: [HtmlDocument] -> ShowS
Show, (forall x. HtmlDocument -> Rep HtmlDocument x)
-> (forall x. Rep HtmlDocument x -> HtmlDocument)
-> Generic HtmlDocument
forall x. Rep HtmlDocument x -> HtmlDocument
forall x. HtmlDocument -> Rep HtmlDocument x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. HtmlDocument -> Rep HtmlDocument x
from :: forall x. HtmlDocument -> Rep HtmlDocument x
$cto :: forall x. Rep HtmlDocument x -> HtmlDocument
to :: forall x. Rep HtmlDocument x -> HtmlDocument
Generic)
  deriving anyclass (HtmlDocument -> ()
(HtmlDocument -> ()) -> NFData HtmlDocument
forall a. (a -> ()) -> NFData a
$crnf :: HtmlDocument -> ()
rnf :: HtmlDocument -> ()
NFData)

toHtmlDocument :: X.Document -> Either String HtmlDocument
toHtmlDocument :: Document -> Either String HtmlDocument
toHtmlDocument = (HtmlElement -> HtmlDocument)
-> Either String HtmlElement -> Either String HtmlDocument
forall a b. (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HtmlElement -> HtmlDocument
HtmlDocument (Either String HtmlElement -> Either String HtmlDocument)
-> (Document -> Either String HtmlElement)
-> Document
-> Either String HtmlDocument
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> Either String HtmlElement
toHtmlElement (Element -> Either String HtmlElement)
-> (Document -> Element) -> Document -> Either String HtmlElement
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Document -> Element
X.documentRoot

instance L.ToHtml HtmlDocument where
  toHtml :: forall (m :: * -> *). Monad m => HtmlDocument -> HtmlT m ()
toHtml (HtmlDocument HtmlElement
el) = HtmlT m ()
forall (m :: * -> *). Monad m => HtmlT m ()
L.doctype_ HtmlT m () -> HtmlT m () -> HtmlT m ()
forall a. Semigroup a => a -> a -> a
<> HtmlElement -> HtmlT m ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
forall (m :: * -> *). Monad m => HtmlElement -> HtmlT m ()
L.toHtml HtmlElement
el
  toHtmlRaw :: forall (m :: * -> *). Monad m => HtmlDocument -> HtmlT m ()
toHtmlRaw = HtmlDocument -> HtmlT m ()
forall a. Monoid a => a
mempty

instance Expansible HtmlDocument where
  expandSubs :: forall s. HtmlDocument -> Ondim s HtmlDocument
expandSubs (HtmlDocument HtmlElement
e) = HtmlElement -> HtmlDocument
HtmlDocument (HtmlElement -> HtmlDocument)
-> Ondim s HtmlElement -> Ondim s HtmlDocument
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HtmlElement -> Ondim s HtmlElement
forall t s. Expansible t => t -> Ondim s t
forall s. HtmlElement -> Ondim s HtmlElement
expandSubs HtmlElement
e

instance OndimNode HtmlDocument where
  renderNode :: Maybe (HtmlDocument -> LByteString)
renderNode = (HtmlDocument -> LByteString)
-> Maybe (HtmlDocument -> LByteString)
forall a. a -> Maybe a
Just ((HtmlDocument -> LByteString)
 -> Maybe (HtmlDocument -> LByteString))
-> (HtmlDocument -> LByteString)
-> Maybe (HtmlDocument -> LByteString)
forall a b. (a -> b) -> a -> b
$ Html () -> LByteString
forall a. Html a -> LByteString
L.renderBS (Html () -> LByteString)
-> (HtmlDocument -> Html ()) -> HtmlDocument -> LByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HtmlDocument -> Html ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
forall (m :: * -> *). Monad m => HtmlDocument -> HtmlT m ()
L.toHtml

data HtmlElement = HtmlElement
  { HtmlElement -> Bool
preNewline :: !Bool,
    HtmlElement -> [WNode]
elementTag :: ![WNode],
    HtmlElement -> [WAttribute]
elementAttrs :: ![WAttribute],
    HtmlElement -> [HtmlNode]
elementChildren :: ![HtmlNode]
  }
  deriving (HtmlElement -> HtmlElement -> Bool
(HtmlElement -> HtmlElement -> Bool)
-> (HtmlElement -> HtmlElement -> Bool) -> Eq HtmlElement
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: HtmlElement -> HtmlElement -> Bool
== :: HtmlElement -> HtmlElement -> Bool
$c/= :: HtmlElement -> HtmlElement -> Bool
/= :: HtmlElement -> HtmlElement -> Bool
Eq, Eq HtmlElement
Eq HtmlElement =>
(HtmlElement -> HtmlElement -> Ordering)
-> (HtmlElement -> HtmlElement -> Bool)
-> (HtmlElement -> HtmlElement -> Bool)
-> (HtmlElement -> HtmlElement -> Bool)
-> (HtmlElement -> HtmlElement -> Bool)
-> (HtmlElement -> HtmlElement -> HtmlElement)
-> (HtmlElement -> HtmlElement -> HtmlElement)
-> Ord HtmlElement
HtmlElement -> HtmlElement -> Bool
HtmlElement -> HtmlElement -> Ordering
HtmlElement -> HtmlElement -> HtmlElement
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 :: HtmlElement -> HtmlElement -> Ordering
compare :: HtmlElement -> HtmlElement -> Ordering
$c< :: HtmlElement -> HtmlElement -> Bool
< :: HtmlElement -> HtmlElement -> Bool
$c<= :: HtmlElement -> HtmlElement -> Bool
<= :: HtmlElement -> HtmlElement -> Bool
$c> :: HtmlElement -> HtmlElement -> Bool
> :: HtmlElement -> HtmlElement -> Bool
$c>= :: HtmlElement -> HtmlElement -> Bool
>= :: HtmlElement -> HtmlElement -> Bool
$cmax :: HtmlElement -> HtmlElement -> HtmlElement
max :: HtmlElement -> HtmlElement -> HtmlElement
$cmin :: HtmlElement -> HtmlElement -> HtmlElement
min :: HtmlElement -> HtmlElement -> HtmlElement
Ord, Int -> HtmlElement -> ShowS
[HtmlElement] -> ShowS
HtmlElement -> String
(Int -> HtmlElement -> ShowS)
-> (HtmlElement -> String)
-> ([HtmlElement] -> ShowS)
-> Show HtmlElement
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HtmlElement -> ShowS
showsPrec :: Int -> HtmlElement -> ShowS
$cshow :: HtmlElement -> String
show :: HtmlElement -> String
$cshowList :: [HtmlElement] -> ShowS
showList :: [HtmlElement] -> ShowS
Show, (forall x. HtmlElement -> Rep HtmlElement x)
-> (forall x. Rep HtmlElement x -> HtmlElement)
-> Generic HtmlElement
forall x. Rep HtmlElement x -> HtmlElement
forall x. HtmlElement -> Rep HtmlElement x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. HtmlElement -> Rep HtmlElement x
from :: forall x. HtmlElement -> Rep HtmlElement x
$cto :: forall x. Rep HtmlElement x -> HtmlElement
to :: forall x. Rep HtmlElement x -> HtmlElement
Generic, HtmlElement -> ()
(HtmlElement -> ()) -> NFData HtmlElement
forall a. (a -> ()) -> NFData a
$crnf :: HtmlElement -> ()
rnf :: HtmlElement -> ()
NFData)

instance Expansible HtmlElement where
  expandSubs :: forall s. HtmlElement -> Ondim s HtmlElement
expandSubs (HtmlElement Bool
nl [WNode]
t [WAttribute]
a [HtmlNode]
c) = Bool -> [WNode] -> [WAttribute] -> [HtmlNode] -> HtmlElement
HtmlElement Bool
nl [WNode]
t ([WAttribute] -> [HtmlNode] -> HtmlElement)
-> Ondim s [WAttribute] -> Ondim s ([HtmlNode] -> HtmlElement)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [WAttribute] -> Ondim s [WAttribute]
forall s. [WAttribute] -> Ondim s [WAttribute]
forall t s. Expansible t => t -> Ondim s t
expandSubs [WAttribute]
a Ondim s ([HtmlNode] -> HtmlElement)
-> Ondim s [HtmlNode] -> Ondim s HtmlElement
forall a b. Ondim s (a -> b) -> Ondim s a -> Ondim s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [HtmlNode] -> Ondim s [HtmlNode]
forall s. [HtmlNode] -> Ondim s [HtmlNode]
forall t s. Expansible t => t -> Ondim s t
expandSubs [HtmlNode]
c

-- | Convert from XML nodes to @HtmlNode@
toHtmlNodes :: [X.Node] -> Either String [HtmlNode]
toHtmlNodes :: [Node] -> Either String [HtmlNode]
toHtmlNodes = (Node -> [HtmlNode] -> Either String [HtmlNode])
-> [HtmlNode] -> [Node] -> Either String [HtmlNode]
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> b -> m b) -> b -> t a -> m b
foldrM Node -> [HtmlNode] -> Either String [HtmlNode]
go [] ([Node] -> Either String [HtmlNode])
-> ([Node] -> [Node]) -> [Node] -> Either String [HtmlNode]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Node -> Bool) -> [Node] -> [Node]
forall a. (a -> Bool) -> [a] -> [a]
filter Node -> Bool
notEmpty
  where
    notEmpty :: Node -> Bool
notEmpty (X.NodeContent Text
"") = Bool
False
    notEmpty Node
_ = Bool
True
  
    go :: Node -> [HtmlNode] -> Either String [HtmlNode]
go (X.NodeContent Text
t) []
      | (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isSpace Text
t, (Char -> Bool) -> Text -> Bool
T.any (Char
'\n' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==) Text
t = [HtmlNode] -> Either String [HtmlNode]
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return []
    go (X.NodeContent Text
t) (Element HtmlElement
el : [HtmlNode]
xs)
      | (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isSpace Text
t, (Char -> Bool) -> Text -> Bool
T.any (Char
'\n' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==) Text
t = [HtmlNode] -> Either String [HtmlNode]
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return ([HtmlNode] -> Either String [HtmlNode])
-> [HtmlNode] -> Either String [HtmlNode]
forall a b. (a -> b) -> a -> b
$ HtmlElement -> HtmlNode
Element HtmlElement
el {preNewline = True} HtmlNode -> [HtmlNode] -> [HtmlNode]
forall a. a -> [a] -> [a]
: [HtmlNode]
xs
    go (X.NodeContent Text
t) (TextNode [WNode]
t' : [HtmlNode]
xs) = do
      p <- Text -> Either String [WNode]
parse Text
t
      return $ TextNode (p <> t') : xs
    go (X.NodeContent Text
t) [HtmlNode]
l = do
      p <- Text -> Either String [WNode]
parse Text
t
      return $ TextNode p : l
    go (X.NodeElement Element
el) [HtmlNode]
xs = do
      el' <- Element -> Either String HtmlElement
toHtmlElement Element
el
      return $ Element el' : xs
    go X.NodeComment {} [HtmlNode]
xs = [HtmlNode] -> Either String [HtmlNode]
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return [HtmlNode]
xs
    go X.NodeInstruction {} [HtmlNode]
xs = [HtmlNode] -> Either String [HtmlNode]
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return [HtmlNode]
xs
    parse :: Text -> Either String [WNode]
parse = Attribute -> String -> Text -> Either String [WNode]
parseWhiskers (Text
"${", Text
"}") String
""

toHtmlElement :: X.Element -> Either String HtmlElement
toHtmlElement :: Element -> Either String HtmlElement
toHtmlElement (X.Element Name
name Map Name Text
attrs [Node]
nodes) =
  Bool -> [WNode] -> [WAttribute] -> [HtmlNode] -> HtmlElement
HtmlElement Bool
False
    ([WNode] -> [WAttribute] -> [HtmlNode] -> HtmlElement)
-> Either String [WNode]
-> Either String ([WAttribute] -> [HtmlNode] -> HtmlElement)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Either String [WNode]
parse (Name -> Text
X.nameLocalName Name
name)
    Either String ([WAttribute] -> [HtmlNode] -> HtmlElement)
-> Either String [WAttribute]
-> Either String ([HtmlNode] -> HtmlElement)
forall a b.
Either String (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((Name, Text) -> Either String WAttribute)
-> [(Name, Text)] -> Either String [WAttribute]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((Name -> Either String Text)
-> (Text -> Either String [WNode])
-> (Name, Text)
-> Either String WAttribute
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bimapM (Text -> Either String Text
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Either String Text)
-> (Name -> Text) -> Name -> Either String Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Text
X.nameLocalName) Text -> Either String [WNode]
parse) (Map Name Text -> [(Name, Text)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Name Text
attrs)
    Either String ([HtmlNode] -> HtmlElement)
-> Either String [HtmlNode] -> Either String HtmlElement
forall a b.
Either String (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Node] -> Either String [HtmlNode]
toHtmlNodes [Node]
nodes
  where
    parse :: Text -> Either String [WNode]
parse = Attribute -> String -> Text -> Either String [WNode]
parseWhiskers (Text
"${", Text
"}") String
""

voidElems :: Set.Set Text
voidElems :: Set Text
voidElems = [Text] -> Set Text
forall a. Eq a => [a] -> Set a
Set.fromAscList ([Text] -> Set Text) -> [Text] -> Set Text
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
T.words Text
"area base br col command embed hr img input keygen link meta param source track wbr"

instance L.ToHtml HtmlElement where
  toHtml :: forall (m :: * -> *). Monad m => HtmlElement -> HtmlT m ()
toHtml (HtmlElement Bool
nl ([WNode] -> Text
forall (t :: * -> *). Foldable t => t WNode -> Text
renderWhiskers -> Text
name) [WAttribute]
attrs [HtmlNode]
child)
    | Bool
nl = HtmlT m ()
"\n" HtmlT m () -> HtmlT m () -> HtmlT m ()
forall a. Semigroup a => a -> a -> a
<> HtmlT m () -> [Attribute] -> HtmlT m ()
forall a. With a => a -> [Attribute] -> a
L.with HtmlT m ()
elm [Attribute]
attrs'
    | Bool
otherwise = HtmlT m () -> [Attribute] -> HtmlT m ()
forall a. With a => a -> [Attribute] -> a
L.with HtmlT m ()
elm [Attribute]
attrs'
    where
      attrs' :: [Attribute]
attrs' =
        (WAttribute -> Attribute) -> [WAttribute] -> [Attribute]
forall a b. (a -> b) -> [a] -> [b]
map ((Text -> Text -> Attribute) -> Attribute -> Attribute
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Text -> Text -> Attribute
L.makeAttribute (Attribute -> Attribute)
-> (WAttribute -> Attribute) -> WAttribute -> Attribute
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([WNode] -> Text) -> WAttribute -> Attribute
forall a b. (a -> b) -> (Text, a) -> (Text, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [WNode] -> Text
forall (t :: * -> *). Foldable t => t WNode -> Text
renderWhiskers) [WAttribute]
attrs
      childHtml :: HtmlT m ()
childHtml =
        if Text
name Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"script" Bool -> Bool -> Bool
|| Text
name Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"style"
          then [HtmlNode] -> HtmlT m ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
forall (m :: * -> *). Monad m => [HtmlNode] -> HtmlT m ()
L.toHtmlRaw [HtmlNode]
child
          else [HtmlNode] -> HtmlT m ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
forall (m :: * -> *). Monad m => [HtmlNode] -> HtmlT m ()
L.toHtml [HtmlNode]
child
      elm :: HtmlT m ()
elm =
        if Text
name Text -> Set Text -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Text
voidElems
          then Text -> HtmlT m ()
forall (m :: * -> *). Monad m => Text -> HtmlT m ()
L.makeElementNoEnd Text
name
          else Text -> HtmlT m () -> HtmlT m ()
forall (m :: * -> *) a. Monad m => Text -> HtmlT m a -> HtmlT m a
L.makeElement Text
name HtmlT m ()
childHtml
  toHtmlRaw :: forall (m :: * -> *). Monad m => HtmlElement -> HtmlT m ()
toHtmlRaw = HtmlElement -> HtmlT m ()
forall a. Monoid a => a
mempty

instance OndimNode HtmlElement where
  renderNode :: Maybe (HtmlElement -> LByteString)
renderNode = (HtmlElement -> LByteString) -> Maybe (HtmlElement -> LByteString)
forall a. a -> Maybe a
Just ((HtmlElement -> LByteString)
 -> Maybe (HtmlElement -> LByteString))
-> (HtmlElement -> LByteString)
-> Maybe (HtmlElement -> LByteString)
forall a b. (a -> b) -> a -> b
$ Html () -> LByteString
forall a. Html a -> LByteString
L.renderBS (Html () -> LByteString)
-> (HtmlElement -> Html ()) -> HtmlElement -> LByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HtmlElement -> Html ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
forall (m :: * -> *). Monad m => HtmlElement -> HtmlT m ()
L.toHtml

data HtmlNode
  = Element !HtmlElement
  | TextNode ![WNode]
  | RawNode !Text
  deriving (HtmlNode -> HtmlNode -> Bool
(HtmlNode -> HtmlNode -> Bool)
-> (HtmlNode -> HtmlNode -> Bool) -> Eq HtmlNode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: HtmlNode -> HtmlNode -> Bool
== :: HtmlNode -> HtmlNode -> Bool
$c/= :: HtmlNode -> HtmlNode -> Bool
/= :: HtmlNode -> HtmlNode -> Bool
Eq, Eq HtmlNode
Eq HtmlNode =>
(HtmlNode -> HtmlNode -> Ordering)
-> (HtmlNode -> HtmlNode -> Bool)
-> (HtmlNode -> HtmlNode -> Bool)
-> (HtmlNode -> HtmlNode -> Bool)
-> (HtmlNode -> HtmlNode -> Bool)
-> (HtmlNode -> HtmlNode -> HtmlNode)
-> (HtmlNode -> HtmlNode -> HtmlNode)
-> Ord HtmlNode
HtmlNode -> HtmlNode -> Bool
HtmlNode -> HtmlNode -> Ordering
HtmlNode -> HtmlNode -> HtmlNode
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 :: HtmlNode -> HtmlNode -> Ordering
compare :: HtmlNode -> HtmlNode -> Ordering
$c< :: HtmlNode -> HtmlNode -> Bool
< :: HtmlNode -> HtmlNode -> Bool
$c<= :: HtmlNode -> HtmlNode -> Bool
<= :: HtmlNode -> HtmlNode -> Bool
$c> :: HtmlNode -> HtmlNode -> Bool
> :: HtmlNode -> HtmlNode -> Bool
$c>= :: HtmlNode -> HtmlNode -> Bool
>= :: HtmlNode -> HtmlNode -> Bool
$cmax :: HtmlNode -> HtmlNode -> HtmlNode
max :: HtmlNode -> HtmlNode -> HtmlNode
$cmin :: HtmlNode -> HtmlNode -> HtmlNode
min :: HtmlNode -> HtmlNode -> HtmlNode
Ord, Int -> HtmlNode -> ShowS
[HtmlNode] -> ShowS
HtmlNode -> String
(Int -> HtmlNode -> ShowS)
-> (HtmlNode -> String) -> ([HtmlNode] -> ShowS) -> Show HtmlNode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HtmlNode -> ShowS
showsPrec :: Int -> HtmlNode -> ShowS
$cshow :: HtmlNode -> String
show :: HtmlNode -> String
$cshowList :: [HtmlNode] -> ShowS
showList :: [HtmlNode] -> ShowS
Show, (forall x. HtmlNode -> Rep HtmlNode x)
-> (forall x. Rep HtmlNode x -> HtmlNode) -> Generic HtmlNode
forall x. Rep HtmlNode x -> HtmlNode
forall x. HtmlNode -> Rep HtmlNode x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. HtmlNode -> Rep HtmlNode x
from :: forall x. HtmlNode -> Rep HtmlNode x
$cto :: forall x. Rep HtmlNode x -> HtmlNode
to :: forall x. Rep HtmlNode x -> HtmlNode
Generic, HtmlNode -> ()
(HtmlNode -> ()) -> NFData HtmlNode
forall a. (a -> ()) -> NFData a
$crnf :: HtmlNode -> ()
rnf :: HtmlNode -> ()
NFData)

instance L.ToHtml HtmlNode where
  toHtml :: forall (m :: * -> *). Monad m => HtmlNode -> HtmlT m ()
toHtml (Element HtmlElement
el) = HtmlElement -> HtmlT m ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
forall (m :: * -> *). Monad m => HtmlElement -> HtmlT m ()
L.toHtml HtmlElement
el
  toHtml (TextNode [WNode]
t) = Text -> HtmlT m ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
forall (m :: * -> *). Monad m => Text -> HtmlT m ()
L.toHtml (Text -> HtmlT m ()) -> Text -> HtmlT m ()
forall a b. (a -> b) -> a -> b
$ [WNode] -> Text
forall (t :: * -> *). Foldable t => t WNode -> Text
renderWhiskers [WNode]
t
  toHtml (RawNode Text
t) = Text -> HtmlT m ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
forall (m :: * -> *). Monad m => Text -> HtmlT m ()
L.toHtmlRaw Text
t
  toHtmlRaw :: forall (m :: * -> *). Monad m => HtmlNode -> HtmlT m ()
toHtmlRaw Element {} = HtmlT m ()
forall a. Monoid a => a
mempty
  toHtmlRaw (TextNode [WNode]
t) = Text -> HtmlT m ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
forall (m :: * -> *). Monad m => Text -> HtmlT m ()
T.toHtmlRaw (Text -> HtmlT m ()) -> Text -> HtmlT m ()
forall a b. (a -> b) -> a -> b
$ [WNode] -> Text
forall (t :: * -> *). Foldable t => t WNode -> Text
renderWhiskers [WNode]
t
  toHtmlRaw (RawNode Text
t) = Text -> HtmlT m ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
forall (m :: * -> *). Monad m => Text -> HtmlT m ()
T.toHtmlRaw Text
t

instance L.ToHtml [HtmlNode] where
  toHtml :: forall (m :: * -> *). Monad m => [HtmlNode] -> HtmlT m ()
toHtml = (HtmlNode -> HtmlT m ()) -> [HtmlNode] -> HtmlT m ()
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap' HtmlNode -> HtmlT m ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
forall (m :: * -> *). Monad m => HtmlNode -> HtmlT m ()
L.toHtml
  toHtmlRaw :: forall (m :: * -> *). Monad m => [HtmlNode] -> HtmlT m ()
toHtmlRaw = (HtmlNode -> HtmlT m ()) -> [HtmlNode] -> HtmlT m ()
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap' HtmlNode -> HtmlT m ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
forall (m :: * -> *). Monad m => HtmlNode -> HtmlT m ()
L.toHtmlRaw

instance Expansible HtmlNode where
  expandSubs :: forall s. HtmlNode -> Ondim s HtmlNode
expandSubs = \case
    Element HtmlElement
e -> HtmlElement -> HtmlNode
Element (HtmlElement -> HtmlNode)
-> Ondim s HtmlElement -> Ondim s HtmlNode
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HtmlElement -> Ondim s HtmlElement
forall t s. Expansible t => t -> Ondim s t
forall s. HtmlElement -> Ondim s HtmlElement
expandSubs HtmlElement
e
    TextNode [WNode]
t -> [WNode] -> HtmlNode
TextNode ([WNode] -> HtmlNode) -> Ondim s [WNode] -> Ondim s HtmlNode
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [WNode] -> Ondim s [WNode]
forall s. [WNode] -> Ondim s [WNode]
forall t s. Expansible t => t -> Ondim s t
expandSubs [WNode]
t
    n :: HtmlNode
n@RawNode {} -> HtmlNode -> Ondim s HtmlNode
forall a. a -> Ondim s a
forall (m :: * -> *) a. Monad m => a -> m a
return HtmlNode
n

instance OndimNode HtmlNode where
  identify :: HtmlNode -> Maybe Text
identify (Element (HtmlElement Bool
_ ([WNode] -> Text
forall (t :: * -> *). Foldable t => t WNode -> Text
renderWhiskers -> Text
name) [WAttribute]
_ [HtmlNode]
_)) =
    Text -> Text -> Maybe Text
T.stripPrefix Text
"e:" Text
name
  identify HtmlNode
_ = Maybe Text
forall a. Maybe a
Nothing
  children :: HtmlNode -> [HtmlNode]
children = \case
    Element (HtmlElement {elementChildren :: HtmlElement -> [HtmlNode]
elementChildren = [HtmlNode]
c}) -> [HtmlNode]
c
    HtmlNode
_ -> []
  attributes :: forall s. HtmlNode -> Ondim s [Attribute]
attributes = \case
    Element (HtmlElement {elementAttrs :: HtmlElement -> [WAttribute]
elementAttrs = [WAttribute]
attrs}) -> do
      [WAttribute]
-> (WAttribute -> Ondim s Attribute) -> Ondim s [Attribute]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [WAttribute]
attrs \(Text
k, [WNode]
v) -> do
        v' <- [WNode] -> Ondim s [WNode]
forall s. [WNode] -> Ondim s [WNode]
forall t s. Expansible t => t -> Ondim s t
expandSubs [WNode]
v
        return (k, renderWhiskers v')
    HtmlNode
_ -> [Attribute] -> Ondim s [Attribute]
forall a. a -> Ondim s a
forall (m :: * -> *) a. Monad m => a -> m a
return []
  castFrom :: forall t. (Typeable t) => Maybe (t -> [HtmlNode])
  castFrom :: forall t. Typeable t => Maybe (t -> [HtmlNode])
castFrom
    | Just t :~: Text
Refl <- forall {k} (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
forall a b. (Typeable a, Typeable b) => Maybe (a :~: b)
eqT @t @Text = (t -> [HtmlNode]) -> Maybe (t -> [HtmlNode])
forall a. a -> Maybe a
Just ((t -> [HtmlNode]) -> Maybe (t -> [HtmlNode]))
-> (t -> [HtmlNode]) -> Maybe (t -> [HtmlNode])
forall a b. (a -> b) -> a -> b
$ OneItem [HtmlNode] -> [HtmlNode]
HtmlNode -> [HtmlNode]
forall x. One x => OneItem x -> x
one (HtmlNode -> [HtmlNode]) -> (t -> HtmlNode) -> t -> [HtmlNode]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [WNode] -> HtmlNode
TextNode ([WNode] -> HtmlNode) -> (t -> [WNode]) -> t -> HtmlNode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WNode -> [WNode]
OneItem [WNode] -> [WNode]
forall x. One x => OneItem x -> x
one (WNode -> [WNode]) -> (t -> WNode) -> t -> [WNode]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> WNode
Text -> WNode
Textual
    | Just t :~: HtmlDocument
Refl <- forall {k} (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
forall a b. (Typeable a, Typeable b) => Maybe (a :~: b)
eqT @t @HtmlDocument = (t -> [HtmlNode]) -> Maybe (t -> [HtmlNode])
forall a. a -> Maybe a
Just ((t -> [HtmlNode]) -> Maybe (t -> [HtmlNode]))
-> (t -> [HtmlNode]) -> Maybe (t -> [HtmlNode])
forall a b. (a -> b) -> a -> b
$ HtmlElement -> [HtmlNode]
elementChildren (HtmlElement -> [HtmlNode])
-> (t -> HtmlElement) -> t -> [HtmlNode]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> HtmlElement
HtmlDocument -> HtmlElement
documentRoot
    | Bool
otherwise = Maybe (t -> [HtmlNode])
forall a. Maybe a
Nothing
  nodeAsText :: Maybe (HtmlNode -> Text)
nodeAsText = (HtmlNode -> Text) -> Maybe (HtmlNode -> Text)
forall a. a -> Maybe a
Just ((HtmlNode -> Text) -> Maybe (HtmlNode -> Text))
-> (HtmlNode -> Text) -> Maybe (HtmlNode -> Text)
forall a b. (a -> b) -> a -> b
$ Text -> Text
forall l s. LazyStrict l s => l -> s
toStrict (Text -> Text) -> (HtmlNode -> Text) -> HtmlNode -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Html () -> Text
forall a. Html a -> Text
L.renderText (Html () -> Text) -> (HtmlNode -> Html ()) -> HtmlNode -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HtmlNode -> Html ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
forall (m :: * -> *). Monad m => HtmlNode -> HtmlT m ()
L.toHtml
  renderNode :: Maybe (HtmlNode -> LByteString)
renderNode = (HtmlNode -> LByteString) -> Maybe (HtmlNode -> LByteString)
forall a. a -> Maybe a
Just ((HtmlNode -> LByteString) -> Maybe (HtmlNode -> LByteString))
-> (HtmlNode -> LByteString) -> Maybe (HtmlNode -> LByteString)
forall a b. (a -> b) -> a -> b
$ Html () -> LByteString
forall a. Html a -> LByteString
L.renderBS (Html () -> LByteString)
-> (HtmlNode -> Html ()) -> HtmlNode -> LByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HtmlNode -> Html ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
forall (m :: * -> *). Monad m => HtmlNode -> HtmlT m ()
L.toHtml