{-# LANGUAGE OverloadedStrings #-}

module Language.Ltml.HTML.CSS.Util
    ( -- * Convert CSS Classes to HTML Attributes
      (<#>)
    , cssClass_
    , cssClasses_
    , toCssClasses_

      -- * Wrap HTML Headers and Stylesheets
    , addHtmlHeader
    , addInlineCssHeader
    ) where

import Clay (Css, render)
import Data.Text (pack)
import Data.Text.Lazy (toStrict)
import Language.Ltml.HTML.CSS.Classes
    ( Class
    , ToCssClasses
    , className
    , toCssClasses
    )
import qualified Language.Ltml.HTML.CSS.Classes as Class
import Lucid

-- | Constructs HTML element with given Class
(<#>) :: ([Attributes] -> a) -> Class -> a
[Attributes] -> a
htmlFunc <#> :: forall a. ([Attributes] -> a) -> Class -> a
<#> Class
cssClass = [Attributes] -> a
htmlFunc [StrictText -> Attributes
class_ (Class -> StrictText
className Class
cssClass)]

infixl 9 <#>

-- | Convert CSS Class to Lucid HTML Attribute
cssClass_ :: Class -> Attributes
cssClass_ :: Class -> Attributes
cssClass_ = StrictText -> Attributes
class_ (StrictText -> Attributes)
-> (Class -> StrictText) -> Class -> Attributes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Class -> StrictText
className

-- | Convert List of CSS Classes to List of Lucid HTML Attribute
--   Note: Lucid combines list of class_ attributes so single HTML
--   class attribute.
cssClasses_ :: [Class] -> [Attributes]
cssClasses_ :: [Class] -> [Attributes]
cssClasses_ = (Class -> Attributes) -> [Class] -> [Attributes]
forall a b. (a -> b) -> [a] -> [b]
map (StrictText -> Attributes
class_ (StrictText -> Attributes)
-> (Class -> StrictText) -> Class -> Attributes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Class -> StrictText
className)

-- | Convert 'a' to list of 'Attributes' via 'ToCssClasses' instance.
toCssClasses_ :: (ToCssClasses a) => a -> [Attributes]
toCssClasses_ :: forall a. ToCssClasses a => a -> [Attributes]
toCssClasses_ = [Class] -> [Attributes]
cssClasses_ ([Class] -> [Attributes]) -> (a -> [Class]) -> a -> [Attributes]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [Class]
forall a. ToCssClasses a => a -> [Class]
toCssClasses

-------------------------------------------------------------------------------

-- | Adds html, @<head>@ and @<body>@ tags onto given html and
--   sets title and css path
addHtmlHeader :: (ToHtml title) => title -> FilePath -> Html () -> Html ()
addHtmlHeader :: forall title.
ToHtml title =>
title -> String -> HtmlT Identity () -> HtmlT Identity ()
addHtmlHeader title
title String
cssPath HtmlT Identity ()
html = HtmlT Identity () -> HtmlT Identity ()
forall (m :: * -> *) a. Monad m => HtmlT m a -> HtmlT m a
doctypehtml_ (HtmlT Identity () -> HtmlT Identity ())
-> HtmlT Identity () -> HtmlT Identity ()
forall a b. (a -> b) -> a -> b
$ do
    HtmlT Identity () -> HtmlT Identity ()
forall arg result. Term arg result => arg -> result
head_ (HtmlT Identity () -> HtmlT Identity ())
-> HtmlT Identity () -> HtmlT Identity ()
forall a b. (a -> b) -> a -> b
$ do
        HtmlT Identity () -> HtmlT Identity ()
forall arg result. Term arg result => arg -> result
title_ (title -> HtmlT Identity ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
forall (m :: * -> *). Monad m => title -> HtmlT m ()
toHtml title
title)
        [Attributes] -> HtmlT Identity ()
forall (m :: * -> *). Monad m => [Attributes] -> HtmlT m ()
link_ [StrictText -> Attributes
rel_ StrictText
"stylesheet", StrictText -> Attributes
href_ (String -> StrictText
pack String
cssPath)]
    HtmlT Identity () -> HtmlT Identity ()
forall arg result. Term arg result => arg -> result
body_ (HtmlT Identity () -> HtmlT Identity ())
-> HtmlT Identity () -> HtmlT Identity ()
forall a b. (a -> b) -> a -> b
$ [Attributes] -> HtmlT Identity () -> HtmlT Identity ()
forall arg result. Term arg result => arg -> result
div_ ([Attributes] -> HtmlT Identity () -> HtmlT Identity ())
-> Class -> HtmlT Identity () -> HtmlT Identity ()
forall a. ([Attributes] -> a) -> Class -> a
<#> Class
Class.Body (HtmlT Identity () -> HtmlT Identity ())
-> HtmlT Identity () -> HtmlT Identity ()
forall a b. (a -> b) -> a -> b
$ HtmlT Identity ()
html

-- | Adds html, head and body tags onto given html,
--   adds title, renders and inlines given css;
--   This is used for creating a "preview" HTML;
addInlineCssHeader :: String -> Css -> Html () -> Html ()
addInlineCssHeader :: String -> Css -> HtmlT Identity () -> HtmlT Identity ()
addInlineCssHeader String
title Css
css HtmlT Identity ()
html =
    HtmlT Identity () -> HtmlT Identity ()
forall (m :: * -> *) a. Monad m => HtmlT m a -> HtmlT m a
doctypehtml_ (HtmlT Identity () -> HtmlT Identity ())
-> HtmlT Identity () -> HtmlT Identity ()
forall a b. (a -> b) -> a -> b
$ do
        HtmlT Identity () -> HtmlT Identity ()
forall arg result. Term arg result => arg -> result
head_ (HtmlT Identity () -> HtmlT Identity ())
-> HtmlT Identity () -> HtmlT Identity ()
forall a b. (a -> b) -> a -> b
$ do
            HtmlT Identity () -> HtmlT Identity ()
forall arg result. Term arg result => arg -> result
title_ (String -> HtmlT Identity ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
forall (m :: * -> *). Monad m => String -> HtmlT m ()
toHtml String
title)
            StrictText -> HtmlT Identity ()
forall arg result. TermRaw arg result => arg -> result
style_ (LazyText -> StrictText
toStrict (LazyText -> StrictText) -> LazyText -> StrictText
forall a b. (a -> b) -> a -> b
$ Css -> LazyText
render Css
css)
        HtmlT Identity () -> HtmlT Identity ()
forall arg result. Term arg result => arg -> result
body_ (HtmlT Identity () -> HtmlT Identity ())
-> HtmlT Identity () -> HtmlT Identity ()
forall a b. (a -> b) -> a -> b
$ [Attributes] -> HtmlT Identity () -> HtmlT Identity ()
forall arg result. Term arg result => arg -> result
div_ ([Attributes] -> HtmlT Identity () -> HtmlT Identity ())
-> Class -> HtmlT Identity () -> HtmlT Identity ()
forall a. ([Attributes] -> a) -> Class -> a
<#> Class
Class.Body (HtmlT Identity () -> HtmlT Identity ())
-> HtmlT Identity () -> HtmlT Identity ()
forall a b. (a -> b) -> a -> b
$ HtmlT Identity ()
html