1
1
mirror of https://github.com/srid/ema.git synced 2024-11-25 20:12:20 +03:00

Unicode normalize routeUrl (via decodeSlug)

This commit is contained in:
Sridhar Ratnakumar 2021-05-16 16:03:22 -04:00
parent ed782ef1a9
commit df58a62139
2 changed files with 17 additions and 15 deletions

View File

@ -6,6 +6,7 @@
- Add `Ord`, `Generic`, `Data` and Aeson instances to `Slug`
- Unicode normalize slugs using NFC
- TODO(doc) Add `decodeSlug` and `encodeSlug`
- Unicode normalize `routeUrl` (via `decodeSlug`)
- Add default implementation based on Enum for `staticRoute`
- Warn, without failing, on missing `staticAssets` during static generation
- Helpers

View File

@ -4,8 +4,9 @@
module Ema.Route.UrlStrategy where
import Data.Default (Default, def)
import qualified Data.List.NonEmpty as NE
import qualified Data.Text as T
import Ema.Route.Slug (Slug (unSlug))
import Ema.Route.Slug (Slug (unSlug), decodeSlug, encodeSlug)
import System.FilePath (joinPath)
data UrlStrategy
@ -22,19 +23,19 @@ slugUrlWithStrategy :: UrlStrategy -> [Slug] -> Text
slugUrlWithStrategy strat slugs =
case strat of
UrlStrategy_FolderOnly ->
"/" <> T.replace "index.html" "" (toText $ slugFileWithStrategy strat slugs)
"/" <> T.intercalate "/" (encodeSlug <$> 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
case nonEmpty slugs of
Nothing ->
"/"
Just (removeLastIf (decodeSlug "index") -> slugsWithoutIndex) ->
"/" <> T.intercalate "/" (encodeSlug <$> slugsWithoutIndex)
where
removeLastIf :: Eq a => a -> NonEmpty a -> [a]
removeLastIf x xs =
if NE.last xs == x
then NE.init xs
else toList xs
slugFileWithStrategy :: UrlStrategy -> [Slug] -> FilePath
slugFileWithStrategy strat slugs =
@ -42,5 +43,5 @@ slugFileWithStrategy strat slugs =
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"]
let (term :| (reverse -> parts)) = fromMaybe ("index" :| []) $ nonEmpty (reverse $ fmap (toString . unSlug) slugs)
in joinPath $ parts <> [term <> ".html"]