From 5f10887eaf9c69f3d2c70fde76a50b3820235845 Mon Sep 17 00:00:00 2001
From: Sridhar Ratnakumar <3998+srid@users.noreply.github.com>
Date: Sun, 9 May 2021 11:42:41 -0400
Subject: [PATCH] URI encoding for slugs (#25)

* Add encodeSlug, decodeSlug

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

* refactor
---
 CHANGELOG.md          |  1 +
 ema.cabal             |  1 +
 src/Ema/Route.hs      |  4 +++-
 src/Ema/Route/Slug.hs | 11 +++++++++++
 src/Ema/Server.hs     |  3 ++-
 5 files changed, 18 insertions(+), 2 deletions(-)

diff --git a/CHANGELOG.md b/CHANGELOG.md
index bef3aa6..3cd7c9c 100644
--- a/CHANGELOG.md
+++ b/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
diff --git a/ema.cabal b/ema.cabal
index ab0d5c6..b7a2328 100644
--- a/ema.cabal
+++ b/ema.cabal
@@ -55,6 +55,7 @@ library
     , text
     , unicode-transforms
     , unliftio
+    , uri-encode
     , wai
     , wai-middleware-static
     , wai-websockets
diff --git a/src/Ema/Route.hs b/src/Ema/Route.hs
index 377fdc9..60adccf 100644
--- a/src/Ema/Route.hs
+++ b/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,
diff --git a/src/Ema/Route/Slug.hs b/src/Ema/Route/Slug.hs
index 1492e1b..1c83750 100644
--- a/src/Ema/Route/Slug.hs
+++ b/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) =
diff --git a/src/Ema/Server.hs b/src/Ema/Server.hs
index 8dd81eb..52c62b9 100644
--- a/src/Ema/Server.hs
+++ b/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)