{-| 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)