Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

Run checkEncoder with template haskell #1087

Draft
wants to merge 1 commit into
base: develop
Choose a base branch
from
Draft

Run checkEncoder with template haskell #1087

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
5 changes: 4 additions & 1 deletion skeleton/backend/src/Backend.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -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
Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

This could just be _backend_routeEncoder = validFullEncoder but that's a breaking change, probably best to get adoption first (assuming we merge this)

}
1 change: 1 addition & 0 deletions skeleton/common/common.cabal
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
4 changes: 2 additions & 2 deletions skeleton/common/src/Common/Route.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down
20 changes: 20 additions & 0 deletions skeleton/common/src/Common/Route/Checked.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -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
|]
Comment on lines +14 to +20
Copy link
Contributor Author

@alexfmpe alexfmpe Jun 15, 2024 •
edited
Loading

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Can't do this directly in Common.Route due to stage restriction.
I would also like to have some sort of thisIsTheOnlyBindingYouShouldEdit = fullRouteEncoder before the case so that renames to fullRouteEncoder in "userland" only require a single rename in this weird place (and thus unlikely to get out of sync) but that requires yet another module due to stage restriction.

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Wasn't able to pull this into a DRY util as there's no way to get a Lift instance for Encoder to splice back in.
At most we could have a util taking in Encoder check parse a b for the check and Name/Dec for use in the new binding and pass both "forms" of fullRouteEncoder. Maybe it'd be worth putting that in Obelisk.Route ?

7 changes: 2 additions & 5 deletions skeleton/frontend/src-bin/main.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -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