on master help sign in
Merge pull request #715 from obsidiansystems/fix-contravariant-prismEncoder

Rename prismEncoder and isoEncoder to prismDecoder and isoDecoder to signal contravariance

commit4f6cf00d5e32a2f747bba1758a1e168fcbac45bf authorElliot Cameron <3noch@users.noreply.github.com> dateWed 29 Apr 2020, 13:48 (6 years ago) parentfb2844d7b34aea
2 files changed+58−28
lib/frontend/src/Obelisk/Frontend.hs+1−1 lib/route/src/Obelisk/Route.hs+57−27
lib/frontend/src/Obelisk/Frontend.hs+1−1
@@ -182,7 +182,7 @@ runFrontendWithConfigsAndCurrentRoute
182182 -> Frontend (R frontendRoute)
183183 -> JSM ()
184184runFrontendWithConfigsAndCurrentRoute mode configs validFullEncoder frontend = do
185− let ve = validFullEncoder . hoistParse errorLeft (prismEncoder (rPrism $ _FullRoute_Frontend . _ObeliskRoute_App))
185+ let ve = validFullEncoder . hoistParse errorLeft (reviewEncoder (rPrism $ _FullRoute_Frontend . _ObeliskRoute_App))
186186 errorLeft = \case
187187 Left _ -> error "runFrontend: Unexpected non-app ObeliskRoute reached the frontend. This shouldn't happen."
188188 Right x -> Identity x
lib/route/src/Obelisk/Route.hs+57−27
@@ -61,6 +61,7 @@ module Obelisk.Route
6161 , justEncoder
6262 , nothingEncoder
6363 , isoEncoder
64+ , viewEncoder
6465 , wrappedEncoder
6566 , unwrappedEncoder
6667 , listToNonEmptyEncoder
@@ -69,6 +70,7 @@ module Obelisk.Route
6970 , toListMapEncoder
7071 , shadowEncoder
7172 , prismEncoder
73+ , reviewEncoder
7274 , rPrism
7375 , _R
7476 , obeliskRouteEncoder
@@ -133,6 +135,7 @@ import Control.Lens
133135 , Prism'
134136 , prism'
135137 , re
138+ , review
136139 , view
137140 , Wrapped (..)
138141 )
@@ -340,7 +343,7 @@ instance Monad parse => Bifunctor (,) (EncoderImpl parse) (EncoderImpl parse) (E
340343 }
341344
342345instance (Monad parse, Applicative check) => Braided (Encoder check parse) (,) where
343− braid = isoEncoder (iso swap swap)
346+ braid = viewEncoder (iso swap swap)
344347
345348
346349instance (Applicative check, Monad parse) => PFunctor (,) (Encoder check parse) (Encoder check parse) where
@@ -376,11 +379,11 @@ instance (Monad parse, Applicative check) => Bifunctor Either (Encoder check par
376379 bimap f g = Encoder $ liftA2 bimap (unEncoder f) (unEncoder g)
377380
378381instance (Applicative check, Monad parse) => Associative (Encoder check parse) Either where
379− associate = isoEncoder (iso (associate @(->) @Either) disassociate)
380− disassociate = isoEncoder (iso disassociate associate)
382+ associate = viewEncoder (iso (associate @(->) @Either) disassociate)
383+ disassociate = viewEncoder (iso disassociate associate)
381384
382385instance (Monad parse, Applicative check) => Braided (Encoder check parse) Either where
383− braid = isoEncoder (iso swap swap)
386+ braid = viewEncoder (iso swap swap)
384387
385388
386389
@@ -434,17 +437,17 @@ instance (Applicative check, Monad parse) => Monoidal (Encoder check parse) (,)
434437--------------------------------------------------------------------------------
435438
436439-- | Given a valid 'Iso' from lens, construct an 'Encoder'
437−isoEncoder :: (Applicative check, Applicative parse) => Iso' a b -> Encoder check parse a b
438−isoEncoder f = unsafeMkEncoder $ EncoderImpl
440+viewEncoder :: (Applicative check, Applicative parse) => Iso' a b -> Encoder check parse a b
441+viewEncoder f = unsafeMkEncoder $ EncoderImpl
439442 { _encoderImpl_encode = view f
440443 , _encoderImpl_decode = pure . view (from f)
441444 }
442445
443446wrappedEncoder :: (Wrapped a, Applicative check, Applicative parse) => Encoder check parse (Unwrapped a) a
444−wrappedEncoder = isoEncoder $ from _Wrapped'
447+wrappedEncoder = viewEncoder $ from _Wrapped'
445448
446449unwrappedEncoder :: (Wrapped a, Applicative check, Applicative parse) => Encoder check parse a (Unwrapped a)
447−unwrappedEncoder = isoEncoder _Wrapped'
450+unwrappedEncoder = viewEncoder $ _Wrapped'
448451
449452maybeToEitherEncoder :: (Applicative check, Applicative parse) => Encoder check parse (Maybe a) (Either () a)
450453maybeToEitherEncoder = unsafeMkEncoder $ EncoderImpl
@@ -469,11 +472,11 @@ maybeEncoder f g = shadowEncoder f g . maybeToEitherEncoder
469472
470473-- | Encode a value by simply applying 'Just'
471474justEncoder :: (Applicative check, MonadError Text parse) => Encoder check parse a (Maybe a)
472−justEncoder = prismEncoder _Just
475+justEncoder = reviewEncoder _Just
473476
474477-- | Encode () to 'Nothing'.
475478nothingEncoder :: (Applicative check, MonadError Text parse) => Encoder check parse () (Maybe a)
476−nothingEncoder = prismEncoder _Nothing
479+nothingEncoder = reviewEncoder _Nothing
477480
478481someConstEncoder :: (Applicative check, Applicative parse) => Encoder check parse (Some (Const a)) a
479482someConstEncoder = unsafeMkEncoder $ EncoderImpl
@@ -827,12 +830,19 @@ _R variant = dSumGEqPrism variant . iso runIdentity Identity
827830
828831-- | An encoder that only works on the items available via the prism. An error will be thrown in the parse monad
829832-- if the prism doesn't match.
830−prismEncoder :: (Applicative check, MonadError Text parse) => Prism' b a -> Encoder check parse a b
831−prismEncoder p = unsafeMkEncoder $ EncoderImpl
832− { _encoderImpl_encode = (^. re p)
833+--
834+-- Note that a 'Prism' from @a@ to @b@ will produce an 'Encoder' from @b@ to @a@
835+-- (i.e. 'reviewEncoder' is a contravariant functor from the category of prisms to the category of encoders),
836+-- just like 'review' produces a function @b -> a@. This is because 'Prism's extract values, in a way that might
837+-- fail, in their forward direction and inject values, in a way that cannot fail, in their reverse direction;
838+-- whereas 'Encoder's encode, which cannot fail, in their forward direction, and decode, which can fail, in their
839+-- reverse direction. In short @reviewEncoder (f . g) = reviewEncoder g . reviewEncoder f@.
840+reviewEncoder :: (Applicative check, MonadError Text parse) => Prism' b a -> Encoder check parse a b
841+reviewEncoder p = unsafeMkEncoder $ EncoderImpl
842+ { _encoderImpl_encode = review p
833843 , _encoderImpl_decode = \r -> case r ^? p of
834844 Just a -> pure a
835− Nothing -> throwError "prismEncoder: value is not present in the prism"
845+ Nothing -> throwError "reviewEncoder: value is not present in the prism"
836846 }
837847
838848-- | A URL path and query string, in which trailing slashes don't matter in the path
@@ -1028,17 +1038,6 @@ void1Encoder = Encoder $ pure $ EncoderImpl
10281038instance GShow Void1 where
10291039 gshowsPrec _ = \case {}
10301040
1031−concat <$> mapM deriveRouteComponent
1032− [ ''ResourceRoute
1033− , ''JSaddleWarpRoute
1034− , ''IndexOnlyRoute
1035− ]
1036−
1037−makePrisms ''ObeliskRoute
1038−makePrisms ''FullRoute
1039−deriveGEq ''Void1
1040−deriveGCompare ''Void1
1041−
10421041-- | Given a backend route and a checked route encoder, render the route (path
10431042-- and query string). See 'checkEncoder' for how to produce a checked encoder.
10441043renderBackendRoute
@@ -1071,11 +1070,11 @@ readShowEncoder :: (MonadError Text parse, Read a, Show a, Applicative check) =>
10711070readShowEncoder = singlePathSegmentEncoder . unsafeTshowEncoder
10721071
10731072integralEncoder :: (MonadError Text parse, Applicative check, Integral a) => Encoder check parse a Integer
1074−integralEncoder = prismEncoder (Numeric.Lens.integral)
1073+integralEncoder = reviewEncoder (Numeric.Lens.integral)
10751074
10761075pathSegmentEncoder :: (MonadError Text parse, Applicative check, Cons as as a a) =>
10771076 Encoder check parse (a, (as, b)) (as, b)
1078−pathSegmentEncoder = first (prismEncoder _Cons) . disassociate
1077+pathSegmentEncoder = first (reviewEncoder _Cons) . disassociate
10791078
10801079newtype Decoder check parse b a = Decoder { toEncoder :: Encoder check parse a b }
10811080
@@ -1182,3 +1181,34 @@ byteStringsToPageName p q =
11821181 in decode pageNameEncoder' (T.unpack (T.decodeUtf8 p), T.unpack (T.decodeUtf8 q))
11831182
11841183--TODO: decodeURIComponent as appropriate
1184+
1185+
1186+{-# DEPRECATED isoEncoder "Instead of 'isoEncoder f', use 'viewEncoder f'" #-}
1187+-- | Given a valid 'Iso' from lens, construct an 'Encoder'
1188+isoEncoder :: (Applicative check, Applicative parse) => Iso' a b -> Encoder check parse a b
1189+isoEncoder = viewEncoder
1190+
1191+{-# DEPRECATED prismEncoder "Instead of 'prismEncoder f', use 'reviewEncoder f'" #-}
1192+-- | An encoder that only works on the items available via the prism. An error will be thrown in the parse monad
1193+-- if the prism doesn't match.
1194+--
1195+-- Note that a 'Prism' from @a@ to @b@ will produce an 'Encoder' from @b@ to @a@
1196+-- (i.e. 'prismEncoder' is a contravariant functor from the category of prisms to the category of encoders),
1197+-- just like 'review' produces a function @b -> a@. This is because 'Prism's extract values, in a way that might
1198+-- fail, in their forward direction and inject values, in a way that cannot fail, in their reverse direction;
1199+-- whereas 'Encoder's encode, which cannot fail, in their forward direction, and decode, which can fail, in their
1200+-- reverse direction. In short @prismEncoder (f . g) = prismEncoder g . prismEncoder f@.
1201+prismEncoder :: (Applicative check, MonadError Text parse) => Prism' b a -> Encoder check parse a b
1202+prismEncoder = reviewEncoder
1203+
1204+
1205+concat <$> mapM deriveRouteComponent
1206+ [ ''ResourceRoute
1207+ , ''JSaddleWarpRoute
1208+ , ''IndexOnlyRoute
1209+ ]
1210+
1211+makePrisms ''ObeliskRoute
1212+makePrisms ''FullRoute
1213+deriveGEq ''Void1
1214+deriveGCompare ''Void1