From 0f2ab1280f589112eb2ddde0d98af04e3ff5b2dc Mon Sep 17 00:00:00 2001
From: Alexandre Esteves <alexfmpe@proton.me>
Date: Sat, 15 Jun 2024 02:45:14 +0100
Subject: [PATCH] Run checkEncoder with template haskell

---
 skeleton/backend/src/Backend.hs             |  5 ++++-
 skeleton/common/common.cabal                |  1 +
 skeleton/common/src/Common/Route.hs         |  4 ++--
 skeleton/common/src/Common/Route/Checked.hs | 20 ++++++++++++++++++++
 skeleton/frontend/src-bin/main.hs           |  7 ++-----
 5 files changed, 29 insertions(+), 8 deletions(-)
 create mode 100644 skeleton/common/src/Common/Route/Checked.hs

diff --git a/skeleton/backend/src/Backend.hs b/skeleton/backend/src/Backend.hs
index 5842ce9fd..6de711c99 100644
--- a/skeleton/backend/src/Backend.hs
+++ b/skeleton/backend/src/Backend.hs
@@ -1,10 +1,13 @@
 module Backend where
 
 import Common.Route
+import Common.Route.Checked
+import Data.Functor.Identity
 import Obelisk.Backend
+import Obelisk.Route
 
 backend :: Backend BackendRoute FrontendRoute
 backend = Backend
   { _backend_run = \serve -> serve $ const $ return ()
-  , _backend_routeEncoder = fullRouteEncoder
+  , _backend_routeEncoder = hoistCheck (pure . runIdentity) validFullEncoder
   }
diff --git a/skeleton/common/common.cabal b/skeleton/common/common.cabal
index 931ff5d02..0317c5845 100644
--- a/skeleton/common/common.cabal
+++ b/skeleton/common/common.cabal
@@ -11,6 +11,7 @@ library
   exposed-modules:
     Common.Api
     Common.Route
+    Common.Route.Checked
   ghc-options: -Wall -O -fno-show-valid-hole-fits
                -- unsafe code
                -Wincomplete-record-updates -Wincomplete-uni-patterns -Wpartial-fields
diff --git a/skeleton/common/src/Common/Route.hs b/skeleton/common/src/Common/Route.hs
index 17dadaee5..e2973fc89 100644
--- a/skeleton/common/src/Common/Route.hs
+++ b/skeleton/common/src/Common/Route.hs
@@ -34,8 +34,8 @@ data FrontendRoute :: * -> * where
   -- This type is used to define frontend routes, i.e. ones for which the backend will serve the frontend.
 
 fullRouteEncoder
-  :: Encoder (Either Text) Identity (R (FullRoute BackendRoute FrontendRoute)) PageName
-fullRouteEncoder = mkFullRouteEncoder
+  :: Either Text (Encoder Identity Identity (R (FullRoute BackendRoute FrontendRoute)) PageName)
+fullRouteEncoder = checkEncoder $ mkFullRouteEncoder
   (FullRoute_Backend BackendRoute_Missing :/ ())
   (\case
       BackendRoute_Missing -> PathSegment "missing" $ unitEncoder mempty)
diff --git a/skeleton/common/src/Common/Route/Checked.hs b/skeleton/common/src/Common/Route/Checked.hs
new file mode 100644
index 000000000..b23ddebf2
--- /dev/null
+++ b/skeleton/common/src/Common/Route/Checked.hs
@@ -0,0 +1,20 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TypeApplications #-}
+
+{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
+
+module Common.Route.Checked where
+
+import Data.Functor.Identity
+import qualified Data.Text as Text
+import Obelisk.Route
+
+import Common.Route
+
+case fullRouteEncoder of
+  Left err -> error $ Text.unpack err
+  Right _ ->
+    [d|
+      validFullEncoder :: Encoder Identity Identity (R (FullRoute BackendRoute FrontendRoute)) PageName
+      Right validFullEncoder = fullRouteEncoder
+    |]
diff --git a/skeleton/frontend/src-bin/main.hs b/skeleton/frontend/src-bin/main.hs
index 9408dc315..f9adb64d2 100644
--- a/skeleton/frontend/src-bin/main.hs
+++ b/skeleton/frontend/src-bin/main.hs
@@ -1,10 +1,7 @@
+import Common.Route.Checked
 import Frontend
-import Common.Route
 import Obelisk.Frontend
-import Obelisk.Route.Frontend
 import Reflex.Dom
 
 main :: IO ()
-main = do
-  let Right validFullEncoder = checkEncoder fullRouteEncoder
-  run $ runFrontend validFullEncoder frontend
+main = run $ runFrontend validFullEncoder frontend