Route.hs

{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE ScopedTypeVariables #-}

-- | Type-safe routes
module Rib.Route
  ( IsRoute (..),
    routeUrl,
    routeUrlRel,
    writeRoute,
  )
where

import Control.Monad.Catch
import Data.Kind
import Data.Text (Text)
import qualified Data.Text as T
import Development.Shake (Action, liftIO)
import Path
import Relude
import Rib.Shake (writeFileCached)

-- | A route is a GADT representing individual routes.
--
-- The GADT type parameter represents the data used to render that particular route.
class IsRoute (r :: Type -> Type) where
  -- | Return the filepath (relative `Rib.Shake.ribInputDir`) where the
  -- generated content for this route should be written.
  routeFile :: MonadThrow m => r a -> m (Path Rel File)

data UrlType = Relative | Absolute

path2Url :: Path Rel File -> UrlType -> Text
path2Url fp = toText . toFilePath . \case
  Relative ->
    fp
  Absolute ->
    [absdir|/|] </> 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 =
      if T.isSuffixOf "index.html" s
        then T.dropEnd (T.length $ "index.html") s
        else s

-- | Write the content `s` to the file corresponding to the given route.
writeRoute :: (IsRoute r, ToString s) => r a -> s -> Action ()
writeRoute r content = do
  fp <- liftIO $ routeFile r
  writeFileCached fp $ toString $ content