Clay.hs

{-|
Description: Clay CSS helper

This defines a helper function, 'clay', which will serve a 'Clay.Css' instance
from a labeled URL prefix.
-}
module TsWeb.Routing.Clay
  ( clay
  ) where

import qualified TsWeb.Routing as R

import TsWeb.Types (TsSpockCtxT)
import TsWeb.Types.Db (ReadWritePool)

import qualified SuperRecord as SR
import qualified Web.Spock as Spock

import Clay (Css, pretty, renderWith) -- compact)
import Crypto.Hash (Blake2b_160, Digest, hash)
import Data.Monoid ((<>))
import Data.Text.Encoding (encodeUtf8)
import Data.Text.Lazy (toStrict)
import GHC.TypeLits (type (-), KnownNat, KnownSymbol)
import SuperRecord ((:=)(..), FldProxy, Rec, Record, Sort)
import Web.Routing.Combinators (PathState(Open))
import Web.Spock (Path, (<//>))

-- | Serve a 'Clay.Css' instance. The rendered CSS will be served from a .css
-- file whose name is derived from the rendered sheet's contents. This has two
-- results: changing the stylesheet will change the sheet's full URL, and the
-- stylesheet really needs to be referenced by label, using something like
-- `TsWeb.Action.showPath'. The first one of those is actually really nice,
-- since browsers are so aggressive about caching css. The second one is more
-- convenient anyhow, so this function is just pretty nice.
clay ::
     ( SR.KeyDoesNotExist l lts
     , SR.RecCopy lts lts (Sort (l := (Path '[] 'Open) : lts))
     , KnownNat (SR.RecSize lts)
     , (KnownNat ((SR.RecSize (Sort (l := Path '[] 'Open : lts)) - SR.RecTyIdxH 0 l (Sort (l := Path '[] 'Open : lts))) - 1))
     , KnownSymbol l
     )
  => FldProxy l   -- ^Label to access this stylesheet
  -> String       -- ^Base URL for this sheet
  -> Css          -- ^'Clay.Css' instance to serve
  -> (ReadWritePool, Rec lts, TsSpockCtxT lts0 xs sess ())
  -> ( ReadWritePool
     , Record (l := (Path '[] 'Open) : lts)
     , TsSpockCtxT lts0 xs sess ())
clay l base css =
  let sheet = toStrict $ renderWith pretty [] css <> "\n"
      dgst = hash (encodeUtf8 sheet) :: Digest Blake2b_160
      url = Spock.static base <//> Spock.static (show dgst ++ ".css")
   in R.path l url (R.get $ Spock.text sheet)