{-# LANGUAGE OverloadedStrings #-}

{- | Add XStaticFile to Html document.

@
indexHtml :: Html ()
indexHtml = do
    doctypehtml_ do
        head_ do
            meta_ [charset_ "utf-8"]
            meta_ [name_ "viewport", content_ "width=device-width, initial-scale=1.0"]
            xstaticScripts xfiles
  where
    xfiles = XStatic.htmx : XStatic.xterm
@
-}
module Lucid.XStatic (xstaticScripts) where

import Data.Foldable (traverse_)
import Data.Text.Encoding
import Lucid
import XStatic

-- | Adds 'script_' and 'link_' for javascript and css files.
xstaticScripts :: [XStaticFile] -> Html ()
xstaticScripts :: [XStaticFile] -> Html ()
xstaticScripts = forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ XStaticFile -> Html ()
xrender
  where
    xrender :: XStaticFile -> Html ()
    xrender :: XStaticFile -> Html ()
xrender XStaticFile
xf =
        let src :: Text
src = Text
"/xstatic" forall a. Semigroup a => a -> a -> a
<> ByteString -> Text
decodeUtf8 (XStaticFile -> ByteString
xfPath XStaticFile
xf) forall a. Semigroup a => a -> a -> a
<> Text
"?v=" forall a. Semigroup a => a -> a -> a
<> ByteString -> Text
decodeUtf8 (XStaticFile -> ByteString
xfETag XStaticFile
xf)
         in case XStaticFile -> ByteString
xfType XStaticFile
xf of
                ByteString
"application/javascript" -> forall arg result. TermRaw arg result => arg -> result
script_ [Text -> Attributes
src_ Text
src] (Html ()
"" :: Html ())
                ByteString
"text/css" -> forall (m :: * -> *). Monad m => [Attributes] -> HtmlT m ()
link_ [Text -> Attributes
href_ Text
src, Text -> Attributes
rel_ Text
"stylesheet"]
                ByteString
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()