@@ -25,6 +25,7 @@ module Obelisk.Route
2525 , mapSome
2626 , pathComponentEncoder
2727 , enumEncoder
28+ , enum1Encoder
2829 , endValidEncoder
2930 , pathOnlyValidEncoder
3031 , singletonListValidEncoder
@@ -40,7 +41,7 @@ module Obelisk.Route
4041 , rPrism
4142 , obeliskRouteEncoder
4243 , _ObeliskRoute_App
43− , _ObeliskRoute_Static
44+ , _ObeliskRoute_Resource
4445 ) where
4546
4647import Prelude hiding ((.), id)
@@ -157,6 +158,13 @@ instance Monad parse => Bifunctor (,) (ValidEncoder parse) (ValidEncoder parse)
157158 , _validEncoder_decode = \(a, b) -> liftA2 (,) (_validEncoder_decode f a) (_validEncoder_decode g b)
158159 }
159160
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+
160168instance (Traversable f, Monad check, Monad parse) => Cat.Functor f (Encoder check parse) (Encoder check parse) where
161169 fmap e = Encoder $ do
162170 ve <- checkEncoder e
@@ -228,8 +236,8 @@ shadowEncoder
228236 , Show c
229237 , check ~ parse --TODO: Get rid of this
230238 )
231− => Encoder check parse a c
232− -> Encoder check parse b c
239+ => Encoder check parse a c -- ^ Overlaps
240+ -> Encoder check parse b c -- ^ Gets overlapped
233241 -> Encoder check parse (Either a b) c
234242shadowEncoder f g = Encoder $ do
235243 vf <- checkEncoder f
@@ -250,6 +258,18 @@ shadowEncoder f g = Encoder $ do
250258 , _validEncoder_decode = \c -> (Left <$> _validEncoder_decode vf c) `catchError` \_ -> Right <$> _validEncoder_decode vg c
251259 }
252260
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+
253273-- | Encode an enumerable, bounded type. WARNING: Don't use this on types that
254274-- have a large number of values - it will use a lot of memory.
255275enumEncoder :: 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
386406data ObeliskRoute :: (* -> *) -> * -> * where
387407 -- 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
388408 ObeliskRoute_App :: f a -> ObeliskRoute f a
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")
409+ ObeliskRoute_Resource :: ResourceRoute a -> ObeliskRoute f a
410+
411+data ResourceRoute :: * -> * where
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+ }
390430
391431newtype ValidEncoderFunc parse p r = ValidEncoderFunc { unValidEncoderFunc :: forall a. p a -> ValidEncoder parse a r }
392432
@@ -409,48 +449,69 @@ obeliskRouteEncoder
409449 , GShow appRoute
410450 , MonadError Text check
411451 , MonadError Text parse
452+ , check ~ parse --TODO: Get rid of this
412453 )
413− => (Some appRoute -> Maybe Text)
454+ => (Encoder check parse (Some appRoute) (Maybe Text))
414455 -> (forall a. appRoute a -> Encoder check parse a PageName)
415456 -> Encoder check parse (R (ObeliskRoute appRoute)) PageName
416−obeliskRouteEncoder showAppRoute appRouteEncoder = Encoder $ do
457+obeliskRouteEncoder appComponentEncoder appRouteEncoder = Encoder $ do
417458 ValidEncoderFunc appRouteValidEncoder <- checkSomeUniverseEncoder appRouteEncoder
418− checkEncoder $ pathComponentEncoder (enumEncoder (showRoute showAppRoute)) $ \case
459+ let componentEncoder =
460+ (
461+ resourceComponentEncoder
462+ `shadowEncoder`
463+ appComponentEncoder
464+ )
465+ .
466+ obeliskComponentEncoder
467+ checkEncoder $ pathComponentEncoder componentEncoder $ \case
419468 ObeliskRoute_App appRoute -> appRouteValidEncoder appRoute
420− ObeliskRoute_Static -> pathOnlyValidEncoder
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
477+ ResourceRoute_Static -> pathOnlyValidEncoder
421478
422479instance ShowTag appRoute Identity => ShowTag (ObeliskRoute appRoute) Identity where
423480 showTaggedPrec = \case
424481 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
426487
427488instance Universe (Some appRoute) => Universe (Some (ObeliskRoute appRoute)) where
428489 universe = mconcat
429490 [ mapSome ObeliskRoute_App <$> universe
430− , [Some.This ObeliskRoute_Static]
491+ , mapSome ObeliskRoute_Resource <$> universe
431492 ]
432493
433−showRoute :: (Some appRoute -> Maybe Text) -> Some (ObeliskRoute appRoute) -> Maybe Text
434−showRoute showAppRoute (Some.This r) = case r of
435− ObeliskRoute_App appRoute -> showAppRoute $ Some.This appRoute
436− ObeliskRoute_Static -> Just "static"
437−
494+{-
438495instance GCompare appRoute => GCompare (ObeliskRoute appRoute) where
439496 gcompare a b = case (a, b) of
440497 (ObeliskRoute_App aa, ObeliskRoute_App ab) -> gcompare aa ab
441− (ObeliskRoute_App _, ObeliskRoute_Static) -> GLT
442− (ObeliskRoute_Static, ObeliskRoute_App _) -> GGT
443− (ObeliskRoute_Static, ObeliskRoute_Static) -> GEQ
498+ (ObeliskRoute_App _, ObeliskRoute_Resource) -> GLT
499+ (ObeliskRoute_Resource, ObeliskRoute_App _) -> GGT
500+ (ObeliskRoute_Resource, ObeliskRoute_Resource) -> GEQ
444501
445502instance GEq appRoute => GEq (ObeliskRoute appRoute) where
446503 geq a b = case (a, b) of
447504 (ObeliskRoute_App aa, ObeliskRoute_App ab) -> geq aa ab
448− (ObeliskRoute_App _, ObeliskRoute_Static) -> Nothing
449− (ObeliskRoute_Static, ObeliskRoute_App _) -> Nothing
450− (ObeliskRoute_Static, ObeliskRoute_Static) -> Just Refl
505+ (ObeliskRoute_App _, ObeliskRoute_Resource) -> Nothing
506+ (ObeliskRoute_Resource, ObeliskRoute_App _) -> Nothing
507+ (ObeliskRoute_Resource, ObeliskRoute_Resource) -> Just Refl
508+-}
451509
452510instance GShow appRoute => GShow (ObeliskRoute appRoute) where
453511
454512makePrisms ''ObeliskRoute
513+deriveGShow ''ResourceRoute
514+deriveGEq ''ResourceRoute
515+deriveGCompare ''ResourceRoute
455516
456517--TODO: decodeURIComponent as appropriate