module Ema.Example.Common (
  tailwindLayout,
  watchDirForked,
) where

import Control.Concurrent (Chan, forkIO, newChan, threadDelay)
import System.FSNotify qualified as FSNotify
import Text.Blaze.Html.Renderer.Utf8 qualified as RU
import Text.Blaze.Html5 ((!))
import Text.Blaze.Html5 qualified as H
import Text.Blaze.Html5.Attributes qualified as A

-- | A simple and off-the-shelf layout using Tailwind CSS
tailwindLayout :: H.Html -> H.Html -> LByteString
tailwindLayout :: Html -> Html -> LByteString
tailwindLayout Html
h Html
b =
  AttributeValue -> AttributeValue -> Html -> Html -> LByteString
layoutWith AttributeValue
"en" AttributeValue
"UTF-8" (Html
tailwind2ShimCdn forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
>> Html
h) 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 forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"overflow-y-scroll" forall a b. (a -> b) -> a -> b
$ Html
b
  where
    -- 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 forall a b. (a -> b) -> a -> b
$ do
      Html
H.docType
      Html -> Html
H.html forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.lang AttributeValue
lang forall a b. (a -> b) -> a -> b
$ do
        Html -> Html
H.head forall a b. (a -> b) -> a -> b
$ do
          Html
H.meta forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.charset AttributeValue
encoding
          -- This makes the site mobile friendly by default.
          Html
H.meta forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.name AttributeValue
"viewport" forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.content AttributeValue
"width=device-width, initial-scale=1"
          Html
appHead
        Html
appBody

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

-- Observe changes to a directory path, and return the `Chan` of its events.
watchDirForked :: FilePath -> IO (Chan FSNotify.Event)
watchDirForked :: FilePath -> IO (Chan Event)
watchDirForked FilePath
path = do
  Chan Event
ch <- forall a. IO (Chan a)
newChan
  -- FIXME: We should be using race_, not forkIO.
  forall (f :: Type -> Type) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO () -> IO ThreadId
forkIO forall a b. (a -> b) -> a -> b
$
    forall a. (WatchManager -> IO a) -> IO a
FSNotify.withManager forall a b. (a -> b) -> a -> b
$ \WatchManager
mgr -> do
      IO ()
_stopListening <- WatchManager
-> FilePath -> ActionPredicate -> Chan Event -> IO (IO ())
FSNotify.watchDirChan WatchManager
mgr FilePath
path (forall a b. a -> b -> a
const Bool
True) Chan Event
ch
      Int -> IO ()
threadDelay forall a. Bounded a => a
maxBound
  forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Chan Event
ch