{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# OPTIONS_GHC -Wno-deferred-out-of-scope-variables #-}

module Web.View.Render where

import Data.ByteString.Lazy qualified as BL
import Data.Function ((&))
import Data.List (foldl', sortOn)
import Data.Map qualified as M
import Data.Maybe (mapMaybe)
import Data.String (fromString)
import Data.String.Interpolate (i)
import Data.Text (Text, intercalate, pack, toLower)
import Data.Text qualified as T
import Data.Text.Lazy qualified as L
import Data.Text.Lazy.Encoding qualified as LE
import HTMLEntities.Text qualified as HE
import Web.View.Types
import Web.View.View (View, ViewState (..), runView)


{- | Renders a 'View' as HTML with embedded CSS class definitions

>>> renderText $ el bold "Hello"
<style type='text/css'>.bold { font-weight:bold }</style>
<div class='bold'>Hello</div>
-}
renderText :: View () () -> Text
renderText :: View () () -> Text
renderText = () -> View () () -> Text
forall c. c -> View c () -> Text
renderText' ()


renderLazyText :: View () () -> L.Text
renderLazyText :: View () () -> Text
renderLazyText = Text -> Text
L.fromStrict (Text -> Text) -> (View () () -> Text) -> View () () -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. View () () -> Text
renderText


renderLazyByteString :: View () () -> BL.ByteString
renderLazyByteString :: View () () -> ByteString
renderLazyByteString = Text -> ByteString
LE.encodeUtf8 (Text -> ByteString)
-> (View () () -> Text) -> View () () -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. View () () -> Text
renderLazyText


data Line
  = Line {Line -> LineEnd
end :: LineEnd, Line -> Int
indent :: Int, Line -> Text
text :: Text}
  deriving (Int -> Line -> ShowS
[Line] -> ShowS
Line -> String
(Int -> Line -> ShowS)
-> (Line -> String) -> ([Line] -> ShowS) -> Show Line
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Line -> ShowS
showsPrec :: Int -> Line -> ShowS
$cshow :: Line -> String
show :: Line -> String
$cshowList :: [Line] -> ShowS
showList :: [Line] -> ShowS
Show, Line -> Line -> Bool
(Line -> Line -> Bool) -> (Line -> Line -> Bool) -> Eq Line
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Line -> Line -> Bool
== :: Line -> Line -> Bool
$c/= :: Line -> Line -> Bool
/= :: Line -> Line -> Bool
Eq)


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


-- | Render lines to text
renderLines :: [Line] -> Text
renderLines :: [Line] -> Text
renderLines = (Bool, Text) -> Text
forall a b. (a, b) -> b
snd ((Bool, Text) -> Text)
-> ([Line] -> (Bool, Text)) -> [Line] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Bool, Text) -> Line -> (Bool, Text))
-> (Bool, Text) -> [Line] -> (Bool, Text)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Bool, Text) -> Line -> (Bool, Text)
nextLine (Bool
False, Text
"")
 where
  nextLine :: (Bool, Text) -> Line -> (Bool, Text)
  nextLine :: (Bool, Text) -> Line -> (Bool, Text)
nextLine (Bool
newline, Text
t) Line
l = (Line -> Bool
forall {r}. HasField "end" r LineEnd => r -> Bool
nextNewline Line
l, Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Bool -> Line -> Text
currentLine Bool
newline Line
l)

  currentLine :: Bool -> Line -> Text
  currentLine :: Bool -> Line -> Text
currentLine Bool
newline Line
l
    | Bool
newline = Text
"\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
spaces Line
l.indent Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Line
l.text
    | Bool
otherwise = Line
l.text

  nextNewline :: r -> Bool
nextNewline r
l = r
l.end LineEnd -> LineEnd -> Bool
forall a. Eq a => a -> a -> Bool
== LineEnd
Newline

  spaces :: Int -> Text
spaces Int
n = Int -> Text -> Text
T.replicate Int
n Text
" "


{- | Render with the specified view context

> renderText' () $ el bold "Hello"
-}
renderText' :: c -> View c () -> Text
renderText' :: forall c. c -> View c () -> Text
renderText' c
c View c ()
vw =
  let vst :: ViewState
vst = c -> View c () -> ViewState
forall context. context -> View context () -> ViewState
runView c
c View c ()
vw
      css :: [Line]
