URI encoding for slugs (#25)

* Add encodeSlug, decodeSlug

* Decode URL into slug properly. Thus support whitespace in slugs

* refactor

CHANGELOG.md

@@ -5,6 +5,7 @@
 - `Ema.Slug`
   - Add `Ord` instance to `Slug`
   - Unicode normalize slugs using NFC
+  - Add `decodeSlug` and `encodeSlug`
 - Add default implementation based on Enum for `staticRoute`
 - Helpers
   - Helpers.FileSystem

ema.cabal

@@ -55,6 +55,7 @@ library
     , text
     , unicode-transforms
     , unliftio
+    , uri-encode
     , wai
     , wai-middleware-static
     , wai-websockets

src/Ema/Route.hs

@@ -5,13 +5,15 @@ module Ema.Route
   ( routeUrl,
     routeFile,
     Slug (unSlug),
+    decodeSlug,
+    encodeSlug,
     UrlStrategy (..),
   )
 where
 
 import Data.Default (def)
 import Ema.Class
-import Ema.Route.Slug (Slug (unSlug))
+import Ema.Route.Slug (Slug (unSlug), decodeSlug, encodeSlug)
 import Ema.Route.UrlStrategy
   ( UrlStrategy (..),
     slugFileWithStrategy,

src/Ema/Route/Slug.hs

@@ -4,11 +4,22 @@ module Ema.Route.Slug where
 
 import qualified Data.Text as T
 import qualified Data.Text.Normalize as UT
+import qualified Network.URI.Encode as UE
 
 -- | An URL path is made of multiple slugs, separated by '/'
 newtype Slug = Slug {unSlug :: Text}
   deriving (Eq, Show, Ord)
 
+-- | Decode an URL component into a `Slug` using `Network.URI.Encode`
+decodeSlug :: Text -> Slug
+decodeSlug =
+  fromString . UE.decode . toString
+
+-- | Encode a `Slug` into an URL component using `Network.URI.Encode`
+encodeSlug :: Slug -> Text
+encodeSlug =
+  UE.encodeText . unSlug
+
 instance IsString Slug where
   fromString :: HasCallStack => String -> Slug
   fromString (toText -> s) =

src/Ema/Server.hs

@@ -10,6 +10,7 @@ import Data.LVar (LVar)
 import qualified Data.LVar as LVar
 import qualified Data.Text as T
 import Ema.Class (Ema (decodeRoute, staticAssets), MonadEma)
+import qualified Ema.Route.Slug as Slug
 import GHC.IO.Unsafe (unsafePerformIO)
 import NeatInterpolation (text)
 import qualified Network.HTTP.Types as H
@@ -126,7 +127,7 @@ runServerWithWebSocketHotReload port model render = do
                 <> show @Text err
                 <> "</pre><p>Once you fix your code this page will automatically update.</body>"
     routeFromPathInfo =
-      decodeRoute @model . fmap (fromString . toString)
+      decodeRoute @model . fmap Slug.decodeSlug
     -- TODO: It would be good have this also get us the stack trace.
     unsafeCatch :: Exception e => a -> (e -> a) -> a
     unsafeCatch x f = unsafePerformIO $ catch (seq x $ pure x) (pure . f)