{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Rib.Route
(
IsRoute (..),
routeUrl,
routeUrlRel,
writeRoute,
)
where
import Control.Monad.Catch
import Data.Kind
import qualified Data.Text as T
import Development.Shake (Action)
import Relude
import Rib.Shake (writeFileCached)
import System.FilePath
class IsRoute (r :: Type -> Type) where
routeFile :: MonadThrow m => r a -> m (FilePath)
data UrlType = Relative | Absolute
path2Url :: FilePath -> UrlType -> Text
path2Url fp = toText . \case
Relative ->
fp
Absolute ->
"/" </> fp
routeUrl :: IsRoute r => r a -> Text
routeUrl = routeUrl' Absolute
routeUrlRel :: IsRoute r => r a -> Text
routeUrlRel = routeUrl' Relative
routeUrl' :: IsRoute r => UrlType -> r a -> Text
routeUrl' urlType = stripIndexHtml . flip path2Url urlType . either (error . toText . displayException) id . routeFile
where
stripIndexHtml s =
if | "/index.html" `T.isSuffixOf` s ->
T.dropEnd (T.length "index.html") s
| s == "index.html" ->
"."
| otherwise ->
s
writeRoute :: (IsRoute r, ToString s) => r a -> s -> Action ()
writeRoute r content = do
fp <- liftIO $ routeFile r
writeFileCached fp $ toString $ content