css = CSS -> [Line]
renderCSS ViewState
vst.css
   in [Line] -> Text
renderLines ([Line] -> Text) -> [Line] -> Text
forall a b. (a -> b) -> a -> b
$ [Line] -> [Line] -> [Line]
addCss [Line]
css ([Line] -> [Line]) -> [Line] -> [Line]
forall a b. (a -> b) -> a -> b
$ [[Line]] -> [Line]
forall a. Monoid a => [a] -> a
mconcat ([[Line]] -> [Line]) -> [[Line]] -> [Line]
forall a b. (a -> b) -> a -> b
$ (Content -> [Line]) -> [Content] -> [[Line]]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Content -> [Line]
renderContent Int
2) ViewState
vst.contents
 where
  addCss :: [Line] -> [Line] -> [Line]
  addCss :: [Line] -> [Line] -> [Line]
addCss [] [Line]
cnt = [Line]
cnt
  addCss [Line]
css [Line]
cnt = do
    [Line] -> [Line]
styleLines [Line]
css [Line] -> [Line] -> [Line]
forall a. Semigroup a => a -> a -> a
<> (LineEnd -> Int -> Text -> Line
Line LineEnd
Newline Int
0 Text
"" Line -> [Line] -> [Line]
forall a. a -> [a] -> [a]
: [Line]
cnt)

  styleLines :: [Line] -> [Line]
  styleLines :: [Line] -> [Line]
styleLines [Line]
css =
    [LineEnd -> Int -> Text -> Line
Line LineEnd
Newline Int
0 Text
"<style type='text/css'>"]
      [Line] -> [Line] -> [Line]
forall a. Semigroup a => a -> a -> a
<> [Line]
css
      [Line] -> [Line] -> [Line]
forall a. Semigroup a => a -> a -> a
<> [LineEnd -> Int -> Text -> Line
Line LineEnd
Newline Int
0 Text
"</style>"]


renderContent :: Int -> Content -> [Line]
renderContent :: Int -> Content -> [Line]
renderContent Int
ind (Node Element
t) = Int -> Element -> [Line]
renderTag Int
ind Element
t
renderContent Int
_ (Text Text
t) = [LineEnd -> Int -> Text -> Line
Line LineEnd
Inline Int
0 (Text -> Line) -> Text -> Line
forall a b. (a -> b) -> a -> b
$ Text -> Text
HE.text Text
t]
renderContent Int
_ (Raw Text
t) = [LineEnd -> Int -> Text -> Line
Line LineEnd
Newline Int
0 Text
t]


renderTag :: Int -> Element -> [Line]
renderTag :: Int -> Element -> [Line]
renderTag Int
ind Element
tag =
  case Element
tag.children of
    [] ->
      -- auto closing creates a bug in chrome. An auto-closed div
      -- absorbs the next children
      [Text -> Line
line (Text -> Line) -> Text -> Line
forall a b. (a -> b) -> a -> b
$ Text
open Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FlatAttributes -> Text
htmlAtts (Element -> FlatAttributes
flatAttributes Element
tag) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
">" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
close]
    -- single text node
    [Text Text
t] ->
      -- SINGLE text node, just display it indented
      [Text -> Line
line (Text -> Line) -> Text -> Line
forall a b. (a -> b) -> a -> b
$ Text
open Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FlatAttributes -> Text
htmlAtts (Element -> FlatAttributes
flatAttributes Element
tag) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
">" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
HE.text Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
close]
    [Content]
_ ->
      [[Line]] -> [Line]
forall a. Monoid a => [a] -> a
mconcat
        [ [Text -> Line
line (Text -> Line) -> Text -> Line
forall a b. (a -> b) -> a -> b
$ Text
open Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FlatAttributes -> Text
htmlAtts (Element -> FlatAttributes
flatAttributes Element
tag) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
">"]
        , (Line -> Line) -> [Line] -> [Line]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Line -> Line
addIndent Int
ind) ([Line] -> [Line]) -> [Line] -> [Line]
forall a b. (a -> b) -> a -> b
$ [Content] -> [Line]
htmlChildren Element
tag.children
        , [Text -> Line
line Text
close]
        ]
 where
  open :: Text
open = Text
"<" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Element
tag.name
  close :: Text
close = Text
"</" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Element
tag.name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
">"

  line :: Text -> Line
