@@ -20,40 +20,47 @@ module Obelisk.Route
2020 ( R
2121 , pattern (:/)
2222 , PageName
23− , Encoder (..) --TODO: unsafe
23+ , PathQuery
24+ , Encoder (..)
2425 , checkEncoder
25− , ValidEncoder (..) --TODO: unsafe
26− , ValidEncoderFunc (..)
26+ , EncoderImpl (..)
27+ , EncoderFunc (..)
28+ , unsafeMkEncoder
29+ , encode
30+ , decode
31+ , tryDecode
32+ , hoistCheck
33+ , hoistParse
2734 , mapSome
35+ , SegmentResult (..)
2836 , pathComponentEncoder
2937 , enumEncoder
3038 , enum1Encoder
3139 , checkEnum1EncoderFunc
32− , endValidEncoder
33− , pathOnlyValidEncoder
34− , singletonListValidEncoder
40+ , unitEncoder
41+ , pathOnlyEncoder
42+ , singletonListEncoder
3543 , unpackTextEncoder
3644 , prefixTextEncoder
37− , unsafeTshowValidEncoder
38− , someConstValidEncoder
39− , singlePathSegmentValidEncoder
40− , justValidEncoder
41− , nothingValidEncoder
42− , isoValidEncoder
43− , wrappedValidEncoder
44− , unwrappedValidEncoder
45+ , unsafeTshowEncoder
46+ , someConstEncoder
47+ , singlePathSegmentEncoder
48+ , justEncoder
49+ , nothingEncoder
50+ , isoEncoder
51+ , wrappedEncoder
52+ , unwrappedEncoder
4553 , listToNonEmptyEncoder
4654 , prefixNonemptyTextEncoder
4755 , joinPairTextEncoder
4856 , toListMapEncoder
4957 , shadowEncoder
50− , prismValidEncoder
58+ , prismEncoder
5159 , rPrism
5260 , obeliskRouteEncoder
53− , obeliskRouteComponentEncoder
54− , checkObeliskRouteRestEncoder
55− , pageNameValidEncoder
56− , catchValidEncoder
61+ , obeliskRouteSegment
62+ , pageNameEncoder
63+ , handleEncoder
5764 , ObeliskRoute (..)
5865 , _ObeliskRoute_App
5966 , _ObeliskRoute_Resource
@@ -61,11 +68,13 @@ module Obelisk.Route
6168 , JSaddleWarpRoute (..)
6269 , jsaddleWarpRouteEncoder
6370 , IndexOnlyRoute (..)
64− , indexOnlyRouteComponentEncoder
65− , indexOnlyRouteRestEncoder
71+ , indexOnlyRouteSegment
72+ , indexOnlyRouteEncoder
6673 , someSumEncoder
6774 , Void1
6875 , void1Encoder
76+ , pathSegmentsTextEncoder
77+ , queryParametersTextEncoder
6978 ) where
7079
7180import Prelude hiding ((.), id)
@@ -95,6 +104,7 @@ import Data.Set (Set)
95104import qualified Data.Set as Set
96105import Data.Some (Some)
97106import qualified Data.Some as Some
107+import Data.Some.Universe.Orphans ()
98108import Data.Text (Text)
99109import qualified Data.Text as T
100110import Data.Text.Encoding
@@ -139,41 +149,80 @@ mapSome f (Some.This a) = Some.This $ f a
139149-- Encoder fundamentals
140150--------------------------------------------------------------------------------
141151
142−newtype Encoder check parse decoded encoded = Encoder { unEncoder :: check (ValidEncoder parse decoded encoded) }
143−
144−-- | Law:
145−-- forall p. _validEncoder_decode ve . _validEncoder_encode ve p == pure
146−-- Note that the reverse may not be the case: when parsing, a route may be canonicalized, and erroneous routes may be collapsed to a single 404 route. However, as a consequence of the law, encode . decode must be idemponent.
147−data ValidEncoder parse decoded encoded = ValidEncoder
148− { _validEncoder_decode :: !(encoded -> parse decoded) -- Can fail; can lose information; must always succeed on outputs of `_validEncoder_encode` and result in the original value
149− , _validEncoder_encode :: !(decoded -> encoded) -- Must be injective
152+-- | This is the type of route encoder/decoders. It is parameterised over two monads: Firstly, the monad
153+-- used to check the validity of the encoder (i.e. that it is total), secondly the monad used for parsing
154+-- during the decode phase. The following two parameters are respectively the type of decoded data, and the
155+-- encoded type.
156+newtype Encoder check parse decoded encoded =
157+ Encoder { unEncoder :: check (EncoderImpl parse decoded encoded) }
158+
159+-- | The internal type used to construct primitive 'Encoder' values.
160+-- Law:
161+-- forall p. _encoderImpl_decode ve . _encoderImpl_encode ve p == pure
162+-- Note that the reverse may not be the case: when parsing, a route may be canonicalized, and erroneous routes may be collapsed to a single 404 route. However, as a consequence of the law, encode . decode must be idempotent.
163+data EncoderImpl parse decoded encoded = EncoderImpl
164+ { _encoderImpl_decode :: !(encoded -> parse decoded) -- Can fail; can lose information; must always succeed on outputs of `_encoderImpl_encode` and result in the original value
165+ , _encoderImpl_encode :: !(decoded -> encoded) -- Must be injective
150166 }
151167
152−checkEncoder :: Encoder check parse decoded encoded -> check (ValidEncoder parse decoded encoded)
153−checkEncoder = unEncoder
168+-- | Once an 'Encoder' has been checked, so that its check monad has become 'Identity', and its parser is total
169+-- so that its parse monad is also 'Identity', it may be used to actually decode by applying this function.
170+decode :: Encoder Identity Identity decoded encoded -> encoded -> decoded
171+decode e x = runIdentity (tryDecode e x)
172+
173+-- | Once an 'Encoder' has been checked, so that its check monad has become 'Identity', even if the same is not true of the
174+-- parse monad, we may still attempt to decode with it in its parse monad.
175+tryDecode :: Encoder Identity parse decoded encoded -> encoded -> parse decoded
176+tryDecode (Encoder (Identity impl)) x = _encoderImpl_decode impl x
177+
178+-- | Similar to 'decode' above, once an encoder has been checked so that its check monad is Identity, it
179+-- can be used to actually encode by using this. Note that while there's no constraint on the parse monad here,
180+-- one should usually be applying decode and encode to the same 'Encoder'
181+encode :: Encoder Identity parse decoded encoded -> decoded -> encoded
182+encode (Encoder (Identity impl)) x = _encoderImpl_encode impl x
183+
184+-- | This is a primitive used to build encoders which can't fail to check. It should not be used unless one is
185+-- reasonably certain that the law given for 'EncoderImpl' above holds.
186+unsafeMkEncoder :: (Applicative check) => EncoderImpl parse decoded encoded -> Encoder check parse decoded encoded
187+unsafeMkEncoder impl = Encoder (pure impl)
188+
189+-- | Transform the check monad of an 'Encoder' by applying a natural transformation.
190+hoistCheck :: (forall t. check t -> check' t) -> Encoder check parse a b -> Encoder check' parse a b
191+hoistCheck f (Encoder x) = Encoder (f x)
192+
193+-- | Transform the parse monad of an 'Encoder' by applying a natural transformation.
194+hoistParse :: (Functor check)
195+ => (forall t. parse t -> parse' t) -> Encoder check parse a b -> Encoder check parse' a b
196+hoistParse f (Encoder x) = Encoder (fmap (\(EncoderImpl dec enc) -> EncoderImpl (f . dec) enc) x)
197+
198+-- | Check an 'Encoder', transforming it into one whose check monad is anything we want (usually Identity).
199+checkEncoder :: (Applicative check', Functor check)
200+ => Encoder check parse decoded encoded
201+ -> check (Encoder check' parse decoded encoded)
202+checkEncoder = fmap unsafeMkEncoder . unEncoder
154203
155204instance (Applicative check, Monad parse) => Category (Encoder check parse) where
156205 id = Encoder $ pure id
157206 Encoder f . Encoder g = Encoder $ liftA2 (.) f g
158207
159−instance Monad parse => Category (ValidEncoder parse) where
160− id = ValidEncoder
161− { _validEncoder_decode = pure
162− , _validEncoder_encode = id
208+instance Monad parse => Category (EncoderImpl parse) where
209+ id = EncoderImpl
210+ { _encoderImpl_decode = pure
211+ , _encoderImpl_encode = id
163212 }
164− f . g = ValidEncoder
165− { _validEncoder_decode = _validEncoder_decode g <=< _validEncoder_decode f
166− , _validEncoder_encode = _validEncoder_encode f . _validEncoder_encode g
213+ f . g = EncoderImpl
214+ { _encoderImpl_decode = _encoderImpl_decode g <=< _encoderImpl_decode f
215+ , _encoderImpl_encode = _encoderImpl_encode f . _encoderImpl_encode g
167216 }
168217
169−instance Monad parse => PFunctor (,) (ValidEncoder parse) (ValidEncoder parse) where
218+instance Monad parse => PFunctor (,) (EncoderImpl parse) (EncoderImpl parse) where
170219 first f = bimap f id
171−instance Monad parse => QFunctor (,) (ValidEncoder parse) (ValidEncoder parse) where
220+instance Monad parse => QFunctor (,) (EncoderImpl parse) (EncoderImpl parse) where
172221 second g = bimap id g
173−instance Monad parse => Bifunctor (,) (ValidEncoder parse) (ValidEncoder parse) (ValidEncoder parse) where
174− bimap f g = ValidEncoder
175− { _validEncoder_encode = bimap (_validEncoder_encode f) (_validEncoder_encode g)
176− , _validEncoder_decode = \(a, b) -> liftA2 (,) (_validEncoder_decode f a) (_validEncoder_decode g b)
222+instance Monad parse => Bifunctor (,) (EncoderImpl parse) (EncoderImpl parse) (EncoderImpl parse) where
223+ bimap f g = EncoderImpl
224+ { _encoderImpl_encode = bimap (_encoderImpl_encode f) (_encoderImpl_encode g)
225+ , _encoderImpl_decode = \(a, b) -> liftA2 (,) (_encoderImpl_decode f a) (_encoderImpl_decode g b)
177226 }
178227
179228instance (Applicative check, Monad parse) => PFunctor (,) (Encoder check parse) (Encoder check parse) where
@@ -181,46 +230,46 @@ instance (Applicative check, Monad parse) => PFunctor (,) (Encoder check parse)
181230instance (Applicative check, Monad parse) => QFunctor (,) (Encoder check parse) (Encoder check parse) where
182231 second g = bimap id g
183232instance (Applicative check, Monad parse) => Bifunctor (,) (Encoder check parse) (Encoder check parse) (Encoder check parse) where
184− bimap f g = Encoder $ liftA2 bimap (checkEncoder f) (checkEncoder g)
233+ bimap f g = Encoder $ liftA2 bimap (unEncoder f) (unEncoder g)
185234
186−instance (Traversable f, Monad parse) => Cat.Functor f (ValidEncoder parse) (ValidEncoder parse) where
187− fmap ve = ValidEncoder
188− { _validEncoder_encode = fmap $ _validEncoder_encode ve
189− , _validEncoder_decode = traverse $ _validEncoder_decode ve
235+instance (Traversable f, Monad parse) => Cat.Functor f (EncoderImpl parse) (EncoderImpl parse) where
236+ fmap ve = EncoderImpl
237+ { _encoderImpl_encode = fmap $ _encoderImpl_encode ve
238+ , _encoderImpl_decode = traverse $ _encoderImpl_decode ve
190239 }
191240
192241instance (Traversable f, Monad check, Monad parse) => Cat.Functor f (Encoder check parse) (Encoder check parse) where
193242 fmap e = Encoder $ do
194− ve <- checkEncoder e
243+ ve <- unEncoder e
195244 pure $ Cat.fmap ve
196245
197−instance Monad parse => Associative (ValidEncoder parse) (,) where
198− associate = ValidEncoder
199− { _validEncoder_encode = associate
200− , _validEncoder_decode = pure . disassociate
246+instance Monad parse => Associative (EncoderImpl parse) (,) where
247+ associate = EncoderImpl
248+ { _encoderImpl_encode = associate
249+ , _encoderImpl_decode = pure . disassociate
201250 }
202− disassociate = ValidEncoder
203− { _validEncoder_encode = disassociate
204− , _validEncoder_decode = pure . associate
251+ disassociate = EncoderImpl
252+ { _encoderImpl_encode = disassociate
253+ , _encoderImpl_decode = pure . associate
205254 }
206255
207−instance Monad parse => Monoidal (ValidEncoder parse) (,) where
208− type Id (ValidEncoder parse) (,) = ()
209− idl = ValidEncoder
210− { _validEncoder_encode = idl
211− , _validEncoder_decode = pure . coidl
256+instance Monad parse => Monoidal (EncoderImpl parse) (,) where
257+ type Id (EncoderImpl parse) (,) = ()
258+ idl = EncoderImpl
259+ { _encoderImpl_encode = idl
260+ , _encoderImpl_decode = pure . coidl
212261 }
213− idr = ValidEncoder
214− { _validEncoder_encode = idr
215− , _validEncoder_decode = pure . coidr
262+ idr = EncoderImpl
263+ { _encoderImpl_encode = idr
264+ , _encoderImpl_decode = pure . coidr
216265 }
217− coidl = ValidEncoder
218− { _validEncoder_encode = coidl
219− , _validEncoder_decode = pure . idl
266+ coidl = EncoderImpl
267+ { _encoderImpl_encode = coidl
268+ , _encoderImpl_decode = pure . idl
220269 }
221− coidr = ValidEncoder
222− { _validEncoder_encode = coidr
223− , _validEncoder_decode = pure . idr
270+ coidr = EncoderImpl
271+ { _encoderImpl_encode = coidr
272+ , _encoderImpl_decode = pure . idr
224273 }
225274
226275instance (Applicative check, Monad parse) => Associative (Encoder check parse) (,) where
@@ -234,53 +283,99 @@ instance (Applicative check, Monad parse) => Monoidal (Encoder check parse) (,)
234283 coidl = Encoder $ pure coidl
235284 coidr = Encoder $ pure coidr
236285
237−
238286--------------------------------------------------------------------------------
239287-- Specific instances of encoders
240288--------------------------------------------------------------------------------
241289
242−-- | A path and query string, in which trailing slashes don't matter in the path
243−-- and duplicate query parameters are not allowed
244−type PageName = ([Text], Map Text (Maybe Text))
290+-- | Given a valid 'Iso' from lens, construct an 'Encoder'
291+isoEncoder :: (Applicative check, Applicative parse) => Iso' a b -> Encoder check parse a b
292+isoEncoder f = unsafeMkEncoder $ EncoderImpl
293+ { _encoderImpl_encode = view f
294+ , _encoderImpl_decode = pure . view (from f)
295+ }
245296
246−newtype Flip f a b = Flip { unFlip :: f b a }
297+wrappedEncoder :: (Wrapped a, Applicative check, Applicative parse) => Encoder check parse (Unwrapped a) a
298+wrappedEncoder = isoEncoder $ from _Wrapped'
299+
300+unwrappedEncoder :: (Wrapped a, Applicative check, Applicative parse) => Encoder check parse a (Unwrapped a)
301+unwrappedEncoder = isoEncoder _Wrapped'
302+
303+-- | Encodea a value by simply applying 'Just'
304+justEncoder :: (Applicative check, MonadError Text parse) => Encoder check parse a (Maybe a)
305+justEncoder = prismEncoder _Just
306+
307+-- |
308+nothingEncoder :: (Applicative check, MonadError Text parse) => Encoder check parse () (Maybe a)
309+nothingEncoder = prismEncoder _Nothing
247310
248−someConstValidEncoder :: Applicative parse => ValidEncoder parse (Some (Const a)) a
249−someConstValidEncoder = ValidEncoder
250− { _validEncoder_encode = \(Some.This (Const a)) -> a
251− , _validEncoder_decode = pure . Some.This . Const
311+someConstEncoder :: (Applicative check, Applicative parse) => Encoder check parse (Some (Const a)) a
312+someConstEncoder = unsafeMkEncoder $ EncoderImpl
313+ { _encoderImpl_encode = \(Some.This (Const a)) -> a
314+ , _encoderImpl_decode = pure . Some.This . Const
252315 }
253316
254317-- | WARNING: This is only safe if the Show and Read instances for 'a' are
255318-- inverses of each other
256−unsafeTshowValidEncoder :: (Show a, Read a, MonadError Text parse) => ValidEncoder parse a Text
257−unsafeTshowValidEncoder = ValidEncoder
258− { _validEncoder_encode = tshow
259− , _validEncoder_decode = \raw -> case readMaybe $ T.unpack raw of
260− Nothing -> throwError $ "unsafeTshowValidEncoder: couldn't decode " <> tshow raw
319+unsafeTshowEncoder :: (Show a, Read a, Applicative check, MonadError Text parse) => Encoder check parse a Text
320+unsafeTshowEncoder = unsafeMkEncoder $ EncoderImpl
321+ { _encoderImpl_encode = tshow
322+ , _encoderImpl_decode = \raw -> case readMaybe $ T.unpack raw of
323+ Nothing -> throwError $ "unsafeTshowEncoderImpl: couldn't decode " <> tshow raw
261324 Just parsed -> pure parsed
262325 }
263326
264−justValidEncoder :: MonadError Text parse => ValidEncoder parse a (Maybe a)
265−justValidEncoder = prismValidEncoder _Just
327+newtype EncoderFunc check parse p r = EncoderFunc { runEncoderImplFunc :: forall a. p a -> Encoder check parse a r }
266328
267−nothingValidEncoder :: MonadError Text parse => ValidEncoder parse () (Maybe a)
268−nothingValidEncoder = prismValidEncoder _Nothing
269−
270−isoValidEncoder :: Applicative parse => Iso' a b -> ValidEncoder parse a b
271−isoValidEncoder f = ValidEncoder
272− { _validEncoder_encode = view f
273− , _validEncoder_decode = pure . view (from f)
274− }
275−
276−wrappedValidEncoder :: (Wrapped a, Applicative parse) => ValidEncoder parse (Unwrapped a) a
277−wrappedValidEncoder = isoValidEncoder $ from _Wrapped'
278−
279−unwrappedValidEncoder :: (Wrapped a, Applicative parse) => ValidEncoder parse a (Unwrapped a)
280−unwrappedValidEncoder = isoValidEncoder _Wrapped'
329+newtype Flip f a b = Flip { unFlip :: f b a }
281330
282−pathComponentEncoder :: forall check parse p. (Monad check, Monad parse) => (Encoder check parse (Some p) (Maybe Text)) -> (forall a. p a -> ValidEncoder parse a PageName) -> Encoder check parse (R p) PageName
283−pathComponentEncoder this rest = chainEncoder (lensEncoder (\(_, b) a -> (a, b)) Prelude.fst consValidEncoder) this rest
331+checkEnum1EncoderFunc
332+ :: forall check check' parse p r.
333+ ( Universe (Some p)
334+ , GCompare p
335+ , Monad check
336+ , Applicative check'
337+ )
338+ => (forall a. p a -> Encoder check parse a r)
339+ -> check (EncoderFunc check' parse p r)
340+checkEnum1EncoderFunc f = do
341+ (encoderImpls :: DMap p (Flip (EncoderImpl parse) r)) <- DMap.fromList <$>
342+ traverse (\(Some.This p) -> (p :=>) . Flip <$> unEncoder (f p)) universe
343+ pure $ EncoderFunc $ \p -> unsafeMkEncoder . unFlip $
344+ DMap.findWithDefault (error "checkEnum1EncoderFunc: EncoderImpl not found (should be impossible)") p encoderImpls
345+
346+-- | This type is used by pathComponentEncoder to allow the user to indicate how to treat various cases when encoding a dependent sum of type `(R p)`.
347+data SegmentResult check parse a =
348+ PathEnd (Encoder check parse a (Map Text (Maybe Text))) -- ^ Indicate that the path is finished, with an Encoder that translates the corresponding value into query parameters
349+ | PathSegment Text (Encoder check parse a PageName) -- ^ Indicate that the key should be represented by an additional path segment with the given 'Text', and give an Encoder for translating the corresponding value into the remainder of the route.
350+
351+-- | Encode a dependent sum of type `(R p)` into a PageName (i.e. the path and query part of a URL) by using the
352+-- supplied function to decide how to encode the constructors of p using the SegmentResult type. It is important
353+-- that the number of values of type `(Some p)` be relatively small in order for checking to complete quickly.
354+pathComponentEncoder
355+ :: forall check parse p.
356+ ( Universe (Some p)
357+ , GShow p
358+ , GCompare p
359+ , MonadError Text check
360+ , MonadError Text parse )
361+ => (forall a. p a -> SegmentResult check parse a)
362+ -> Encoder check parse (R p) PageName
363+pathComponentEncoder f = Encoder $ do
364+ let extractEncoder = \case
365+ PathEnd e -> first (unitEncoder []) . coidl . e
366+ PathSegment _ e -> e
367+ extractPathSegment = \case
368+ PathEnd _ -> Nothing
369+ PathSegment t _ -> Just t
370+ EncoderFunc f' <- checkEnum1EncoderFunc (extractEncoder . f)
371+ unEncoder (pathComponentEncoderImpl (enum1Encoder (extractPathSegment . f)) f')
372+
373+pathComponentEncoderImpl :: forall check parse p. (Monad check, Monad parse)
374+ => (Encoder check parse (Some p) (Maybe Text))
375+ -> (forall a. p a -> Encoder Identity parse a PageName)
376+ -> Encoder check parse (R p) PageName
377+pathComponentEncoderImpl this rest =
378+ chainEncoder (lensEncoder (\(_, b) a -> (a, b)) Prelude.fst consEncoder) this rest
284379
285380--NOTE: Naming convention in this module is to always talk about things in the *encoding* direction, never in the *decoding* direction
286381
@@ -289,34 +384,40 @@ chainEncoder
289384 ( Monad check
290385 , Monad parse
291386 )
292− => ValidEncoder parse (b, r) r
387+ => Encoder check parse (b, r) r
293388 -> Encoder check parse (Some p) b
294− -> (forall a. p a -> ValidEncoder parse a r)
389+ -> (forall a. p a -> Encoder Identity parse a r)
295390 -> Encoder check parse (R p) r
296391chainEncoder cons this rest = Encoder $ do
297− thisValid <- checkEncoder this
298− pure $ ValidEncoder
299− { _validEncoder_decode = \v -> do
300− (here, following) <- _validEncoder_decode cons v
301− Some.This r <- _validEncoder_decode thisValid here
302− (r :/) <$> _validEncoder_decode (rest r) following
303− , _validEncoder_encode = \(r :/ s) ->
304− _validEncoder_encode cons (_validEncoder_encode thisValid $ Some.This r, _validEncoder_encode (rest r) s)
392+ consValid <- unEncoder cons
393+ thisValid <- unEncoder this
394+ pure $ EncoderImpl
395+ { _encoderImpl_decode = \v -> do
396+ (here, following) <- _encoderImpl_decode consValid v
397+ Some.This r <- _encoderImpl_decode thisValid here
398+ (r :/) <$> _encoderImpl_decode (runIdentity . unEncoder $ rest r) following
399+ , _encoderImpl_encode = \(r :/ s) ->
400+ _encoderImpl_encode consValid
401+ ( _encoderImpl_encode thisValid $ Some.This r
402+ , _encoderImpl_encode (runIdentity . unEncoder $ rest r) s)
305403 }
306404
307405--TODO: Do this in terms of a lens instead
308−lensEncoder :: Monad parse => (b -> [a] -> b) -> (b -> [a]) -> ValidEncoder parse (c, [a]) [a] -> ValidEncoder parse (c, b) b
309−lensEncoder set get g = ValidEncoder
310− { _validEncoder_encode = \(ma, b) -> set b $ _validEncoder_encode g (ma, get b)
311− , _validEncoder_decode = \b -> do
312− (ma, la) <- _validEncoder_decode g $ get b
313− pure (ma, set b la)
314− }
406+lensEncoder :: (Applicative check, Monad parse)
407+ => (b -> [a] -> b) -> (b -> [a]) -> Encoder check parse (c, [a]) [a] -> Encoder check parse (c, b) b
408+lensEncoder set get g = Encoder $ do
409+ gImpl <- unEncoder g
410+ pure $ EncoderImpl
411+ { _encoderImpl_encode = \(ma, b) -> set b $ _encoderImpl_encode gImpl (ma, get b)
412+ , _encoderImpl_decode = \b -> do
413+ (ma, la) <- _encoderImpl_decode gImpl $ get b
414+ pure (ma, set b la)
415+ }
315416
316−consValidEncoder :: Applicative parse => ValidEncoder parse (Maybe a, [a]) [a] --TODO: Really shouldn't *always* have the [a], even in the Nothing case
317−consValidEncoder = ValidEncoder
318− { _validEncoder_encode = \(h, t) -> maybeToList h <> t
319− , _validEncoder_decode = pure . \case
417+consEncoder :: (Applicative check, Applicative parse) => Encoder check parse (Maybe a, [a]) [a] --TODO: Really shouldn't *always* have the [a], even in the Nothing case
418+consEncoder = unsafeMkEncoder $ EncoderImpl
419+ { _encoderImpl_encode = \(h, t) -> maybeToList h <> t
420+ , _encoderImpl_decode = pure . \case
320421 [] -> (Nothing, [])
321422 h:t -> (Just h, t)
322423 }
@@ -336,31 +437,31 @@ shadowEncoder
336437 -> Encoder check parse b c -- ^ Gets overlapped
337438 -> Encoder check parse (Either a b) c
338439shadowEncoder f g = Encoder $ do
339− vf <- checkEncoder f
340− vg <- checkEncoder g
341− let gCanParse c = catchError (Just <$> _validEncoder_decode vg c) (\_ -> pure Nothing)
440+ vf <- unEncoder f
441+ vg <- unEncoder g
442+ let gCanParse c = catchError (Just <$> _encoderImpl_decode vg c) (\_ -> pure Nothing)
342443 overlaps <- fmap catMaybes $ forM universe $ \a -> do
343− let c = _validEncoder_encode vf a
444+ let c = _encoderImpl_encode vf a
344445 mb <- gCanParse c
345446 pure $ fmap (\b -> (a, b, c)) mb
346447 case overlaps of
347448 [] -> pure ()
348449 _ -> throwError $ "shadowEncoder: overlap detected: " <> T.unlines
349450 (flip fmap overlaps $ \(a, b, c) -> "first encoder encodes " <> tshow a <> " as " <> tshow c <> ", which second encoder decodes as " <> tshow b)
350− pure $ ValidEncoder
351− { _validEncoder_encode = \case
352− Left a -> _validEncoder_encode vf a
353− Right b -> _validEncoder_encode vg b
354− , _validEncoder_decode = \c -> (Left <$> _validEncoder_decode vf c) `catchError` \_ -> Right <$> _validEncoder_decode vg c
451+ pure $ EncoderImpl
452+ { _encoderImpl_encode = \case
453+ Left a -> _encoderImpl_encode vf a
454+ Right b -> _encoderImpl_encode vg b
455+ , _encoderImpl_decode = \c -> (Left <$> _encoderImpl_decode vf c) `catchError` \_ -> Right <$> _encoderImpl_decode vg c
355456 }
356457
357458enum1Encoder
358459 :: ( Universe (Some p)
359460 , GShow p
360461 , GCompare p
361− , Ord r
362462 , MonadError Text check
363463 , MonadError Text parse
464+ , Ord r
364465 , Show r
365466 )
366467 => (forall a. p a -> r) -> Encoder check parse (Some p) r
@@ -381,40 +482,40 @@ enumEncoder f = Encoder $ do
381482 case itraverse checkSingleton reversed :: Validation (Map r (Set p)) (Map r p) of
382483 Failure ambiguousEntries -> throwError $ T.unlines $
383484 "enumEncoder: ambiguous encodings detected:" : concat (Map.elems $ imap showRedundant ambiguousEntries)
384− Success m -> pure $ ValidEncoder
385− { _validEncoder_decode = \r -> case Map.lookup r m of
485+ Success m -> pure $ EncoderImpl
486+ { _encoderImpl_decode = \r -> case Map.lookup r m of
386487 Just a -> pure a
387488 Nothing -> throwError $ "enumEncoder: not recognized: " <> tshow r --TODO: Report this as a better type
388− , _validEncoder_encode = f
489+ , _encoderImpl_encode = f
389490 }
390491
391−endValidEncoder :: (MonadError Text parse, Show r, Eq r) => r -> ValidEncoder parse () r
392−endValidEncoder expected = ValidEncoder
393− { _validEncoder_decode = \obtained ->
492+unitEncoder :: (Applicative check, MonadError Text parse, Show r, Eq r) => r -> Encoder check parse () r
493+unitEncoder expected = unsafeMkEncoder $ EncoderImpl
494+ { _encoderImpl_decode = \obtained ->
394495 if obtained == expected
395496 then pure ()
396− else throwError $ "endValidEncoder: expected " <> tshow expected <> ", got " <> tshow obtained
397− , _validEncoder_encode = \_ -> expected
497+ else throwError $ "endEncoderImpl: expected " <> tshow expected <> ", got " <> tshow obtained
498+ , _encoderImpl_encode = \_ -> expected
398499 }
399500
400−singlePathSegmentValidEncoder :: MonadError Text parse => ValidEncoder parse Text PageName
401−singlePathSegmentValidEncoder = pathOnlyValidEncoder . singletonListValidEncoder
501+singlePathSegmentEncoder :: (Applicative check, MonadError Text parse) => Encoder check parse Text PageName
502+singlePathSegmentEncoder = pathOnlyEncoder . singletonListEncoder
402503
403−pathOnlyValidEncoder :: (MonadError Text parse) => ValidEncoder parse [Text] PageName
404−pathOnlyValidEncoder = ValidEncoder
405− { _validEncoder_decode = \(path, query) ->
504+pathOnlyEncoder :: (Applicative check, MonadError Text parse) => Encoder check parse [Text] PageName
505+pathOnlyEncoder = unsafeMkEncoder $ EncoderImpl
506+ { _encoderImpl_decode = \(path, query) ->
406507 if query == mempty
407508 then pure path
408− else throwError "pathOnlyValidEncoder: query was provided"
409− , _validEncoder_encode = \path -> (path, mempty)
509+ else throwError "pathOnlyEncoderImpl: query was provided"
510+ , _encoderImpl_encode = \path -> (path, mempty)
410511 }
411512
412−singletonListValidEncoder :: (MonadError Text parse) => ValidEncoder parse a [a]
413−singletonListValidEncoder = ValidEncoder
414− { _validEncoder_decode = \case
513+singletonListEncoder :: (Applicative check, MonadError Text parse) => Encoder check parse a [a]
514+singletonListEncoder = unsafeMkEncoder $ EncoderImpl
515+ { _encoderImpl_decode = \case
415516 [a] -> pure a
416− l -> throwError $ "singletonListValidEncoder: expected one item, got " <> tshow (length l)
417− , _validEncoder_encode = (:[])
517+ l -> throwError $ "singletonListEncoderImpl: expected one item, got " <> tshow (length l)
518+ , _encoderImpl_encode = (:[])
418519 }
419520
420521splitTextNonEmpty :: Text -> Text -> NonEmpty Text
@@ -423,18 +524,18 @@ splitTextNonEmpty separator v = case T.splitOn separator v of
423524 h : t -> h :| t
424525
425526--TODO: To know this is reversible, we must know that the separator isn't included anywhere in the input text
426−pathSegmentsTextEncoder :: (MonadError Text check, Applicative parse) => Encoder check parse (NonEmpty Text) Text
427−pathSegmentsTextEncoder = Encoder $ pure $ ValidEncoder
428− { _validEncoder_encode = T.intercalate "/" . fmap (urlEncodeText False) . toList
429− , _validEncoder_decode = pure . fmap (urlDecodeText False) . splitTextNonEmpty "/"
527+pathSegmentsTextEncoder :: (Applicative check, Applicative parse) => Encoder check parse (NonEmpty Text) Text
528+pathSegmentsTextEncoder = unsafeMkEncoder $ EncoderImpl
529+ { _encoderImpl_encode = T.intercalate "/" . fmap (urlEncodeText False) . toList
530+ , _encoderImpl_decode = pure . fmap (urlDecodeText False) . splitTextNonEmpty "/"
430531 }
431532
432533queryParametersTextEncoder :: (Applicative check, Applicative parse) => Encoder check parse [(Text, Maybe Text)] Text
433−queryParametersTextEncoder = Encoder $ pure $ ValidEncoder
434− { _validEncoder_encode = \case
534+queryParametersTextEncoder = Encoder $ pure $ EncoderImpl
535+ { _encoderImpl_encode = \case
435536 [] -> ""
436537 params -> T.intercalate "&" (fmap encodeParameter params)
437− , _validEncoder_decode = pure . \case
538+ , _encoderImpl_decode = pure . \case
438539 "" -> []
439540 encoded ->
440541 let h :| t = splitTextNonEmpty "&" encoded
@@ -456,30 +557,30 @@ urlDecodeText :: Bool -> Text -> Text
456557urlDecodeText q = decodeUtf8 . urlDecode q . encodeUtf8
457558
458559listToNonEmptyEncoder :: (Applicative check, Applicative parse, Monoid a, Eq a) => Encoder check parse [a] (NonEmpty a)
459−listToNonEmptyEncoder = Encoder $ pure $ ValidEncoder
460− { _validEncoder_encode = \case
560+listToNonEmptyEncoder = Encoder $ pure $ EncoderImpl
561+ { _encoderImpl_encode = \case
461562 [] -> mempty :| []
462563 h : t -> h :| t
463− , _validEncoder_decode = \(h :| t) -> pure $
564+ , _encoderImpl_decode = \(h :| t) -> pure $
464565 if h == mempty
465566 then []
466567 else h : t
467568 }
468569
469570prefixTextEncoder :: (Applicative check, MonadError Text parse) => Text -> Encoder check parse Text Text
470−prefixTextEncoder p = Encoder $ pure $ ValidEncoder
471− { _validEncoder_encode = mappend p
472− , _validEncoder_decode = \v -> case T.stripPrefix p v of
571+prefixTextEncoder p = Encoder $ pure $ EncoderImpl
572+ { _encoderImpl_encode = mappend p
573+ , _encoderImpl_decode = \v -> case T.stripPrefix p v of
473574 Nothing -> throwError $ "prefixTextEncoder: wrong prefix; expected " <> tshow p <> ", got " <> tshow (T.take (T.length p) v)
474575 Just stripped -> pure stripped
475576 }
476577
477578prefixNonemptyTextEncoder :: (Applicative check, MonadError Text parse) => Text -> Encoder check parse Text Text
478−prefixNonemptyTextEncoder p = Encoder $ pure $ ValidEncoder
479− { _validEncoder_encode = \case
579+prefixNonemptyTextEncoder p = Encoder $ pure $ EncoderImpl
580+ { _encoderImpl_encode = \case
480581 "" -> ""
481582 v -> p <> v
482− , _validEncoder_decode = \case
583+ , _encoderImpl_decode = \case
483584 "" -> pure ""
484585 v -> case T.stripPrefix p v of
485586 Nothing -> throwError $ "prefixTextEncoder: wrong prefix; expected " <> tshow p
@@ -487,23 +588,23 @@ prefixNonemptyTextEncoder p = Encoder $ pure $ ValidEncoder
487588 }
488589
489590unpackTextEncoder :: (Applicative check, Applicative parse) => Encoder check parse Text String
490−unpackTextEncoder = Encoder $ pure $ ValidEncoder
491− { _validEncoder_encode = T.unpack
492− , _validEncoder_decode = pure . T.pack
591+unpackTextEncoder = Encoder $ pure $ EncoderImpl
592+ { _encoderImpl_encode = T.unpack
593+ , _encoderImpl_decode = pure . T.pack
493594 }
494595
495596toListMapEncoder :: (Applicative check, Applicative parse, Ord k) => Encoder check parse (Map k v) [(k, v)]
496−toListMapEncoder = Encoder $ pure $ ValidEncoder
497− { _validEncoder_encode = Map.toList
498− , _validEncoder_decode = pure . Map.fromList --TODO: Should we be stricter about repeated keys?
597+toListMapEncoder = Encoder $ pure $ EncoderImpl
598+ { _encoderImpl_encode = Map.toList
599+ , _encoderImpl_decode = pure . Map.fromList --TODO: Should we be stricter about repeated keys?
499600 }
500601
501602joinPairTextEncoder :: (MonadError Text check, MonadError Text parse) => Text -> Encoder check parse (Text, Text) Text
502603joinPairTextEncoder = Encoder . \case
503604 "" -> throwError "joinPairTextEncoder: empty separator"
504− separator -> pure $ ValidEncoder
505− { _validEncoder_encode = \(k, v) -> k <> separator <> v
506− , _validEncoder_decode = \r ->
605+ separator -> pure $ EncoderImpl
606+ { _encoderImpl_encode = \(k, v) -> k <> separator <> v
607+ , _encoderImpl_decode = \r ->
507608 let (kt, vt) = T.breakOn separator r
508609 in case vt of
509610 -- The separator was not found
@@ -516,137 +617,121 @@ joinPairTextEncoder = Encoder . \case
516617rPrism :: forall f g. (forall a. Prism' (f a) (g a)) -> Prism' (R f) (R g)
517618rPrism p = prism (\(g :/ x) -> g ^. re p :/ x) (\(f :/ x) -> bimap (:/ x) (:/ x) $ matching p f)
518619
519−-- An encoder that only works on the items available via the prism
520−prismValidEncoder :: MonadError Text parse => Prism' b a -> ValidEncoder parse a b
521−prismValidEncoder p = ValidEncoder
522− { _validEncoder_encode = (^. re p)
523− , _validEncoder_decode = \r -> case r ^? p of
620+-- | An encoder that only works on the items available via the prism. An error will be thrown in the parse monad
621+-- if the prism doesn't match.
622+prismEncoder :: (Applicative check, MonadError Text parse) => Prism' b a -> Encoder check parse a b
623+prismEncoder p = unsafeMkEncoder $ EncoderImpl
624+ { _encoderImpl_encode = (^. re p)
625+ , _encoderImpl_decode = \r -> case r ^? p of
524626 Just a -> pure a
525− Nothing -> throwError "prismValidEncoder: value is not present in the prism"
627+ Nothing -> throwError "prismEncoder: value is not present in the prism"
526628 }
527629
630+-- | A URL path and query string, in which trailing slashes don't matter in the path
631+-- and duplicate query parameters are not allowed. A final goal of encoders using this library
632+-- will frequently be to produce this.
633+type PageName = ([Text], Map Text (Maybe Text))
528634
529−-- | Encode a PageName into a path and query string, suitable for use in the
530−-- 'URI' type
531−pageNameValidEncoder :: MonadError Text parse => ValidEncoder parse PageName (String, String)
532−pageNameValidEncoder = ve
533− where Right ve = checkEncoder $ bimap
534− (unpackTextEncoder . prefixTextEncoder "/" . pathSegmentsTextEncoder . listToNonEmptyEncoder)
535− (unpackTextEncoder . prefixNonemptyTextEncoder "?" . queryParametersTextEncoder . toListMapEncoder)
536−
537−catchValidEncoder :: (e -> a) -> ValidEncoder (Either e) a b -> ValidEncoder Identity a b
538−catchValidEncoder recover ve = ve
539− { _validEncoder_decode = \a -> pure $ case _validEncoder_decode ve a of
635+-- | A path (separated by slashes), and a query string.
636+type PathQuery = (String, String)
637+
638+-- | Encode a PageName into a path and query string.
639+pageNameEncoder :: (Applicative check, MonadError Text parse) => Encoder check parse PageName PathQuery
640+pageNameEncoder = bimap
641+ (unpackTextEncoder . prefixTextEncoder "/" . pathSegmentsTextEncoder . listToNonEmptyEncoder)
642+ (unpackTextEncoder . prefixNonemptyTextEncoder "?" . queryParametersTextEncoder . toListMapEncoder)
643+
644+-- | Handle an error in parsing, for example, in order to redirect to a 404 page.
645+handleEncoder
646+ :: (Functor check)
647+ => (e -> a)
648+ -> Encoder check (Either e) a b
649+ -> Encoder check Identity a b
650+handleEncoder recover e = Encoder $ do
651+ i <- unEncoder e
652+ return $ i
653+ { _encoderImpl_decode = \a -> pure $ case _encoderImpl_decode i a of
540654 Right r -> r
541655 Left err -> recover err
542− }
656+ }
543657
544658--------------------------------------------------------------------------------
545659-- Actual obelisk route info
546660--------------------------------------------------------------------------------
547661
662+-- | A type which can represent Obelisk-specific resource routes, in addition to application specific routes which serve your
663+-- frontend.
548664data ObeliskRoute :: (* -> *) -> * -> * where
549665 -- We need to have the `f a` as an argument here, because otherwise we have no way to specifically check for overlap between us and the given encoder
550666 ObeliskRoute_App :: f a -> ObeliskRoute f a
551667 ObeliskRoute_Resource :: ResourceRoute a -> ObeliskRoute f a
552668
669+instance Universe (Some f) => Universe (Some (ObeliskRoute f)) where
670+ universe = fmap (\(Some.This x) -> Some.This (ObeliskRoute_App x)) universe
671+ ++ fmap (\(Some.This x) -> Some.This (ObeliskRoute_Resource x)) universe
672+
673+instance GEq f => GEq (ObeliskRoute f) where
674+ geq (ObeliskRoute_App x) (ObeliskRoute_App y) = geq x y
675+ geq (ObeliskRoute_Resource x) (ObeliskRoute_Resource y) = geq x y
676+ geq _ _ = Nothing
677+
678+instance GCompare f => GCompare (ObeliskRoute f) where
679+ gcompare (ObeliskRoute_App x) (ObeliskRoute_App y) = gcompare x y
680+ gcompare (ObeliskRoute_Resource x) (ObeliskRoute_Resource y) = gcompare x y
681+ gcompare (ObeliskRoute_App _) (ObeliskRoute_Resource _) = GLT
682+ gcompare (ObeliskRoute_Resource _) (ObeliskRoute_App _) = GGT
683+
684+-- | A type representing the various resource routes served by Obelisk. These can in principle map to any physical routes you want,
685+-- but sane defaults are provided by 'resourceRouteSegment'
553686data ResourceRoute :: * -> * where
554687 ResourceRoute_Static :: ResourceRoute [Text] -- This [Text] represents the *path in our static files directory*, not necessarily the URL path that the asset gets served at (although that will often be "/static/this/text/thing")
555688 ResourceRoute_Ghcjs :: ResourceRoute [Text]
556689 ResourceRoute_JSaddleWarp :: ResourceRoute (R JSaddleWarpRoute)
557690
558−--TODO: Figure out a way to check this
559−obeliskComponentEncoder :: (Applicative check, Applicative parse) => Encoder check parse (Some (ObeliskRoute f)) (Either (Some ResourceRoute) (Some f))
560−obeliskComponentEncoder = Encoder $ pure $ ValidEncoder
561− { _validEncoder_encode = \(Some.This o) -> case o of
562− ObeliskRoute_App r -> Right $ Some.This r
563− ObeliskRoute_Resource r -> Left $ Some.This r
564− , _validEncoder_decode = pure . \case
565− Right (Some.This r) -> Some.This $ ObeliskRoute_App r
566− Left (Some.This r) -> Some.This $ ObeliskRoute_Resource r
567− }
568−
569−newtype ValidEncoderFunc parse p r = ValidEncoderFunc { runValidEncoderFunc :: forall a. p a -> ValidEncoder parse a r }
570−
571−checkEnum1EncoderFunc
572− :: forall check parse p r.
573− ( Universe (Some p)
574− , GCompare p
575− , Monad check
576− )
577− => (forall a. p a -> Encoder check parse a r)
578− -> check (ValidEncoderFunc parse p r)
579−checkEnum1EncoderFunc f = do
580− validEncoders :: DMap p (Flip (ValidEncoder parse) r) <- DMap.fromList <$> traverse (\(Some.This p) -> (p :=>) . Flip <$> checkEncoder (f p)) universe
581− pure $ ValidEncoderFunc $ \p -> unFlip $ DMap.findWithDefault (error "checkEnum1EncoderFunc: ValidEncoder not found (should be impossible)") p validEncoders
582−
583−obeliskRouteEncoder
584− :: forall check parse appRoute.
585− ( Universe (Some appRoute)
586− , GCompare appRoute
691+-- | If there are no additional backend routes in your app (i.e. ObeliskRoute gives you all the routes you need),
692+-- this constructs a suitable 'Encoder' to use for encoding routes to 'PageName's. If you do have additional backend routes,
693+-- you'll want to use 'pathComponentEncoder' yourself, applied to a function that will likely use obeliskRouteSegment in order to
694+-- handle the ObeliskRoute case (i.e. Obelisk resource routes and app frontend routes).
695+obeliskRouteEncoder :: forall check parse appRoute.
696+ ( Universe (Some (ObeliskRoute appRoute))
697+ , GCompare (ObeliskRoute appRoute)
587698 , GShow appRoute
588699 , MonadError Text check
589700 , check ~ parse --TODO: Get rid of this
590701 )
591− => (Encoder check parse (Some appRoute) (Maybe Text))
592− -> (forall a. appRoute a -> Encoder check parse a PageName)
702+ => (forall a. appRoute a -> SegmentResult check parse a)
593703 -> Encoder check parse (R (ObeliskRoute appRoute)) PageName
594−obeliskRouteEncoder appComponentEncoder appRouteEncoder = Encoder $ do
595− let componentEncoder = obeliskRouteComponentEncoder appComponentEncoder
596− restEncoder <- checkObeliskRouteRestEncoder appRouteEncoder
597− checkEncoder $ pathComponentEncoder componentEncoder $ runValidEncoderFunc restEncoder
598−
599−checkObeliskRouteRestEncoder
600− :: ( MonadError Text check
601− , MonadError Text parse
602− , Universe (Some appRoute)
603− , GCompare appRoute
604− )
605− => (forall a. appRoute a -> Encoder check parse a PageName)
606− -> check (ValidEncoderFunc parse (ObeliskRoute appRoute) PageName)
607−checkObeliskRouteRestEncoder appRouteEncoder = do
608− appRouteValidEncoder <- checkEnum1EncoderFunc appRouteEncoder
609− resourceRouteValidEncoder <- checkEnum1EncoderFunc resourceRouteEncoder
610− return $ ValidEncoderFunc $ \case
611− ObeliskRoute_App appRoute -> runValidEncoderFunc appRouteValidEncoder appRoute
612− ObeliskRoute_Resource resRoute -> runValidEncoderFunc resourceRouteValidEncoder resRoute
613−
614−obeliskRouteComponentEncoder
615− :: ( MonadError Text parse
616− , GShow appRoute
617− , check ~ parse
618− )
619− => Encoder check parse (Some appRoute) (Maybe Text) -> Encoder check parse (Some (ObeliskRoute appRoute)) (Maybe Text)
620−obeliskRouteComponentEncoder appComponentEncoder = (resourceComponentEncoder `shadowEncoder` appComponentEncoder) . obeliskComponentEncoder
621−
622−resourceComponentEncoder :: (MonadError Text check, MonadError Text parse) => Encoder check parse (Some ResourceRoute) (Maybe Text)
623−resourceComponentEncoder = enum1Encoder $ \case
624− ResourceRoute_Static -> Just "static"
625− ResourceRoute_Ghcjs -> Just "ghcjs"
626− ResourceRoute_JSaddleWarp -> Just "jsaddle"
627−
628−resourceRouteEncoder :: (MonadError Text check, MonadError Text parse) => ResourceRoute a -> Encoder check parse a PageName
629−resourceRouteEncoder = \case
630− ResourceRoute_Static -> Encoder $ pure pathOnlyValidEncoder
631− ResourceRoute_Ghcjs -> Encoder $ pure pathOnlyValidEncoder
632− ResourceRoute_JSaddleWarp -> jsaddleWarpRouteEncoder
704+obeliskRouteEncoder appRouteSegment = pathComponentEncoder (obeliskRouteSegment appRouteSegment)
705+
706+-- | From a function which explains how app-specific frontend routes translate into segments, produce a function which does the
707+-- same for ObeliskRoute. This uses the given function for the 'ObeliskRoute_App' case, and 'resourceRouteSegment' for the
708+-- 'ObeliskRoute_Resource' case.
709+obeliskRouteSegment :: forall check parse appRoute.
710+ (MonadError Text check, MonadError Text parse)
711+ => (forall a. appRoute a -> SegmentResult check parse a)
712+ -> (forall a. ObeliskRoute appRoute a -> SegmentResult check parse a)
713+obeliskRouteSegment appRouteSegment = \case
714+ ObeliskRoute_App appRoute -> appRouteSegment appRoute
715+ ObeliskRoute_Resource resourceRoute -> resourceRouteSegment resourceRoute
716+
717+-- | A function which gives a sane default for how to encode Obelisk resource routes. It's given in this form, because it will
718+-- be combined with other such segment encoders before 'pathComponentEncoder' turns it into a proper 'Encoder'.
719+resourceRouteSegment :: (MonadError Text check, MonadError Text parse) => ResourceRoute a -> SegmentResult check parse a
720+resourceRouteSegment = \case
721+ ResourceRoute_Static -> PathSegment "static" $ pathOnlyEncoder
722+ ResourceRoute_Ghcjs -> PathSegment "ghcjs" $ pathOnlyEncoder
723+ ResourceRoute_JSaddleWarp -> PathSegment "jsaddle" $ jsaddleWarpRouteEncoder
633724
634725data JSaddleWarpRoute :: * -> * where
635726 JSaddleWarpRoute_JavaScript :: JSaddleWarpRoute ()
636727 JSaddleWarpRoute_WebSocket :: JSaddleWarpRoute ()
637728 JSaddleWarpRoute_Sync :: JSaddleWarpRoute [Text]
638729
639−jsaddleWarpRouteComponentEncoder :: (MonadError Text check, MonadError Text parse) => Encoder check parse (Some JSaddleWarpRoute) (Maybe Text)
640−jsaddleWarpRouteComponentEncoder = enum1Encoder $ \case
641− JSaddleWarpRoute_JavaScript -> Just "jsaddle.js"
642− JSaddleWarpRoute_WebSocket -> Nothing
643− JSaddleWarpRoute_Sync -> Just "sync"
644−
645730jsaddleWarpRouteEncoder :: (MonadError Text check, MonadError Text parse) => Encoder check parse (R JSaddleWarpRoute) PageName
646−jsaddleWarpRouteEncoder = pathComponentEncoder jsaddleWarpRouteComponentEncoder $ \case
647− JSaddleWarpRoute_JavaScript -> endValidEncoder mempty
648− JSaddleWarpRoute_WebSocket -> endValidEncoder mempty
649− JSaddleWarpRoute_Sync -> pathOnlyValidEncoder
731+jsaddleWarpRouteEncoder = pathComponentEncoder $ \case
732+ JSaddleWarpRoute_JavaScript -> PathSegment "jsaddle.js" $ unitEncoder mempty
733+ JSaddleWarpRoute_WebSocket -> PathEnd $ unitEncoder mempty
734+ JSaddleWarpRoute_Sync -> PathSegment "sync" $ pathOnlyEncoder
650735
651736instance GShow appRoute => GShow (ObeliskRoute appRoute) where
652737 gshowsPrec prec = \case
@@ -655,32 +740,22 @@ instance GShow appRoute => GShow (ObeliskRoute appRoute) where
655740 ObeliskRoute_Resource appRoute -> showParen (prec > 10) $
656741 showString "ObeliskRoute_Resource " . gshowsPrec 11 appRoute
657742
658−
659743data IndexOnlyRoute :: * -> * where
660744 IndexOnlyRoute :: IndexOnlyRoute ()
661745
662−indexOnlyRouteComponentEncoder :: (MonadError Text check, MonadError Text parse) => Encoder check parse (Some IndexOnlyRoute) (Maybe Text)
663−indexOnlyRouteComponentEncoder = enum1Encoder $ \case
664− IndexOnlyRoute -> Nothing
665−
666−indexOnlyRouteRestEncoder :: (Applicative check, MonadError Text parse) => IndexOnlyRoute a -> Encoder check parse a PageName
667−indexOnlyRouteRestEncoder = \case
668− IndexOnlyRoute -> Encoder $ pure $ constLaxValidEncoder mempty
746+indexOnlyRouteSegment :: (Applicative check, MonadError Text parse) => IndexOnlyRoute a -> SegmentResult check parse a
747+indexOnlyRouteSegment = \case
748+ IndexOnlyRoute -> PathEnd $ unitEncoder mempty
669749
670−--TODO: Come up with a naming scheme that is better at describing how permissive
671−--versus strict things are
672−constLaxValidEncoder :: Applicative parse => a -> ValidEncoder parse () a
673−constLaxValidEncoder a = ValidEncoder
674− { _validEncoder_encode = \_ -> a
675− , _validEncoder_decode = \_ -> pure ()
676− }
750+indexOnlyRouteEncoder :: (MonadError Text check, MonadError Text parse) => Encoder check parse (R IndexOnlyRoute) PageName
751+indexOnlyRouteEncoder = pathComponentEncoder indexOnlyRouteSegment
677752
678753someSumEncoder :: (Applicative check, Applicative parse) => Encoder check parse (Some (Sum a b)) (Either (Some a) (Some b))
679−someSumEncoder = Encoder $ pure $ ValidEncoder
680− { _validEncoder_encode = \(Some.This t) -> case t of
754+someSumEncoder = Encoder $ pure $ EncoderImpl
755+ { _encoderImpl_encode = \(Some.This t) -> case t of
681756 InL l -> Left $ Some.This l
682757 InR r -> Right $ Some.This r
683− , _validEncoder_decode = pure . \case
758+ , _encoderImpl_decode = pure . \case
684759 Left (Some.This l) -> Some.This (InL l)
685760 Right (Some.This r) -> Some.This (InR r)
686761 }
@@ -691,23 +766,23 @@ instance Universe (Some Void1) where
691766 universe = []
692767
693768void1Encoder :: (Applicative check, MonadError Text parse) => Encoder check parse (Some Void1) a
694−void1Encoder = Encoder $ pure $ ValidEncoder
695− { _validEncoder_encode = \case
769+void1Encoder = Encoder $ pure $ EncoderImpl
770+ { _encoderImpl_encode = \case
696771 Some.This f -> case f of {}
697− , _validEncoder_decode = \_ -> throwError "void1Encoder: can't decode anything"
772+ , _encoderImpl_decode = \_ -> throwError "void1Encoder: can't decode anything"
698773 }
699774
700775instance GShow Void1 where
701776 gshowsPrec _ = \case {}
702777
703−makePrisms ''ObeliskRoute
704−
705778concat <$> mapM deriveRouteComponent
706779 [ ''ResourceRoute
707780 , ''JSaddleWarpRoute
708781 , ''IndexOnlyRoute
709782 ]
710783
784+makePrisms ''ObeliskRoute
785+
711786deriveGEq ''Void1
712787deriveGCompare ''Void1
713788