srid/ema
1
1
Fork 0
mirror of https://github.com/srid/ema.git synced 2024-11-29 09:25:14 +03:00
Code Issues Projects Releases Wiki Activity

Unicode normalize routeUrl (via decodeSlug)

Browse Source
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
CHANGELOG.md
View File

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

29
src/Ema/Route/UrlStrategy.hs
View File

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