{-# 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 Path
import Relude
import Rib.Shake (writeFileCached)
class IsRoute (r :: Type -> Type) where
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
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
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
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 =
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
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