line Text
t =
    if Element
tag.inline
      then LineEnd -> Int -> Text -> Line
Line LineEnd
Inline Int
0 Text
t
      else LineEnd -> Int -> Text -> Line
Line LineEnd
Newline Int
0 Text
t

  htmlChildren :: [Content] -> [Line]
  htmlChildren :: [Content] -> [Line]
htmlChildren [Content]
cts =
    [[Line]] -> [Line]
forall a. Monoid a => [a] -> a
mconcat ([[Line]] -> [Line]) -> [[Line]] -> [Line]
forall a b. (a -> b) -> a -> b
$
      (Content -> [Line]) -> [Content] -> [[Line]]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Content -> [Line]
renderContent Int
ind) [Content]
cts

  htmlAtts :: FlatAttributes -> Text
  htmlAtts :: FlatAttributes -> Text
htmlAtts (FlatAttributes []) = Text
""
  htmlAtts (FlatAttributes Map Text Text
as) =
    Text
" "
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
T.unwords (((Text, Text) -> Text) -> [(Text, Text)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Text) -> Text
htmlAtt ([(Text, Text)] -> [Text]) -> [(Text, Text)] -> [Text]
forall a b. (a -> b) -> a -> b
$ Map Text Text -> [(Text, Text)]
forall k a. Map k a -> [(k, a)]
M.toList Map Text Text
as)
   where
    htmlAtt :: (Text, Text) -> Text
htmlAtt (Text
k, Text
v) =
      Text
k Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"'" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
HE.text Text
v Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"'"


addIndent :: Int -> Line -> Line
addIndent :: Int -> Line -> Line
addIndent Int
n (Line LineEnd
e Int
ind Text
t) = LineEnd -> Int -> Text -> Line
Line LineEnd
e (Int
ind Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n) Text
t


renderCSS :: CSS -> [Line]
renderCSS :: CSS -> [Line]
renderCSS = (Class -> Maybe Line) -> CSS -> [Line]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Class -> Maybe Line
renderClass (CSS -> [Line]) -> (CSS -> CSS) -> CSS -> [Line]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Class -> Selector) -> CSS -> CSS
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (.selector)
 where
  renderClass :: Class -> Maybe Line
  renderClass :: Class -> Maybe Line
renderClass Class
c | Map Text StyleValue -> Bool
forall k a. Map k a -> Bool
M.null Class
c.properties = Maybe Line
forall a. Maybe a
Nothing
  renderClass Class
c =
    let sel :: Text
sel = Selector -> Text
selectorText Class
c.selector
        props :: Text
props = Text -> [Text] -> Text
intercalate Text
"; " (((Text, StyleValue) -> Text) -> [(Text, StyleValue)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text, StyleValue) -> Text
renderProp ([(Text, StyleValue)] -> [Text]) -> [(Text, StyleValue)] -> [Text]
forall a b. (a -> b) -> a -> b
$ Map Text StyleValue -> [(Text, StyleValue)]
forall k a. Map k a -> [(k, a)]
M.toList Class
c.properties)
     in Line -> Maybe Line
