git.iko.soy/obelisk
on master help sign in
More route cleanup
7763d8dRyan Trinkle
lib/route/src/Obelisk/Route.hs+82−21
compare with master
unifiedsplit
@@ -25,6 +25,7 @@ module Obelisk.Route
25 , mapSome
25 , mapSome
26 , pathComponentEncoder
26 , pathComponentEncoder
27 , enumEncoder
27 , enumEncoder
28+ , enum1Encoder
28 , endValidEncoder
29 , endValidEncoder
29 , pathOnlyValidEncoder
30 , pathOnlyValidEncoder
30 , singletonListValidEncoder
31 , singletonListValidEncoder
@@ -40,7 +41,7 @@ module Obelisk.Route
40 , rPrism
41 , rPrism
41 , obeliskRouteEncoder
42 , obeliskRouteEncoder
42 , _ObeliskRoute_App
43 , _ObeliskRoute_App
43− , _ObeliskRoute_Static
44+ , _ObeliskRoute_Resource
44 ) where
45 ) where
45
46
46import Prelude hiding ((.), id)
47import Prelude hiding ((.), id)
@@ -157,6 +158,13 @@ instance Monad parse => Bifunctor (,) (ValidEncoder parse) (ValidEncoder parse)
157 , _validEncoder_decode = \(a, b) -> liftA2 (,) (_validEncoder_decode f a) (_validEncoder_decode g b)
158 , _validEncoder_decode = \(a, b) -> liftA2 (,) (_validEncoder_decode f a) (_validEncoder_decode g b)
158 }
159 }
159
160
161+instance (Applicative check, Monad parse) => PFunctor (,) (Encoder check parse) (Encoder check parse) where
162+ first f = bimap f id
163+instance (Applicative check, Monad parse) => QFunctor (,) (Encoder check parse) (Encoder check parse) where
164+ second g = bimap id g
165+instance (Applicative check, Monad parse) => Bifunctor (,) (Encoder check parse) (Encoder check parse) (Encoder check parse) where
166+ bimap f g = Encoder $ liftA2 bimap (checkEncoder f) (checkEncoder g)
167+
160instance (Traversable f, Monad check, Monad parse) => Cat.Functor f (Encoder check parse) (Encoder check parse) where
168instance (Traversable f, Monad check, Monad parse) => Cat.Functor f (Encoder check parse) (Encoder check parse) where
161 fmap e = Encoder $ do
169 fmap e = Encoder $ do
162 ve <- checkEncoder e
170 ve <- checkEncoder e
@@ -228,8 +236,8 @@ shadowEncoder
228 , Show c
236 , Show c
229 , check ~ parse --TODO: Get rid of this
237 , check ~ parse --TODO: Get rid of this
230 )
238 )
231− => Encoder check parse a c
239+ => Encoder check parse a c -- ^ Overlaps
232− -> Encoder check parse b c
240+ -> Encoder check parse b c -- ^ Gets overlapped
233 -> Encoder check parse (Either a b) c
241 -> Encoder check parse (Either a b) c
234shadowEncoder f g = Encoder $ do
242shadowEncoder f g = Encoder $ do
235 vf <- checkEncoder f
243 vf <- checkEncoder f
@@ -250,6 +258,18 @@ shadowEncoder f g = Encoder $ do
250 , _validEncoder_decode = \c -> (Left <$> _validEncoder_decode vf c) `catchError` \_ -> Right <$> _validEncoder_decode vg c
258 , _validEncoder_decode = \c -> (Left <$> _validEncoder_decode vf c) `catchError` \_ -> Right <$> _validEncoder_decode vg c
251 }
259 }
252
260
261+enum1Encoder
262+ :: ( Universe (Some p)
263+ , GShow p
264+ , GCompare p
265+ , Ord r
266+ , MonadError Text check
267+ , MonadError Text parse
268+ , Show r
269+ )
270+ => (forall a. p a -> r) -> Encoder check parse (Some p) r
271+enum1Encoder f = enumEncoder $ \(Some.This p) -> f p
272+
253-- | Encode an enumerable, bounded type. WARNING: Don't use this on types that
273-- | Encode an enumerable, bounded type. WARNING: Don't use this on types that
254-- have a large number of values - it will use a lot of memory.
274-- have a large number of values - it will use a lot of memory.
255enumEncoder :: forall parse check p r. (Universe p, Show p, Ord p, Ord r, MonadError Text parse, MonadError Text check, Show r) => (p -> r) -> Encoder check parse p r
275enumEncoder :: forall parse check p r. (Universe p, Show p, Ord p, Ord r, MonadError Text parse, MonadError Text check, Show r) => (p -> r) -> Encoder check parse p r
@@ -386,7 +406,27 @@ prismValidEncoder p = ValidEncoder
386data ObeliskRoute :: (* -> *) -> * -> * where
406data ObeliskRoute :: (* -> *) -> * -> * where
387 -- 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
407 -- 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
388 ObeliskRoute_App :: f a -> ObeliskRoute f a
408 ObeliskRoute_App :: f a -> ObeliskRoute f a
409+ ObeliskRoute_Resource :: ResourceRoute a -> ObeliskRoute f a
410+
411+data ResourceRoute :: * -> * where
389− ObeliskRoute_Static :: ObeliskRoute f [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")
412+ 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")
413+
414+--TODO: Generate this
415+instance Universe (Some ResourceRoute) where
416+ universe =
417+ [ Some.This ResourceRoute_Static
418+ ]
419+
420+--TODO: Figure out a way to check this
421+obeliskComponentEncoder :: (Applicative check, Applicative parse) => Encoder check parse (Some (ObeliskRoute f)) (Either (Some ResourceRoute) (Some f))
422+obeliskComponentEncoder = Encoder $ pure $ ValidEncoder
423+ { _validEncoder_encode = \(Some.This o) -> case o of
424+ ObeliskRoute_App r -> Right $ Some.This r
425+ ObeliskRoute_Resource r -> Left $ Some.This r
426+ , _validEncoder_decode = pure . \case
427+ Right (Some.This r) -> Some.This $ ObeliskRoute_App r
428+ Left (Some.This r) -> Some.This $ ObeliskRoute_Resource r
429+ }
390
430
391newtype ValidEncoderFunc parse p r = ValidEncoderFunc { unValidEncoderFunc :: forall a. p a -> ValidEncoder parse a r }
431newtype ValidEncoderFunc parse p r = ValidEncoderFunc { unValidEncoderFunc :: forall a. p a -> ValidEncoder parse a r }
392
432
@@ -409,48 +449,69 @@ obeliskRouteEncoder
409 , GShow appRoute
449 , GShow appRoute
410 , MonadError Text check
450 , MonadError Text check
411 , MonadError Text parse
451 , MonadError Text parse
452+ , check ~ parse --TODO: Get rid of this
412 )
453 )
413− => (Some appRoute -> Maybe Text)
454+ => (Encoder check parse (Some appRoute) (Maybe Text))
414 -> (forall a. appRoute a -> Encoder check parse a PageName)
455 -> (forall a. appRoute a -> Encoder check parse a PageName)
415 -> Encoder check parse (R (ObeliskRoute appRoute)) PageName
456 -> Encoder check parse (R (ObeliskRoute appRoute)) PageName
416−obeliskRouteEncoder showAppRoute appRouteEncoder = Encoder $ do
457+obeliskRouteEncoder appComponentEncoder appRouteEncoder = Encoder $ do
417 ValidEncoderFunc appRouteValidEncoder <- checkSomeUniverseEncoder appRouteEncoder
458 ValidEncoderFunc appRouteValidEncoder <- checkSomeUniverseEncoder appRouteEncoder
459+ let componentEncoder =
460+ (
461+ resourceComponentEncoder
462+ `shadowEncoder`
463+ appComponentEncoder
464+ )
465+ .
466+ obeliskComponentEncoder
418− checkEncoder $ pathComponentEncoder (enumEncoder (showRoute showAppRoute)) $ \case
467+ checkEncoder $ pathComponentEncoder componentEncoder $ \case
419 ObeliskRoute_App appRoute -> appRouteValidEncoder appRoute
468 ObeliskRoute_App appRoute -> appRouteValidEncoder appRoute
469+ ObeliskRoute_Resource resRoute -> resourceRouteValidEncoder resRoute
470+
471+resourceComponentEncoder :: (MonadError Text check, MonadError Text parse) => Encoder check parse (Some ResourceRoute) (Maybe Text)
472+resourceComponentEncoder = enum1Encoder $ \case
473+ ResourceRoute_Static -> Just "static"
474+
475+resourceRouteValidEncoder :: MonadError Text parse => ResourceRoute a -> ValidEncoder parse a PageName
476+resourceRouteValidEncoder = \case
420− ObeliskRoute_Static -> pathOnlyValidEncoder
477+ ResourceRoute_Static -> pathOnlyValidEncoder
421
478
422instance ShowTag appRoute Identity => ShowTag (ObeliskRoute appRoute) Identity where
479instance ShowTag appRoute Identity => ShowTag (ObeliskRoute appRoute) Identity where
423 showTaggedPrec = \case
480 showTaggedPrec = \case
424 ObeliskRoute_App a -> showTaggedPrec a
481 ObeliskRoute_App a -> showTaggedPrec a
425− ObeliskRoute_Static -> showsPrec
482+ ObeliskRoute_Resource r -> showTaggedPrec r
483+
484+instance ShowTag ResourceRoute Identity where
485+ showTaggedPrec = \case
486+ ResourceRoute_Static -> showsPrec
426
487
427instance Universe (Some appRoute) => Universe (Some (ObeliskRoute appRoute)) where
488instance Universe (Some appRoute) => Universe (Some (ObeliskRoute appRoute)) where
428 universe = mconcat
489 universe = mconcat
429 [ mapSome ObeliskRoute_App <$> universe
490 [ mapSome ObeliskRoute_App <$> universe
430− , [Some.This ObeliskRoute_Static]
491+ , mapSome ObeliskRoute_Resource <$> universe
431 ]
492 ]
432
493
433−showRoute :: (Some appRoute -> Maybe Text) -> Some (ObeliskRoute appRoute) -> Maybe Text
494+{-
434−showRoute showAppRoute (Some.This r) = case r of
435− ObeliskRoute_App appRoute -> showAppRoute $ Some.This appRoute
436− ObeliskRoute_Static -> Just "static"
437−
438instance GCompare appRoute => GCompare (ObeliskRoute appRoute) where
495instance GCompare appRoute => GCompare (ObeliskRoute appRoute) where
439 gcompare a b = case (a, b) of
496 gcompare a b = case (a, b) of
440 (ObeliskRoute_App aa, ObeliskRoute_App ab) -> gcompare aa ab
497 (ObeliskRoute_App aa, ObeliskRoute_App ab) -> gcompare aa ab
441− (ObeliskRoute_App _, ObeliskRoute_Static) -> GLT
498+ (ObeliskRoute_App _, ObeliskRoute_Resource) -> GLT
442− (ObeliskRoute_Static, ObeliskRoute_App _) -> GGT
499+ (ObeliskRoute_Resource, ObeliskRoute_App _) -> GGT
443− (ObeliskRoute_Static, ObeliskRoute_Static) -> GEQ
500+ (ObeliskRoute_Resource, ObeliskRoute_Resource) -> GEQ
444
501
445instance GEq appRoute => GEq (ObeliskRoute appRoute) where
502instance GEq appRoute => GEq (ObeliskRoute appRoute) where
446 geq a b = case (a, b) of
503 geq a b = case (a, b) of
447 (ObeliskRoute_App aa, ObeliskRoute_App ab) -> geq aa ab
504 (ObeliskRoute_App aa, ObeliskRoute_App ab) -> geq aa ab
448− (ObeliskRoute_App _, ObeliskRoute_Static) -> Nothing
505+ (ObeliskRoute_App _, ObeliskRoute_Resource) -> Nothing
449− (ObeliskRoute_Static, ObeliskRoute_App _) -> Nothing
506+ (ObeliskRoute_Resource, ObeliskRoute_App _) -> Nothing
450− (ObeliskRoute_Static, ObeliskRoute_Static) -> Just Refl
507+ (ObeliskRoute_Resource, ObeliskRoute_Resource) -> Just Refl
508+-}
451
509
452instance GShow appRoute => GShow (ObeliskRoute appRoute) where
510instance GShow appRoute => GShow (ObeliskRoute appRoute) where
453
511
454makePrisms ''ObeliskRoute
512makePrisms ''ObeliskRoute
513+deriveGShow ''ResourceRoute
514+deriveGEq ''ResourceRoute
515+deriveGCompare ''ResourceRoute
455
516
456--TODO: decodeURIComponent as appropriate
517--TODO: decodeURIComponent as appropriate