{-# LANGUAGE GADTs #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TypeApplications #-}

-- | Use Tailwind CSS with blaze-html? Try this module for rapid prototyping of
-- websites in Ema.
module Ema.Helper.Blaze
  ( -- * Main functions
    layoutWith,
    twindLayout,

    -- * Tailwind official shims
    tailwind2ShimCdn,

    -- * Twind.dev shims
    twindShimOfficial,
    twindShimUnofficial,
  )
where

import Data.Some (Some (Some))
import qualified Ema.CLI
import NeatInterpolation (text)
import qualified Text.Blaze.Html.Renderer.Utf8 as RU
import Text.Blaze.Html5 ((!))
import qualified Text.Blaze.Html5 as H
import qualified Text.Blaze.Html5.Attributes as A

-- | A general layout
layoutWith :: H.AttributeValue -> H.AttributeValue -> H.Html -> H.Html -> LByteString
layoutWith :: AttributeValue -> AttributeValue -> Html -> Html -> LByteString
layoutWith AttributeValue
lang AttributeValue
encoding Html
appHead Html
appBody = Html -> LByteString
RU.renderHtml (Html -> LByteString) -> Html -> LByteString
forall a b. (a -> b) -> a -> b
$ do
  Html
H.docType
  Html -> Html
H.html (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.lang AttributeValue
lang (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
    Html -> Html
H.head (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
      Html
H.meta Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.charset AttributeValue
encoding
      -- This makes the site mobile friendly by default.
      Html
H.meta Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.name AttributeValue
"viewport" Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.content AttributeValue
"width=device-width, initial-scale=1"
      Html
appHead
    Html
appBody

-- | A simple and off-the-shelf layout using Tailwind CSS
twindLayout :: Some Ema.CLI.Action -> H.Html -> H.Html -> LByteString
twindLayout :: Some Action -> Html -> Html -> LByteString
twindLayout Some Action
action Html
h Html
b =
  AttributeValue -> AttributeValue -> Html -> Html -> LByteString
layoutWith AttributeValue
"en" AttributeValue
"UTF-8" (Html
shim Html -> Html -> Html
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Html
h) (Html -> LByteString) -> Html -> LByteString
forall a b. (a -> b) -> a -> b
$
    -- The "overflow-y-scroll" makes the scrollbar visible always, so as to
    -- avoid janky shifts when switching to routes with suddenly scrollable content.
    Html -> Html
H.body (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"overflow-y-scroll" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html
b
  where
    shim :: H.Html
    shim :: Html
shim =
      case Some Action
action of
        Some (Ema.CLI.Generate FilePath
_) ->
          Html
twindShimUnofficial
        Some Action
_ ->
          -- Twind shim doesn't reliably work in dev server mode. Let's just use the
          -- tailwind CDN.
          Html
tailwind2ShimCdn

-- | Loads full tailwind CSS from CDN (not good for production)
tailwind2ShimCdn :: H.Html
tailwind2ShimCdn :: Html
tailwind2ShimCdn =
  Html
H.link
    Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.href AttributeValue
"https://unpkg.com/tailwindcss@2/dist/tailwind.min.css"
    Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.rel AttributeValue
"stylesheet"
    Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.type_ AttributeValue
"text/css"

-- | This shim may not work with hot reload.
twindShimOfficial :: H.Html
twindShimOfficial :: Html
twindShimOfficial =
  ByteString -> Html
H.unsafeByteString (ByteString -> Html) -> (Text -> ByteString) -> Text -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
forall a b. ConvertUtf8 a b => a -> b
encodeUtf8 (Text -> Html) -> Text -> Html
forall a b. (a -> b) -> a -> b
$
    [text|
    <script type="module" src="https://cdn.skypack.dev/twind/shim"></script>
    |]

-- | This shim does work with hot reload, but it spams console with warnings.
twindShimUnofficial :: H.Html
twindShimUnofficial :: Html
twindShimUnofficial = do
  Html -> Html
H.script
    (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.type_ AttributeValue
"text/javascript"
    (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.src AttributeValue
"https://cdn.jsdelivr.net/combine/npm/twind/twind.umd.min.js,npm/twind/observe/observe.umd.min.js"
    (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html
""
  Html -> Html
H.script (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.type_ AttributeValue
"text/javascript" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html
twindShimUnofficialEval
  where
    twindShimUnofficialEval :: H.Html
    twindShimUnofficialEval :: Html
twindShimUnofficialEval =
      ByteString -> Html
H.unsafeByteString (ByteString -> Html) -> (Text -> ByteString) -> Text -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
forall a b. ConvertUtf8 a b => a -> b
encodeUtf8 (Text -> Html) -> Text -> Html
forall a b. (a -> b) -> a -> b
$
        [text|
        // Be silent to avoid complaining about non-tailwind classes
        // https://github.com/tw-in-js/twind/discussions/180#discussioncomment-678272
        console.log("ema: Twind: setup & observe")
        twind.setup({mode: 'silent'})
        window.emaTwindObs = twindObserve.observe(document.documentElement);
        |]