{-# LANGUAGE KindSignatures #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiWayIf #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE ScopedTypeVariables #-} -- | Type-safe routes for static sites. module Rib.Route ( -- * Defining routes IsRoute (..), -- * Rendering routes routeUrl, routeUrlRel, -- * Writing routes 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 -- | A route is a GADT which represents the individual routes in a static site. -- -- `r` represents the data used to render that particular route. class IsRoute (r :: Type -> Type) where -- | Return the filepath (relative to `Rib.Shake.ribInputDir`) where the -- generated content for this route should be written. routeFile :: MonadThrow m => r a -> m (FilePath) data UrlType = Relative | Absolute path2Url :: FilePath -> UrlType -> Text path2Url fp = toText . \case Relative -> fp Absolute -> "/" fp -- | The absolute URL to this route (relative to site root) routeUrl :: IsRoute r => r a -> Text routeUrl = routeUrl' Absolute -- | The relative URL to this route routeUrlRel :: IsRoute r => r a -> Text routeUrlRel = routeUrl' Relative -- | Get the URL to a route routeUrl' :: IsRoute r => UrlType -> r a -> Text routeUrl' urlType = stripIndexHtml . flip path2Url urlType . either (error . toText . displayException) id . routeFile where stripIndexHtml s = -- Because path2Url can return relative URL, we must account for there -- not being a / at the beginning. if | "/index.html" `T.isSuffixOf` s -> T.dropEnd (T.length "index.html") s | s == "index.html" -> "." | otherwise -> s -- | Write the content `s` to the file corresponding to the given route. -- -- This is similar to `Rib.Shake.writeFileCached`, but takes a route instead of -- a filepath as its argument. writeRoute :: (IsRoute r, ToString s) => r a -> s -> Action () writeRoute r content = do fp <- liftIO $ routeFile r writeFileCached fp $ toString $ content