Route.hs

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