diff --git a/lib/route/src/Obelisk/Route.hs b/lib/route/src/Obelisk/Route.hs index 5fc17aaae..21f835f69 100644 --- a/lib/route/src/Obelisk/Route.hs +++ b/lib/route/src/Obelisk/Route.hs @@ -705,16 +705,18 @@ obeliskRouteEncoder :: forall check parse appRoute. ) => (forall a. appRoute a -> SegmentResult check parse a) -> Encoder check parse (R (ObeliskRoute appRoute)) PageName -obeliskRouteEncoder appRouteSegment = pathComponentEncoder (obeliskRouteSegment appRouteSegment) +obeliskRouteEncoder appRouteSegment = pathComponentEncoder $ \r -> + obeliskRouteSegment r appRouteSegment -- | From a function which explains how app-specific frontend routes translate into segments, produce a function which does the -- same for ObeliskRoute. This uses the given function for the 'ObeliskRoute_App' case, and 'resourceRouteSegment' for the -- 'ObeliskRoute_Resource' case. -obeliskRouteSegment :: forall check parse appRoute. +obeliskRouteSegment :: forall check parse appRoute a. (MonadError Text check, MonadError Text parse) - => (forall a. appRoute a -> SegmentResult check parse a) - -> (forall a. ObeliskRoute appRoute a -> SegmentResult check parse a) -obeliskRouteSegment appRouteSegment = \case + => ObeliskRoute appRoute a + -> (forall a. appRoute a -> SegmentResult check parse a) + -> SegmentResult check parse a +obeliskRouteSegment r appRouteSegment = case r of ObeliskRoute_App appRoute -> appRouteSegment appRoute ObeliskRoute_Resource resourceRoute -> resourceRouteSegment resourceRoute diff --git a/skeleton/common/src/Common/Route.hs b/skeleton/common/src/Common/Route.hs index 1dafb83ef..e2ebc4437 100644 --- a/skeleton/common/src/Common/Route.hs +++ b/skeleton/common/src/Common/Route.hs @@ -17,7 +17,6 @@ import Prelude hiding (id, (.)) import Control.Category -} -import Control.Monad.Except import Data.Text (Text) import Data.Functor.Identity import Data.Functor.Sum @@ -41,16 +40,13 @@ backendRouteEncoder = handleEncoder (const (InL BackendRoute_Missing :/ ())) $ pathComponentEncoder $ \case InL backendRoute -> case backendRoute of BackendRoute_Missing -> PathSegment "missing" $ unitEncoder mempty - InR obeliskRoute -> obeliskRouteSegment frontendRouteSegment obeliskRoute + InR obeliskRoute -> obeliskRouteSegment obeliskRoute $ \case + -- The encoder given to PathEnd determines how to parse query parameters, + -- in this example, we have none, so we insist on it. + FrontendRoute_Main -> PathEnd $ unitEncoder mempty -frontendRouteSegment :: (Applicative check, MonadError Text parse) - => FrontendRoute a -> SegmentResult check parse a -frontendRouteSegment = \case - FrontendRoute_Main -> PathEnd $ unitEncoder mempty - -- The encoder given to PathEnd determines how to parse query parameters, - -- in this example, we have none, so we insist on it. concat <$> mapM deriveRouteComponent [ ''BackendRoute , ''FrontendRoute - ] \ No newline at end of file + ]