{-# 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 Path
import Relude
import Rib.Shake (writeFileCached)

-- | 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 (Path Rel File)

data UrlType = Relative | Absolute

path2Url :: Path Rel File -> UrlType -> Text
path2Url :: Path Rel File -> UrlType -> Text
path2Url fp :: Path Rel File
fp = FilePath -> Text
forall a. ToText a => a -> Text
toText (FilePath -> Text) -> (UrlType -> FilePath) -> UrlType -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Rel File -> FilePath
forall b t. Path b t -> FilePath
toFilePath (Path Rel File -> FilePath)
-> (UrlType -> Path Rel File) -> UrlType -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
  Relative ->
    Path Rel File
fp
  Absolute ->
    [absdir|/|] Path Rel Dir -> Path Rel File -> Path Rel File
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel File
fp

-- | The absolute URL to this route (relative to site root)
routeUrl :: IsRoute r => r a -> Text
routeUrl :: r a -> Text
routeUrl = UrlType -> r a -> Text
forall (r :: * -> *) a. IsRoute r => UrlType -> r a -> Text
routeUrl' UrlType
Absolute

-- | The relative URL to this route
routeUrlRel :: IsRoute r => r a -> Text
routeUrlRel :: r a -> Text
routeUrlRel = UrlType -> r a -> Text
forall (r :: * -> *) a. IsRoute r => UrlType -> r a -> Text
routeUrl' UrlType
Relative

-- | Get the URL to a route
routeUrl' :: IsRoute r => UrlType -> r a -> Text
routeUrl' :: UrlType -> r a -> Text
routeUrl' urlType :: UrlType
urlType = Text -> Text
stripIndexHtml (Text -> Text) -> (r a -> Text) -> r a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Path Rel File -> UrlType -> Text)
-> UrlType -> Path Rel File -> Text
forall a b c. (a -> b -> c) -> b -> a -> c
flip Path Rel File -> UrlType -> Text
path2Url UrlType
urlType (Path Rel File -> Text) -> (r a -> Path Rel File) -> r a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SomeException -> Path Rel File)
-> (Path Rel File -> Path Rel File)
-> Either SomeException (Path Rel File)
-> Path Rel File
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Text -> Path Rel File
forall a t. (HasCallStack, IsText t) => t -> a
error (Text -> Path Rel File)
-> (SomeException -> Text) -> SomeException -> Path Rel File
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
forall a. ToText a => a -> Text
toText (FilePath -> Text)
-> (SomeException -> FilePath) -> SomeException -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeException -> FilePath
forall e. Exception e => e -> FilePath
displayException) Path Rel File -> Path Rel File
forall a. a -> a
id (Either SomeException (Path Rel File) -> Path Rel File)
-> (r a -> Either SomeException (Path Rel File))
-> r a
-> Path Rel File
forall b c a. (b -> c) -> (a -> b) -> a -> c
. r a -> Either SomeException (Path Rel File)
forall (r :: * -> *) (m :: * -> *) a.
(IsRoute r, MonadThrow m) =>
r a -> m (Path Rel File)
routeFile
  where
    stripIndexHtml :: Text -> Text
stripIndexHtml s :: Text
s =
      -- Because path2Url can return relative URL, we must account for there
      -- not being a / at the beginning.
      if  | "/index.html" Text -> Text -> Bool
`T.isSuffixOf` Text
s ->
            Int -> Text -> Text
T.dropEnd (Text -> Int
T.length "index.html") Text
s
          | Text
s Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== "index.html" ->
            "."
          | Bool
otherwise ->
            Text
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 a -> s -> Action ()
writeRoute r :: r a
r content :: s
content = do
  Path Rel File
fp <- IO (Path Rel File) -> Action (Path Rel File)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Path Rel File) -> Action (Path Rel File))
-> IO (Path Rel File) -> Action (Path Rel File)
forall a b. (a -> b) -> a -> b
$ r a -> IO (Path Rel File)
forall (r :: * -> *) (m :: * -> *) a.
(IsRoute r, MonadThrow m) =>
r a -> m (Path Rel File)
routeFile r a
r
  Path Rel File -> FilePath -> Action ()
writeFileCached Path Rel File
fp (FilePath -> Action ()) -> FilePath -> Action ()
forall a b. (a -> b) -> a -> b
$ s -> FilePath
forall a. ToString a => a -> FilePath
toString (s -> FilePath) -> s -> FilePath
forall a b. (a -> b) -> a -> b
$ s
content