@@ -6,6 +6,7 @@
66{-# LANGUAGE FlexibleContexts #-}
77{-# LANGUAGE FlexibleInstances #-}
88{-# LANGUAGE GADTs #-}
9+{-# LANGUAGE KindSignatures #-}
910{-# LANGUAGE LambdaCase #-}
1011{-# LANGUAGE MultiParamTypeClasses #-}
1112{-# LANGUAGE OverloadedStrings #-}
@@ -140,19 +141,16 @@ import Control.Lens
140141 , Wrapped (..)
141142 )
142143import Control.Monad.Except
144+import Control.Monad.Writer (execWriter, tell)
143145import qualified Control.Monad.State.Strict as State
144146import Control.Monad.Trans (lift)
145−import Control.Monad.Writer (execWriter, tell)
146−import Data.Aeson (FromJSON, ToJSON)
147−import qualified Data.Aeson as Aeson
148147import qualified Data.ByteString as BS
149148import qualified Data.ByteString.Lazy as BSL
149+import Data.Dependent.Sum (DSum (..))
150150import Data.Dependent.Map (DMap)
151151import qualified Data.Dependent.Map as DMap
152−import Data.Dependent.Sum (DSum (..))
153152import Data.Either.Validation (Validation (..))
154153import Data.Foldable
155−import Data.Functor (($>))
156154import Data.Functor.Sum
157155import Data.GADT.Compare
158156import Data.GADT.Compare.TH
@@ -165,18 +163,19 @@ import Data.Monoid ((<>))
165163import Data.Set (Set)
166164import qualified Data.Set as Set
167165import Data.Some (Some(Some))
168−import Data.Tabulation
169166import Data.Text (Text)
167+import Data.Text.Lens (IsText, packed, unpacked)
170168import qualified Data.Text as T
171169import qualified Data.Text.Encoding as T
172−import Data.Text.Lens (IsText, packed, unpacked)
173−import Data.Type.Equality
174170import Data.Universe
175171import Data.Universe.Some
176172import Network.HTTP.Types.URI
177173import qualified Numeric.Lens
178174import Obelisk.Route.TH
179175import Text.Read (readMaybe)
176+import Data.Tabulation
177+import qualified Data.Aeson as Aeson
178+import Data.Aeson (FromJSON, ToJSON)
180179
181180-- Design goals:
182181-- No start-up time on the frontend (not yet met)
@@ -304,13 +303,13 @@ decode e x = runIdentity (tryDecode e x)
304303-- | Once an 'Encoder' has been checked, so that its check monad has become 'Identity', even if the same is not true of the
305304-- parse monad, we may still attempt to decode with it in its parse monad.
306305tryDecode :: Encoder Identity parse decoded encoded -> encoded -> parse decoded
307−tryDecode (Encoder (Identity impl)) = _encoderImpl_decode impl
306+tryDecode (Encoder (Identity impl)) x = _encoderImpl_decode impl x
308307
309308-- | Similar to 'decode', once an encoder has been checked so that its check monad is Identity, it
310309-- can be used to actually encode by using this. Note that while there's no constraint on the parse monad here,
311310-- one should usually be applying decode and encode to the same 'Encoder'
312311encode :: Encoder Identity parse decoded encoded -> decoded -> encoded
313−encode (Encoder (Identity impl)) = _encoderImpl_encode impl
312+encode (Encoder (Identity impl)) x = _encoderImpl_encode impl x
314313
315314-- | This is a primitive used to build encoders which can't fail to check. It should not be used unless one is
316315-- reasonably certain that the law given for 'EncoderImpl' above holds.
@@ -555,11 +554,11 @@ pathComponentEncoder f = Encoder $ do
555554 unEncoder (pathComponentEncoderImpl (enum1Encoder (extractPathSegment . f)) f')
556555
557556pathComponentEncoderImpl :: forall check parse p. (Monad check, Monad parse)
558− => Encoder check parse (Some p) (Maybe Text)
557+ => (Encoder check parse (Some p) (Maybe Text))
559558 -> (forall a. p a -> Encoder Identity parse a PageName)
560559 -> Encoder check parse (R p) PageName
561−pathComponentEncoderImpl =
562− chainEncoder (lensEncoder (\(_, b) a -> (a, b)) Prelude.fst consEncoder)
560+pathComponentEncoderImpl this rest =
561+ chainEncoder (lensEncoder (\(_, b) a -> (a, b)) Prelude.fst consEncoder) this rest
563562
564563--NOTE: Naming convention in this module is to always talk about things in the *encoding* direction, never in the *decoding* direction
565564
@@ -815,7 +814,7 @@ rPrism
815814 :: forall f f'
816815 . (forall a. Prism' (f a) (f' a))
817816 -> Prism' (R f) (R f')
818−rPrism = dSumPrism
817+rPrism p = dSumPrism p
819818
820819dSumPrism'
821820 :: forall f g a
@@ -827,7 +826,7 @@ dSumGEqPrism
827826 :: GEq f
828827 => f a
829828 -> Prism' (DSum f g) (g a)
830−dSumGEqPrism variant = dSumPrism' $ prism' (\Refl -> variant) (geq variant)
829+dSumGEqPrism variant = dSumPrism' $ prism' (\Refl -> variant) (\x -> geq variant x)
831830
832831-- | Given a 'tag :: f a', make a prism for 'R f'. This generalizes the usual
833832-- prisms for a sum type (the ones that 'mkPrisms' would make), just as 'R'
@@ -994,9 +993,9 @@ obeliskRouteSegment r appRouteSegment = case r of
994993-- be combined with other such segment encoders before 'pathComponentEncoder' turns it into a proper 'Encoder'.
995994resourceRouteSegment :: (MonadError Text check, MonadError Text parse) => ResourceRoute a -> SegmentResult check parse a
996995resourceRouteSegment = \case
997− ResourceRoute_Static -> PathSegment "static" pathOnlyEncoderIgnoringQuery
998− ResourceRoute_Ghcjs -> PathSegment "ghcjs" pathOnlyEncoder
999− ResourceRoute_JSaddleWarp -> PathSegment "jsaddle" jsaddleWarpRouteEncoder
996+ ResourceRoute_Static -> PathSegment "static" $ pathOnlyEncoderIgnoringQuery
997+ ResourceRoute_Ghcjs -> PathSegment "ghcjs" $ pathOnlyEncoder
998+ ResourceRoute_JSaddleWarp -> PathSegment "jsaddle" $ jsaddleWarpRouteEncoder
1000999 ResourceRoute_Version -> PathSegment "version" $ unitEncoder mempty
10011000
10021001data JSaddleWarpRoute :: * -> * where
@@ -1008,7 +1007,7 @@ jsaddleWarpRouteEncoder :: (MonadError Text check, MonadError Text parse) => Enc
10081007jsaddleWarpRouteEncoder = pathComponentEncoder $ \case
10091008 JSaddleWarpRoute_JavaScript -> PathSegment "jsaddle.js" $ unitEncoder mempty
10101009 JSaddleWarpRoute_WebSocket -> PathEnd $ unitEncoder mempty
1011− JSaddleWarpRoute_Sync -> PathSegment "sync" pathOnlyEncoder
1010+ JSaddleWarpRoute_Sync -> PathSegment "sync" $ pathOnlyEncoder
10121011
10131012instance GShow appRoute => GShow (ObeliskRoute appRoute) where
10141013 gshowsPrec prec = \case
@@ -1039,8 +1038,8 @@ someSumEncoder = Encoder $ pure $ EncoderImpl
10391038
10401039data Void1 :: * -> * where {}
10411040
1042−instance UniverseSome Void1 where
1043− universeSome = []
1041+instance Universe (Some Void1) where
1042+ universe = []
10441043
10451044void1Encoder :: (Applicative check, MonadError Text parse) => Encoder check parse (Some Void1) a
10461045void1Encoder = Encoder $ pure $ EncoderImpl
@@ -1084,7 +1083,7 @@ readShowEncoder :: (MonadError Text parse, Read a, Show a, Applicative check) =>
10841083readShowEncoder = singlePathSegmentEncoder . unsafeTshowEncoder
10851084
10861085integralEncoder :: (MonadError Text parse, Applicative check, Integral a) => Encoder check parse a Integer
1087−integralEncoder = reviewEncoder Numeric.Lens.integral
1086+integralEncoder = reviewEncoder (Numeric.Lens.integral)
10881087
10891088pathSegmentEncoder :: (MonadError Text parse, Applicative check, Cons as as a a) =>
10901089 Encoder check parse (a, (as, b)) (as, b)
@@ -1159,7 +1158,7 @@ pathFieldEncoder fieldEncoder = unsafeEncoder $ do
11591158 fieldEncoderPure f = toEncoder (DMap.findWithDefault (error "bad") f fieldEncoderPureMap)
11601159 pure $ EncoderImpl
11611160 { _encoderImpl_encode = \(x, rest) -> execWriter $ do
1162− _ <- traverseWithField (\f x_i -> tell (pure $ encode (fieldEncoderPure f) x_i) $> x_i) x
1161+ _ <- traverseWithField (\f x_i -> tell (pure $ encode (fieldEncoderPure f) x_i) *> pure x_i) x
11631162 tell rest
11641163 , _encoderImpl_decode = State.runStateT $ tabulateFieldsA $ \f -> State.get >>= \case
11651164 [] -> throwError $ T.pack "not enough path components"