@@ -49,13 +49,11 @@ module Obelisk.Route
4949import Prelude hiding ((.), id)
5050
5151import Control.Applicative
52−import Control.Category (Category (..), (.), id)
52+import Control.Category (Category (..))
5353import qualified Control.Categorical.Functor as Cat
5454import Control.Categorical.Bifunctor
55−import Control.Category.Cartesian
56−import Control.Lens hiding (Bifunctor, bimap, universe)
55+import Control.Lens (Identity (..), Prism', makePrisms, itraverse, imap, prism, (^.), re, matching, (^?))
5756import Control.Monad.Except
58−import Data.Constraint
5957import Data.Dependent.Sum (DSum (..), ShowTag (..))
6058import Data.Dependent.Map (DMap)
6159import qualified Data.Dependent.Map as DMap
@@ -77,10 +75,6 @@ import Data.Text (Text)
7775import qualified Data.Text as T
7876import Data.Either.Validation (Validation (..))
7977import Data.Universe
80−import Data.Functor.Compose
81−import Data.Functor.Identity
82−
83−import Reflex.Class (EitherTag (..))
8478
8579-- Design goals:
8680-- No start-up time on the frontend (not yet met)
@@ -106,6 +100,7 @@ import Reflex.Class (EitherTag (..))
106100
107101type R f = DSum f Identity --TODO: Better name
108102
103+--TODO: COMPLETE pragma
109104infixr 5 :/
110105pattern (:/) :: f a -> a -> R f
111106pattern a :/ b = a :=> Identity b
@@ -120,10 +115,8 @@ mapSome f (Some.This a) = Some.This $ f a
120115newtype Encoder check parse decoded encoded = Encoder { unEncoder :: check (ValidEncoder parse decoded encoded) }
121116
122117-- | Law:
123−-- forall p. _totalEncoder_decode p . _totalEncoder_encode == id
124−-- 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, decode . encode must be idemponent.
125−type TotalEncoder = Encoder Identity
126−
118+-- forall p. _totalEncoder_decode ve . _validEncoder_encode ve p == pure
119+-- 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.
127120-- | TODO: Should this be turned around? That would match enumEncoder better
128121data ValidEncoder parse decoded encoded = ValidEncoder
129122 { _validEncoder_decode :: !(encoded -> parse decoded) -- Can fail; can lose information; must always succeed on outputs of `_validEncoder_encode` and result in the original value
@@ -394,7 +387,7 @@ prismValidEncoder :: MonadError Text parse => Prism' b a -> ValidEncoder parse a
394387prismValidEncoder p = ValidEncoder
395388 { _validEncoder_encode = (^. re p)
396389 , _validEncoder_decode = \r -> case r ^? p of
397− Just p -> pure p
390+ Just a -> pure a
398391 Nothing -> throwError "prismValidEncoder: value is not present in the prism"
399392 }
400393
@@ -425,11 +418,13 @@ data ObeliskRoute :: (* -> *) -> * -> * where
425418
426419data ResourceRoute :: * -> * where
427420 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")
421+ ResourceRoute_JSaddleWarp :: ResourceRoute (R JSaddleWarpRoute)
428422
429423--TODO: Generate this
430424instance Universe (Some ResourceRoute) where
431425 universe =
432426 [ Some.This ResourceRoute_Static
427+ , Some.This ResourceRoute_JSaddleWarp
433428 ]
434429
435430--TODO: Figure out a way to check this
@@ -443,7 +438,7 @@ obeliskComponentEncoder = Encoder $ pure $ ValidEncoder
443438 Left (Some.This r) -> Some.This $ ObeliskRoute_Resource r
444439 }
445440
446−newtype ValidEncoderFunc parse p r = ValidEncoderFunc { unValidEncoderFunc :: forall a. p a -> ValidEncoder parse a r }
441+newtype ValidEncoderFunc parse p r = ValidEncoderFunc { runValidEncoderFunc :: forall a. p a -> ValidEncoder parse a r }
447442
448443checkSomeUniverseEncoder
449444 :: forall check parse p r.
@@ -470,26 +465,46 @@ obeliskRouteEncoder
470465 -> (forall a. appRoute a -> Encoder check parse a PageName)
471466 -> Encoder check parse (R (ObeliskRoute appRoute)) PageName
472467obeliskRouteEncoder appComponentEncoder appRouteEncoder = Encoder $ do
473− ValidEncoderFunc appRouteValidEncoder <- checkSomeUniverseEncoder appRouteEncoder
474− let componentEncoder =
475− (
476− resourceComponentEncoder
477− `shadowEncoder`
478− appComponentEncoder
479− )
480− .
481− obeliskComponentEncoder
468+ let componentEncoder = (resourceComponentEncoder `shadowEncoder` appComponentEncoder) . obeliskComponentEncoder
469+ appRouteValidEncoder <- checkSomeUniverseEncoder appRouteEncoder
470+ resourceRouteValidEncoder <- checkSomeUniverseEncoder resourceRouteEncoder
482471 checkEncoder $ pathComponentEncoder componentEncoder $ \case
483− ObeliskRoute_App appRoute -> appRouteValidEncoder appRoute
484− ObeliskRoute_Resource resRoute -> resourceRouteValidEncoder resRoute
472+ ObeliskRoute_App appRoute -> runValidEncoderFunc appRouteValidEncoder appRoute
473+ ObeliskRoute_Resource resRoute -> runValidEncoderFunc resourceRouteValidEncoder resRoute
485474
486475resourceComponentEncoder :: (MonadError Text check, MonadError Text parse) => Encoder check parse (Some ResourceRoute) (Maybe Text)
487476resourceComponentEncoder = enum1Encoder $ \case
488477 ResourceRoute_Static -> Just "static"
478+ ResourceRoute_JSaddleWarp -> Just "jsaddle"
479+
480+resourceRouteEncoder :: (MonadError Text check, MonadError Text parse) => ResourceRoute a -> Encoder check parse a PageName
481+resourceRouteEncoder = \case
482+ ResourceRoute_Static -> Encoder $ pure pathOnlyValidEncoder
483+ ResourceRoute_JSaddleWarp -> jsaddleWarpEncoder
489484
490−resourceRouteValidEncoder :: MonadError Text parse => ResourceRoute a -> ValidEncoder parse a PageName
491−resourceRouteValidEncoder = \case
492− ResourceRoute_Static -> pathOnlyValidEncoder
485+data JSaddleWarpRoute :: * -> * where
486+ JSaddleWarpRoute_JavaScript :: JSaddleWarpRoute ()
487+ JSaddleWarpRoute_WebSocket :: JSaddleWarpRoute ()
488+ JSaddleWarpRoute_Sync :: JSaddleWarpRoute [Text]
489+
490+instance Universe (Some JSaddleWarpRoute) where
491+ universe =
492+ [ Some.This JSaddleWarpRoute_JavaScript
493+ , Some.This JSaddleWarpRoute_WebSocket
494+ , Some.This JSaddleWarpRoute_Sync
495+ ]
496+
497+jsaddleWarpComponentEncoder :: (MonadError Text check, MonadError Text parse) => Encoder check parse (Some JSaddleWarpRoute) (Maybe Text)
498+jsaddleWarpComponentEncoder = enum1Encoder $ \case
499+ JSaddleWarpRoute_JavaScript -> Just "jsaddle.js"
500+ JSaddleWarpRoute_WebSocket -> Just "websocket"
501+ JSaddleWarpRoute_Sync -> Just "sync"
502+
503+jsaddleWarpEncoder :: (MonadError Text check, MonadError Text parse) => Encoder check parse (R JSaddleWarpRoute) PageName
504+jsaddleWarpEncoder = pathComponentEncoder jsaddleWarpComponentEncoder $ \case
505+ JSaddleWarpRoute_JavaScript -> endValidEncoder mempty
506+ JSaddleWarpRoute_WebSocket -> endValidEncoder mempty
507+ JSaddleWarpRoute_Sync -> pathOnlyValidEncoder
493508
494509instance ShowTag appRoute Identity => ShowTag (ObeliskRoute appRoute) Identity where
495510 showTaggedPrec = \case
@@ -499,6 +514,14 @@ instance ShowTag appRoute Identity => ShowTag (ObeliskRoute appRoute) Identity w
499514instance ShowTag ResourceRoute Identity where
500515 showTaggedPrec = \case
501516 ResourceRoute_Static -> showsPrec
517+ ResourceRoute_JSaddleWarp -> showsPrec
518+
519+instance ShowTag JSaddleWarpRoute Identity where
520+ showTaggedPrec = \case
521+ JSaddleWarpRoute_JavaScript -> showsPrec
522+ JSaddleWarpRoute_WebSocket -> showsPrec
523+ JSaddleWarpRoute_Sync -> showsPrec
524+
502525
503526instance Universe (Some appRoute) => Universe (Some (ObeliskRoute appRoute)) where
504527 universe = mconcat
@@ -522,11 +545,22 @@ instance GEq appRoute => GEq (ObeliskRoute appRoute) where
522545 (ObeliskRoute_Resource, ObeliskRoute_Resource) -> Just Refl
523546-}
524547
548+--TODO: Fix deriveGShow
525549instance GShow appRoute => GShow (ObeliskRoute appRoute) where
550+ gshowsPrec prec = \case
551+ ObeliskRoute_App appRoute -> showParen (prec > 10) $
552+ showString "ObeliskRoute_App " . gshowsPrec 11 appRoute
553+ ObeliskRoute_Resource appRoute -> showParen (prec > 10) $
554+ showString "ObeliskRoute_Resource " . gshowsPrec 11 appRoute
526555
527556makePrisms ''ObeliskRoute
557+--TODO: Prevent deriveGShow from creating this warning:
558+-- Defined but not used: ‘p’
528559deriveGShow ''ResourceRoute
529560deriveGEq ''ResourceRoute
530561deriveGCompare ''ResourceRoute
562+deriveGShow ''JSaddleWarpRoute
563+deriveGEq ''JSaddleWarpRoute
564+deriveGCompare ''JSaddleWarpRoute
531565
532566--TODO: decodeURIComponent as appropriate