@@ -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 #-}
@@ -140,7 +139,6 @@ import Control.Lens
141 , Wrapped (..)
140 , Wrapped (..)
144import Control.Monad.Except
142import Control.Monad.Except
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)
@@ -154,6 +152,7 @@ import qualified Data.Dependent.Map as DMap
154import Data.Dependent.Sum (DSum (..))
152import Data.Dependent.Sum (DSum (..))
155import Data.Either.Validation (Validation (..))
153import Data.Either.Validation (Validation (..))
156import Data.Foldable
154import Data.Foldable
155+import Data.Functor (($>))
157import Data.Functor.Sum
156import Data.Functor.Sum
158import Data.GADT.Compare
157import Data.GADT.Compare
159import Data.GADT.Compare.TH
158import Data.GADT.Compare.TH
@@ -171,6 +170,7 @@ import Data.Text (Text)
171import qualified Data.Text as T
170import qualified Data.Text as T
172import qualified Data.Text.Encoding as T
171import qualified Data.Text.Encoding as T
173import Data.Text.Lens (IsText, packed, unpacked)
172import Data.Text.Lens (IsText, packed, unpacked)
173+import Data.Type.Equality
174import Data.Universe
174import Data.Universe
175import Data.Universe.Some
175import Data.Universe.Some
176import Network.HTTP.Types.URI
176import Network.HTTP.Types.URI
@@ -304,13 +304,13 @@ decode e x = runIdentity (tryDecode e x)
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-- | Once an 'Encoder' has been checked, so that its check monad has become 'Identity', even if the same is not true of the
305-- 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.
306tryDecode :: Encoder Identity parse decoded encoded -> encoded -> parse decoded
306tryDecode :: Encoder Identity parse decoded encoded -> encoded -> parse decoded
307−tryDecode (Encoder (Identity impl)) x = _encoderImpl_decode impl x
307+tryDecode (Encoder (Identity impl)) = _encoderImpl_decode impl
309-- | 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
310-- 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,
311-- 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'
312encode :: Encoder Identity parse decoded encoded -> decoded -> encoded
312encode :: Encoder Identity parse decoded encoded -> decoded -> encoded
313−encode (Encoder (Identity impl)) x = _encoderImpl_encode impl x
313+encode (Encoder (Identity impl)) = _encoderImpl_encode impl
315-- | 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
316-- reasonably certain that the law given for 'EncoderImpl' above holds.
316-- reasonably certain that the law given for 'EncoderImpl' above holds.
@@ -555,11 +555,11 @@ pathComponentEncoder f = Encoder $ do
555 unEncoder (pathComponentEncoderImpl (enum1Encoder (extractPathSegment . f)) f')
555 unEncoder (pathComponentEncoderImpl (enum1Encoder (extractPathSegment . f)) f')
557pathComponentEncoderImpl :: forall check parse p. (Monad check, Monad parse)
557pathComponentEncoderImpl :: forall check parse p. (Monad check, Monad parse)
558− => (Encoder check parse (Some p) (Maybe Text))
558+ => Encoder check parse (Some p) (Maybe Text)
559 -> (forall a. p a -> Encoder Identity parse a PageName)
559 -> (forall a. p a -> Encoder Identity parse a PageName)
560 -> Encoder check parse (R p) PageName
560 -> Encoder check parse (R p) PageName
561−pathComponentEncoderImpl this rest =
561+pathComponentEncoderImpl =
562− chainEncoder (lensEncoder (\(_, b) a -> (a, b)) Prelude.fst consEncoder) this rest
562+ chainEncoder (lensEncoder (\(_, b) a -> (a, b)) Prelude.fst consEncoder)
564--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
@@ -815,7 +815,7 @@ rPrism
815 :: forall f f'
815 :: forall f f'
816 . (forall a. Prism' (f a) (f' a))
816 . (forall a. Prism' (f a) (f' a))
817 -> Prism' (R f) (R f')
817 -> Prism' (R f) (R f')
818−rPrism p = dSumPrism p
818+rPrism = dSumPrism
820dSumPrism'
820dSumPrism'
821 :: forall f g a
821 :: forall f g a
@@ -827,7 +827,7 @@ dSumGEqPrism
829 -> Prism' (DSum f g) (g a)
829 -> Prism' (DSum f g) (g a)
830−dSumGEqPrism variant = dSumPrism' $ prism' (\Refl -> variant) (\x -> geq variant x)
830+dSumGEqPrism variant = dSumPrism' $ prism' (\Refl -> variant) (geq variant)
832-- | 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
833-- 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'
@@ -994,9 +994,9 @@ obeliskRouteSegment r appRouteSegment = case r of
994-- 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'.
995resourceRouteSegment :: (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
996resourceRouteSegment = \case
996resourceRouteSegment = \case
997− ResourceRoute_Static -> PathSegment "static" $ pathOnlyEncoderIgnoringQuery
997+ ResourceRoute_Static -> PathSegment "static" pathOnlyEncoderIgnoringQuery
998− ResourceRoute_Ghcjs -> PathSegment "ghcjs" $ pathOnlyEncoder
998+ ResourceRoute_Ghcjs -> PathSegment "ghcjs" pathOnlyEncoder
999− ResourceRoute_JSaddleWarp -> PathSegment "jsaddle" $ jsaddleWarpRouteEncoder
999+ ResourceRoute_JSaddleWarp -> PathSegment "jsaddle" jsaddleWarpRouteEncoder
1000 ResourceRoute_Version -> PathSegment "version" $ unitEncoder mempty
1000 ResourceRoute_Version -> PathSegment "version" $ unitEncoder mempty
1002data JSaddleWarpRoute :: * -> * where
1002data JSaddleWarpRoute :: * -> * where
@@ -1008,7 +1008,7 @@ jsaddleWarpRouteEncoder :: (MonadError Text check, MonadError Text parse) => Enc
1008jsaddleWarpRouteEncoder = pathComponentEncoder $ \case
1008jsaddleWarpRouteEncoder = pathComponentEncoder $ \case
1009 JSaddleWarpRoute_JavaScript -> PathSegment "jsaddle.js" $ unitEncoder mempty
1009 JSaddleWarpRoute_JavaScript -> PathSegment "jsaddle.js" $ unitEncoder mempty
1010 JSaddleWarpRoute_WebSocket -> PathEnd $ unitEncoder mempty
1010 JSaddleWarpRoute_WebSocket -> PathEnd $ unitEncoder mempty
1011− JSaddleWarpRoute_Sync -> PathSegment "sync" $ pathOnlyEncoder
1011+ JSaddleWarpRoute_Sync -> PathSegment "sync" pathOnlyEncoder
1013instance GShow appRoute => GShow (ObeliskRoute appRoute) where
1013instance GShow appRoute => GShow (ObeliskRoute appRoute) where
1014 gshowsPrec prec = \case
1014 gshowsPrec prec = \case
@@ -1039,8 +1039,8 @@ someSumEncoder = Encoder $ pure $ EncoderImpl
1040data Void1 :: * -> * where {}
1040data Void1 :: * -> * where {}
1042−instance Universe (Some Void1) where
1042+instance UniverseSome Void1 where
1043− universe = []
1043+ universeSome = []
1045void1Encoder :: (Applicative check, MonadError Text parse) => Encoder check parse (Some Void1) a
1045void1Encoder :: (Applicative check, MonadError Text parse) => Encoder check parse (Some Void1) a
1046void1Encoder = Encoder $ pure $ EncoderImpl
1046void1Encoder = Encoder $ pure $ EncoderImpl
@@ -1084,7 +1084,7 @@ readShowEncoder :: (MonadError Text parse, Read a, Show a, Applicative check) =>
1084readShowEncoder = singlePathSegmentEncoder . unsafeTshowEncoder
1084readShowEncoder = singlePathSegmentEncoder . unsafeTshowEncoder
1086integralEncoder :: (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
1087−integralEncoder = reviewEncoder (Numeric.Lens.integral)
1087+integralEncoder = reviewEncoder Numeric.Lens.integral
1089pathSegmentEncoder :: (MonadError Text parse, Applicative check, Cons as as a a) =>
1089pathSegmentEncoder :: (MonadError Text parse, Applicative check, Cons as as a a) =>
1090 Encoder check parse (a, (as, b)) (as, b)
1090 Encoder check parse (a, (as, b)) (as, b)
@@ -1159,7 +1159,7 @@ pathFieldEncoder fieldEncoder = unsafeEncoder $ do
1159 fieldEncoderPure f = toEncoder (DMap.findWithDefault (error "bad") f fieldEncoderPureMap)
1159 fieldEncoderPure f = toEncoder (DMap.findWithDefault (error "bad") f fieldEncoderPureMap)
1160 pure $ EncoderImpl
1160 pure $ EncoderImpl
1161 { _encoderImpl_encode = \(x, rest) -> execWriter $ do
1161 { _encoderImpl_encode = \(x, rest) -> execWriter $ do
1162− _ <- 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
1163 tell rest
1163 tell rest
1164 , _encoderImpl_decode = State.runStateT $ tabulateFieldsA $ \f -> State.get >>= \case
1164 , _encoderImpl_decode = State.runStateT $ tabulateFieldsA $ \f -> State.get >>= \case
1165 [] -> throwError $ T.pack "not enough path components"
1165 [] -> throwError $ T.pack "not enough path components"