ema-0.1.0.0: src/Ema/Route/UrlStrategy.hs
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE QuasiQuotes #-}
module Ema.Route.UrlStrategy where
import Data.Default (Default, def)
import qualified Data.Text as T
import Ema.Route.Slug (Slug (unSlug))
import System.FilePath (joinPath)
data UrlStrategy
= -- | URLs always end with a slash, and correspond to index.html in that folder
UrlStrategy_FolderOnly
| -- | Pretty URLs without ugly .html ext or slash-suffix
UrlStrategy_HtmlOnlySansExt
deriving (Eq, Show, Ord)
instance Default UrlStrategy where
def = UrlStrategy_HtmlOnlySansExt
slugUrlWithStrategy :: UrlStrategy -> [Slug] -> Text
slugUrlWithStrategy strat slugs =
case strat of
UrlStrategy_FolderOnly ->
"/" <> T.replace "index.html" "" (toText $ slugFileWithStrategy strat slugs)
UrlStrategy_HtmlOnlySansExt ->
-- FIXME: This should replace only at the end, not middle
let fp = toText (slugFileWithStrategy strat slugs)
in if
| "index.html" == fp ->
"/"
| "/index.html" `T.isSuffixOf` fp ->
"/" <> T.take (T.length fp - T.length "/index.html") fp
| ".html" `T.isSuffixOf` fp ->
"/" <> T.take (T.length fp - T.length ".html") fp
| otherwise ->
"/" <> fp
slugFileWithStrategy :: UrlStrategy -> [Slug] -> FilePath
slugFileWithStrategy strat slugs =
case strat of
UrlStrategy_FolderOnly ->
joinPath $ fmap (toString . unSlug) slugs <> ["index.html"]
UrlStrategy_HtmlOnlySansExt ->
let (term :| (reverse -> parts)) = fromMaybe ("index" :| []) $ nonEmpty (reverse $ fmap unSlug slugs)
in joinPath $ fmap toString parts <> [toString term <> ".html"]