forall a. a -> Maybe a
Just (Line -> Maybe Line) -> Line -> Maybe Line
forall a b. (a -> b) -> a -> b
$ LineEnd -> Int -> Text -> Line
Line LineEnd
Newline Int
0 (Text -> Line) -> Text -> Line
forall a b. (a -> b) -> a -> b
$ [i|#{sel} { #{props} }|] Text -> (Text -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Maybe Media -> Text -> Text
forall {src}.
(Interpolatable (IsCustomSink src) src src,
 Interpolatable (IsCustomSink src) Text src) =>
Maybe Media -> src -> src
addMedia Class
c.selector.media

  addMedia :: Maybe Media -> src -> src
addMedia Maybe Media
Nothing src
css = src
css
  addMedia (Just Media
m) src
css =
    let mc :: Text
mc = Media -> Text
mediaCriteria Media
m
     in [i|@media #{mc} { #{css} }|]

  mediaCriteria :: Media -> Text
  mediaCriteria :: Media -> Text
mediaCriteria (MinWidth Int
n) = [i|(min-width: #{n}px)|]
  mediaCriteria (MaxWidth Int
n) = [i|(max-width: #{n}px)|]

  renderProp :: (Text, StyleValue) -> Text
  renderProp :: (Text, StyleValue) -> Text
renderProp (Text
p, StyleValue
cv) = Text
p Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> StyleValue -> Text
renderStyle StyleValue
cv

  renderStyle :: StyleValue -> Text
  renderStyle :: StyleValue -> Text
renderStyle (StyleValue String
v) = String -> Text
pack String
v


indent :: Text -> Text
indent :: Text -> Text
indent Text
t = Text
"  " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t


-- | The css selector for this style
selectorText :: Selector -> Text
selectorText :: Selector -> Text
selectorText Selector
s =
  let classAttributeName :: Text
classAttributeName = Text -> Text
HE.text (Selector -> ClassName
attributeClassName Selector
s).text
   in Maybe Text -> Text
ancestor Selector
s.ancestor Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Maybe Pseudo -> Text -> Text
addPseudo Selector
s.pseudo Text
classAttributeName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Maybe ChildCombinator -> Text
child Selector
s.child
 where
  ancestor :: Maybe Text -> Text
ancestor Maybe Text
Nothing = Text
""
  ancestor (Just Text
p) = Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
HE.text Text
p Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" "

  -- ":" is treated as a pseudo selector. We want to use prefixed pseudos in the name as part of the name
  -- so we must escape the colon
  addPseudo :: Maybe Pseudo -> Text -> Text
addPseudo Maybe Pseudo
Nothing Text
c = Text
c
  addPseudo (Just Pseudo
p) Text
c =
    HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
":" Text
"\\:" Text
c Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Pseudo -> Text
pseudoSuffix Pseudo
p

  child :: Maybe ChildCombinator -> Text
child Maybe ChildCombinator
Nothing = Text
""
  child (Just (ChildWithName Text
c)) =
    Text
" > ." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
HE.text Text
c
  child (Just ChildCombinator
AllChildren) =
    Text
" > *"

  pseudoSuffix :: Pseudo -> Text
  pseudoSuffix :: Pseudo -> Text
pseudoSuffix Pseudo
Even = Text
"nth-child(even)"
  pseudoSuffix Pseudo
Odd = Text
"nth-child(odd)"
  pseudoSuffix Pseudo
p = Pseudo -> Text
pseudoText Pseudo
p


-- | Unique name for the class, as seen in the element's class attribute
attributeClassName :: Selector -> ClassName
attributeClassName :: Selector -> ClassName
attributeClassName Selector
sel =
  Maybe Media -> ClassName -> ClassName
addMedia Selector
sel.media (ClassName -> ClassName)
-> (ClassName -> ClassName) -> ClassName -> ClassName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Pseudo -> ClassName -> ClassName
addPseudo Selector
sel.pseudo (ClassName -> ClassName)
-> (ClassName -> ClassName) -> ClassName -> ClassName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Text -> ClassName -> ClassName
addAncestor Selector
sel.ancestor (ClassName -> ClassName)
-> (ClassName -> ClassName) -> ClassName -> ClassName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe ChildCombinator -> ClassName -> ClassName
addChild Selector
sel.child (ClassName -> ClassName) -> ClassName -> ClassName
forall a b. (a -> b) -> a -> b
$ Selector
sel.className
 where
  addAncestor :: Maybe Ancestor -> ClassName -> ClassName
  addAncestor :: Maybe Text -> ClassName -> ClassName
addAncestor Maybe Text
Nothing ClassName
cn = ClassName
cn
  addAncestor (Just Text
a) ClassName
cn = Text -> ClassName
className Text
a ClassName -> ClassName -> ClassName
forall a. Semigroup a => a -> a -> a
<> ClassName
"-" ClassName -> ClassName -> ClassName
forall a. Semigroup a => a -> a -> a
<> ClassName
cn

  addChild :: Maybe ChildCombinator -> ClassName -> ClassName
  addChild :: Maybe ChildCombinator -> ClassName -> ClassName
addChild Maybe ChildCombinator
Nothing ClassName
cn = ClassName
cn
  addChild (Just (ChildWithName Text
child)) ClassName
cn = ClassName
cn ClassName -> ClassName -> ClassName
forall a. Semigroup a => a -> a -> a
<> ClassName
"-" ClassName -> ClassName -> ClassName
forall a. Semigroup a => a -> a -> a
<> Text -> ClassName
className Text
child
  addChild (Just ChildCombinator
AllChildren) ClassName
cn = ClassName
cn ClassName -> ClassName -> ClassName
forall a. Semigroup a => a -> a -> a
<> ClassName
"-all"

  addPseudo :: Maybe Pseudo -> ClassName -> ClassName
  addPseudo :: Maybe Pseudo -> ClassName -> ClassName
addPseudo Maybe Pseudo
Nothing ClassName
cn = ClassName
cn
  addPseudo (Just Pseudo
p) ClassName
cn =
    Text -> ClassName
className (Pseudo -> Text
pseudoText Pseudo
p) ClassName -> ClassName -> ClassName
forall a. Semigroup a => a -> a -> a
<> ClassName
":" ClassName -> ClassName -> ClassName
forall a. Semigroup a => a -> a -> a
<> ClassName
cn

  addMedia :: Maybe Media -> ClassName -> ClassName
  addMedia :: Maybe Media -> ClassName -> ClassName
addMedia Maybe Media
Nothing ClassName
cn = ClassName
cn
  addMedia (Just (MinWidth Int
n)) ClassName
cn =
    ClassName
"mmnw" ClassName -> ClassName -> ClassName
forall a. Semigroup a => a -> a -> a
<> String -> ClassName
forall a. IsString a => String -> a
fromString (Int -> String
forall a. Show a => a -> String
show Int
n) ClassName -> ClassName -> ClassName
forall a. Semigroup a => a -> a -> a
<> ClassName
"-" ClassName -> ClassName -> ClassName
forall a. Semigroup a => a -> a -> a
<> ClassName
cn
  addMedia (Just (MaxWidth Int
n)) ClassName
cn =
    ClassName
"mmxw" ClassName -> ClassName -> ClassName
forall a. Semigroup a => a -> a -> a
<> String -> ClassName
forall a. IsString a => String -> a
fromString (Int -> String
forall a. Show a => a -> String
show Int
n) ClassName -> ClassName -> ClassName
forall a. Semigroup a => a -> a -> a
<> ClassName
"-" ClassName -> ClassName -> ClassName
forall a. Semigroup a => a -> a -> a
<> ClassName
cn


-- classNameAddAncestor :: Ancestor -> ClassName -> ClassName
-- classNameAddAncestor a cn =
--   ClassName a <> "-" <> cn
--
--
-- classNameAddChild :: ChildCombinator -> ClassName -> ClassName
-- classNameAddChild cc cn =
--   case cc of
--     ChildWithName child -> cn <> "-" <> ClassName child
--     AllChildren -> cn <> "-all"
--
-- classNameAddPseudo :: Pseudo -> ClassName -> ClassName
-- classNameAddPseudo p cn =
--     className (pseudoText p) <> ":" <> cn
--

pseudoText :: Pseudo -> Text
pseudoText :: Pseudo -> Text
pseudoText Pseudo
p = Text -> Text
toLower (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Pseudo -> String
forall a. Show a => a -> String
show Pseudo
p


-- | The 'Web.View.Types.Attributes' for an element, inclusive of class.
flatAttributes :: Element -> FlatAttributes
flatAttributes :: Element -> FlatAttributes
flatAttributes Element
t =
  Map Text Text -> FlatAttributes
FlatAttributes (Map Text Text -> FlatAttributes)
-> Map Text Text -> FlatAttributes
forall a b. (a -> b) -> a -> b
$
    CSS -> Map Text Text -> Map Text Text
forall {k}. (Ord k, IsString k) => CSS -> Map k Text -> Map k Text
addClass Element
t.attributes.classes Element
t.attributes.other
 where
  addClass :: CSS -> Map k Text -> Map k Text
addClass [] Map k Text
atts = Map k Text
atts
  addClass CSS
cx Map k Text
atts = k -> Text -> Map k Text -> Map k Text
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert k
"class" (CSS -> Text
classAttValue CSS
cx) Map k Text
atts

  classAttValue :: [Class] -> Text
  classAttValue :: CSS -> Text
classAttValue CSS
cx =
    [Text] -> Text
T.unwords ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Class -> Text) -> CSS -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((.text) (ClassName -> Text) -> (Class -> ClassName) -> Class -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Selector -> ClassName
attributeClassName (Selector -> ClassName)
-> (Class -> Selector) -> Class -> ClassName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.selector)) CSS
cx