@@ -6,7 +6,6 @@
6{-# LANGUAGE FlexibleContexts #-}
6{-# LANGUAGE FlexibleContexts #-}
7{-# LANGUAGE FlexibleInstances #-}
7{-# LANGUAGE FlexibleInstances #-}
8{-# LANGUAGE GADTs #-}
8{-# LANGUAGE GADTs #-}
9−{-# LANGUAGE KindSignatures #-}
10{-# LANGUAGE LambdaCase #-}
9{-# LANGUAGE LambdaCase #-}
11{-# LANGUAGE MultiParamTypeClasses #-}
10{-# LANGUAGE MultiParamTypeClasses #-}
12{-# LANGUAGE OverloadedStrings #-}
11{-# LANGUAGE OverloadedStrings #-}
@@ -141,16 +140,19 @@ import Control.Lens
141 , Wrapped (..)
140 , Wrapped (..)
143import Control.Monad.Except
142import Control.Monad.Except
144−import Control.Monad.Writer (execWriter, tell)
145import qualified Control.Monad.State.Strict as State
143import qualified Control.Monad.State.Strict as State
146import Control.Monad.Trans (lift)
144import Control.Monad.Trans (lift)
145+import Control.Monad.Writer (execWriter, tell)
146+import Data.Aeson (FromJSON, ToJSON)
147+import qualified Data.Aeson as Aeson
147import qualified Data.ByteString as BS
148import qualified Data.ByteString as BS
148import qualified Data.ByteString.Lazy as BSL
149import qualified Data.ByteString.Lazy as BSL
149−import Data.Dependent.Sum (DSum (..))
150import Data.Dependent.Map (DMap)
150import Data.Dependent.Map (DMap)
151import qualified Data.Dependent.Map as DMap
151import qualified Data.Dependent.Map as DMap
152+import Data.Dependent.Sum (DSum (..))
152import Data.Either.Validation (Validation (..))
153import Data.Either.Validation (Validation (..))
153import Data.Foldable
154import Data.Foldable
155+import Data.Functor (($>))
154import Data.Functor.Sum
156import Data.Functor.Sum
155import Data.GADT.Compare
157import Data.GADT.Compare
156import Data.GADT.Compare.TH
158import Data.GADT.Compare.TH
@@ -163,19 +165,18 @@ import Data.Monoid ((<>))
163import Data.Set (Set)
165import Data.Set (Set)
164import qualified Data.Set as Set
166import qualified Data.Set as Set
165import Data.Some (Some(Some))
167import Data.Some (Some(Some))
168+import Data.Tabulation
166import Data.Text (Text)
169import Data.Text (Text)
167−import Data.Text.Lens (IsText, packed, unpacked)
168import qualified Data.Text as T
170import qualified Data.Text as T
169import qualified Data.Text.Encoding as T
171import qualified Data.Text.Encoding as T
172+import Data.Text.Lens (IsText, packed, unpacked)
173+import Data.Type.Equality
170import Data.Universe
174import Data.Universe
171import Data.Universe.Some
175import Data.Universe.Some
172import Network.HTTP.Types.URI
176import Network.HTTP.Types.URI
173import qualified Numeric.Lens
177import qualified Numeric.Lens
174import Obelisk.Route.TH
178import Obelisk.Route.TH
175import Text.Read (readMaybe)
179import Text.Read (readMaybe)
176−import Data.Tabulation
177−import qualified Data.Aeson as Aeson
178−import Data.Aeson (FromJSON, ToJSON)
180-- Design goals:
181-- Design goals:
181-- No start-up time on the frontend (not yet met)
182-- No start-up time on the frontend (not yet met)
@@ -303,13 +304,13 @@ decode e x = runIdentity (tryDecode e x)
303-- | Once an 'Encoder' has been checked, so that its check monad has become 'Identity', even if the same is not true of the
304-- | Once an 'Encoder' has been checked, so that its check monad has become 'Identity', even if the same is not true of the
304-- parse monad, we may still attempt to decode with it in its parse monad.
305-- parse monad, we may still attempt to decode with it in its parse monad.
305tryDecode :: Encoder Identity parse decoded encoded -> encoded -> parse decoded
306tryDecode :: Encoder Identity parse decoded encoded -> encoded -> parse decoded
306−tryDecode (Encoder (Identity impl)) x = _encoderImpl_decode impl x
307+tryDecode (Encoder (Identity impl)) = _encoderImpl_decode impl
308-- | Similar to 'decode', once an encoder has been checked so that its check monad is Identity, it
309-- | Similar to 'decode', once an encoder has been checked so that its check monad is Identity, it
309-- can be used to actually encode by using this. Note that while there's no constraint on the parse monad here,
310-- can be used to actually encode by using this. Note that while there's no constraint on the parse monad here,
310-- one should usually be applying decode and encode to the same 'Encoder'
311-- one should usually be applying decode and encode to the same 'Encoder'
311encode :: Encoder Identity parse decoded encoded -> decoded -> encoded
312encode :: Encoder Identity parse decoded encoded -> decoded -> encoded
312−encode (Encoder (Identity impl)) x = _encoderImpl_encode impl x
313+encode (Encoder (Identity impl)) = _encoderImpl_encode impl
314-- | This is a primitive used to build encoders which can't fail to check. It should not be used unless one is
315-- | This is a primitive used to build encoders which can't fail to check. It should not be used unless one is
315-- reasonably certain that the law given for 'EncoderImpl' above holds.
316-- reasonably certain that the law given for 'EncoderImpl' above holds.
@@ -554,11 +555,11 @@ pathComponentEncoder f = Encoder $ do
554 unEncoder (pathComponentEncoderImpl (enum1Encoder (extractPathSegment . f)) f')
555 unEncoder (pathComponentEncoderImpl (enum1Encoder (extractPathSegment . f)) f')
556pathComponentEncoderImpl :: forall check parse p. (Monad check, Monad parse)
557pathComponentEncoderImpl :: forall check parse p. (Monad check, Monad parse)
557− => (Encoder check parse (Some p) (Maybe Text))
558+ => Encoder check parse (Some p) (Maybe Text)
558 -> (forall a. p a -> Encoder Identity parse a PageName)
559 -> (forall a. p a -> Encoder Identity parse a PageName)
559 -> Encoder check parse (R p) PageName
560 -> Encoder check parse (R p) PageName
560−pathComponentEncoderImpl this rest =
561+pathComponentEncoderImpl =
561− chainEncoder (lensEncoder (\(_, b) a -> (a, b)) Prelude.fst consEncoder) this rest
562+ chainEncoder (lensEncoder (\(_, b) a -> (a, b)) Prelude.fst consEncoder)
563--NOTE: Naming convention in this module is to always talk about things in the *encoding* direction, never in the *decoding* direction
564--NOTE: Naming convention in this module is to always talk about things in the *encoding* direction, never in the *decoding* direction
@@ -814,7 +815,7 @@ rPrism
814 :: forall f f'
815 :: forall f f'
815 . (forall a. Prism' (f a) (f' a))
816 . (forall a. Prism' (f a) (f' a))
816 -> Prism' (R f) (R f')
817 -> Prism' (R f) (R f')
817−rPrism p = dSumPrism p
818+rPrism = dSumPrism
819dSumPrism'
820dSumPrism'
820 :: forall f g a
821 :: forall f g a
@@ -826,7 +827,7 @@ dSumGEqPrism
828 -> Prism' (DSum f g) (g a)
829 -> Prism' (DSum f g) (g a)
829−dSumGEqPrism variant = dSumPrism' $ prism' (\Refl -> variant) (\x -> geq variant x)
830+dSumGEqPrism variant = dSumPrism' $ prism' (\Refl -> variant) (geq variant)
831-- | Given a 'tag :: f a', make a prism for 'R f'. This generalizes the usual
832-- | Given a 'tag :: f a', make a prism for 'R f'. This generalizes the usual
832-- prisms for a sum type (the ones that 'mkPrisms' would make), just as 'R'
833-- prisms for a sum type (the ones that 'mkPrisms' would make), just as 'R'
@@ -993,9 +994,9 @@ obeliskRouteSegment r appRouteSegment = case r of
993-- be combined with other such segment encoders before 'pathComponentEncoder' turns it into a proper 'Encoder'.
994-- be combined with other such segment encoders before 'pathComponentEncoder' turns it into a proper 'Encoder'.
994resourceRouteSegment :: (MonadError Text check, MonadError Text parse) => ResourceRoute a -> SegmentResult check parse a
995resourceRouteSegment :: (MonadError Text check, MonadError Text parse) => ResourceRoute a -> SegmentResult check parse a
995resourceRouteSegment = \case
996resourceRouteSegment = \case
996− ResourceRoute_Static -> PathSegment "static" $ pathOnlyEncoderIgnoringQuery
997+ ResourceRoute_Static -> PathSegment "static" pathOnlyEncoderIgnoringQuery
997− ResourceRoute_Ghcjs -> PathSegment "ghcjs" $ pathOnlyEncoder
998+ ResourceRoute_Ghcjs -> PathSegment "ghcjs" pathOnlyEncoder
998− ResourceRoute_JSaddleWarp -> PathSegment "jsaddle" $ jsaddleWarpRouteEncoder
999+ ResourceRoute_JSaddleWarp -> PathSegment "jsaddle" jsaddleWarpRouteEncoder
999 ResourceRoute_Version -> PathSegment "version" $ unitEncoder mempty
1000 ResourceRoute_Version -> PathSegment "version" $ unitEncoder mempty
1001data JSaddleWarpRoute :: * -> * where
1002data JSaddleWarpRoute :: * -> * where
@@ -1007,7 +1008,7 @@ jsaddleWarpRouteEncoder :: (MonadError Text check, MonadError Text parse) => Enc
1007jsaddleWarpRouteEncoder = pathComponentEncoder $ \case
1008jsaddleWarpRouteEncoder = pathComponentEncoder $ \case
1008 JSaddleWarpRoute_JavaScript -> PathSegment "jsaddle.js" $ unitEncoder mempty
1009 JSaddleWarpRoute_JavaScript -> PathSegment "jsaddle.js" $ unitEncoder mempty
1009 JSaddleWarpRoute_WebSocket -> PathEnd $ unitEncoder mempty
1010 JSaddleWarpRoute_WebSocket -> PathEnd $ unitEncoder mempty
1010− JSaddleWarpRoute_Sync -> PathSegment "sync" $ pathOnlyEncoder
1011+ JSaddleWarpRoute_Sync -> PathSegment "sync" pathOnlyEncoder
1012instance GShow appRoute => GShow (ObeliskRoute appRoute) where
1013instance GShow appRoute => GShow (ObeliskRoute appRoute) where
1013 gshowsPrec prec = \case
1014 gshowsPrec prec = \case
@@ -1038,8 +1039,8 @@ someSumEncoder = Encoder $ pure $ EncoderImpl
1039data Void1 :: * -> * where {}
1040data Void1 :: * -> * where {}
1041−instance Universe (Some Void1) where
1042+instance UniverseSome Void1 where
1042− universe = []
1043+ universeSome = []
1044void1Encoder :: (Applicative check, MonadError Text parse) => Encoder check parse (Some Void1) a
1045void1Encoder :: (Applicative check, MonadError Text parse) => Encoder check parse (Some Void1) a
1045void1Encoder = Encoder $ pure $ EncoderImpl
1046void1Encoder = Encoder $ pure $ EncoderImpl
@@ -1083,7 +1084,7 @@ readShowEncoder :: (MonadError Text parse, Read a, Show a, Applicative check) =>
1083readShowEncoder = singlePathSegmentEncoder . unsafeTshowEncoder
1084readShowEncoder = singlePathSegmentEncoder . unsafeTshowEncoder
1085integralEncoder :: (MonadError Text parse, Applicative check, Integral a) => Encoder check parse a Integer
1086integralEncoder :: (MonadError Text parse, Applicative check, Integral a) => Encoder check parse a Integer
1086−integralEncoder = reviewEncoder (Numeric.Lens.integral)
1087+integralEncoder = reviewEncoder Numeric.Lens.integral
1088pathSegmentEncoder :: (MonadError Text parse, Applicative check, Cons as as a a) =>
1089pathSegmentEncoder :: (MonadError Text parse, Applicative check, Cons as as a a) =>
1089 Encoder check parse (a, (as, b)) (as, b)
1090 Encoder check parse (a, (as, b)) (as, b)
@@ -1158,7 +1159,7 @@ pathFieldEncoder fieldEncoder = unsafeEncoder $ do
1158 fieldEncoderPure f = toEncoder (DMap.findWithDefault (error "bad") f fieldEncoderPureMap)
1159 fieldEncoderPure f = toEncoder (DMap.findWithDefault (error "bad") f fieldEncoderPureMap)
1159 pure $ EncoderImpl
1160 pure $ EncoderImpl
1160 { _encoderImpl_encode = \(x, rest) -> execWriter $ do
1161 { _encoderImpl_encode = \(x, rest) -> execWriter $ do
1161− _ <- traverseWithField (\f x_i -> tell (pure $ encode (fieldEncoderPure f) x_i) *> pure x_i) x
1162+ _ <- traverseWithField (\f x_i -> tell (pure $ encode (fieldEncoderPure f) x_i) $> x_i) x
1162 tell rest
1163 tell rest
1163 , _encoderImpl_decode = State.runStateT $ tabulateFieldsA $ \f -> State.get >>= \case
1164 , _encoderImpl_decode = State.runStateT $ tabulateFieldsA $ \f -> State.get >>= \case
1164 [] -> throwError $ T.pack "not enough path components"
1165 [] -> throwError $ T.pack "not enough path components"