indexed-profunctors 0.1 → 0.1.1
raw patch · 3 files changed
+11/−192 lines, 3 filesdep ~basenew-uploaderPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: base
API changes (from Hackage documentation)
Files
- CHANGELOG.md +5/−0
- indexed-profunctors.cabal +6/−3
- src/Data/Profunctor/Indexed.hs +0/−189
+ CHANGELOG.md view
@@ -0,0 +1,5 @@+# indexed-profunctors-0.1.1 (2021-04-09)+* Remove unnecessary INLINE pragmas++# indexed-profunctors-0.1 (2019-10-11)+* Initial release
indexed-profunctors.cabal view
@@ -1,12 +1,12 @@ name: indexed-profunctors-version: 0.1+version: 0.1.1 license: BSD3 license-file: LICENSE build-type: Simple cabal-version: 1.24 maintainer: optics@well-typed.com author: Adam Gundry, Andres Löh, Andrzej Rybczak, Oleg Grenrus-tested-with: GHC ==8.0.2 || ==8.2.2 || ==8.4.4 || ==8.6.5 || ==8.8.1, GHCJS ==8.4+tested-with: GHC ==8.2.2 || ==8.4.4 || ==8.6.5 || ==8.8.4 || ==8.10.4 || ==9.0.1, GHCJS ==8.4 synopsis: Utilities for indexed profunctors category: Data, Optics, Lenses, Profunctors description:@@ -14,6 +14,9 @@ are primarily intended as internal utilities to support the @optics@ and @generic-lens@ package families. +extra-doc-files:+ CHANGELOG.md+ bug-reports: https://github.com/well-typed/optics/issues source-repository head type: git@@ -25,6 +28,6 @@ hs-source-dirs: src ghc-options: -Wall - build-depends: base >= 4.9 && <5+ build-depends: base >= 4.10 && <5 exposed-modules: Data.Profunctor.Indexed
src/Data/Profunctor/Indexed.hs view
@@ -98,7 +98,6 @@ -- | Unwrap 'StarA'. runStarA :: StarA f i a b -> a -> f b runStarA (StarA _ k) = k-{-# INLINE runStarA #-} -- | Needed for conversion of indexed affine traversal back to its VL -- representation.@@ -107,24 +106,20 @@ -- | Unwrap 'StarA'. runIxStarA :: IxStarA f i a b -> i -> a -> f b runIxStarA (IxStarA _ k) = k-{-# INLINE runIxStarA #-} ---------------------------------------- -- | Repack 'Star' to change its index type. reStar :: Star f i a b -> Star f j a b reStar (Star k) = Star k-{-# INLINE reStar #-} -- | Repack 'Forget' to change its index type. reForget :: Forget r i a b -> Forget r j a b reForget (Forget k) = Forget k-{-# INLINE reForget #-} -- | Repack 'FunArrow' to change its index type. reFunArrow :: FunArrow i a b -> FunArrow j a b reFunArrow (FunArrow k) = FunArrow k-{-# INLINE reFunArrow #-} ---------------------------------------- -- Classes and instances@@ -140,7 +135,6 @@ => p i a c -> p i b c lcoerce' = coerce- {-# INLINE lcoerce' #-} rcoerce' :: Coercible a b => p i c a -> p i c b default rcoerce'@@ -148,7 +142,6 @@ => p i c a -> p i c b rcoerce' = coerce- {-# INLINE rcoerce' #-} conjoined__ :: (p i a b -> p i s t)@@ -160,7 +153,6 @@ -> (p i a b -> p j s t) -> (p i a b -> p j s t) conjoined__ f _ = coerce . f- {-# INLINE conjoined__ #-} ixcontramap :: (j -> i) -> p i a b -> p j a b default ixcontramap@@ -169,134 +161,87 @@ -> p i a b -> p j a b ixcontramap _ = coerce- {-# INLINE ixcontramap #-} -- | 'rcoerce'' with type arguments rearranged for TypeApplications. rcoerce :: (Coercible a b, Profunctor p) => p i c a -> p i c b rcoerce = rcoerce'-{-# INLINE rcoerce #-} -- | 'lcoerce'' with type arguments rearranged for TypeApplications. lcoerce :: (Coercible a b, Profunctor p) => p i a c -> p i b c lcoerce = lcoerce'-{-# INLINE lcoerce #-} instance Functor f => Profunctor (StarA f) where dimap f g (StarA point k) = StarA point (fmap g . k . f) lmap f (StarA point k) = StarA point (k . f) rmap g (StarA point k) = StarA point (fmap g . k)- {-# INLINE dimap #-}- {-# INLINE lmap #-}- {-# INLINE rmap #-} rcoerce' = rmap coerce- {-# INLINE rcoerce' #-} instance Functor f => Profunctor (Star f) where dimap f g (Star k) = Star (fmap g . k . f) lmap f (Star k) = Star (k . f) rmap g (Star k) = Star (fmap g . k)- {-# INLINE dimap #-}- {-# INLINE lmap #-}- {-# INLINE rmap #-} rcoerce' = rmap coerce- {-# INLINE rcoerce' #-} instance Profunctor (Forget r) where dimap f _ (Forget k) = Forget (k . f) lmap f (Forget k) = Forget (k . f) rmap _g (Forget k) = Forget k- {-# INLINE dimap #-}- {-# INLINE lmap #-}- {-# INLINE rmap #-} instance Profunctor (ForgetM r) where dimap f _ (ForgetM k) = ForgetM (k . f) lmap f (ForgetM k) = ForgetM (k . f) rmap _g (ForgetM k) = ForgetM k- {-# INLINE dimap #-}- {-# INLINE lmap #-}- {-# INLINE rmap #-} instance Profunctor FunArrow where dimap f g (FunArrow k) = FunArrow (g . k . f) lmap f (FunArrow k) = FunArrow (k . f) rmap g (FunArrow k) = FunArrow (g . k)- {-# INLINE dimap #-}- {-# INLINE lmap #-}- {-# INLINE rmap #-} instance Functor f => Profunctor (IxStarA f) where dimap f g (IxStarA point k) = IxStarA point (\i -> fmap g . k i . f) lmap f (IxStarA point k) = IxStarA point (\i -> k i . f) rmap g (IxStarA point k) = IxStarA point (\i -> fmap g . k i)- {-# INLINE dimap #-}- {-# INLINE lmap #-}- {-# INLINE rmap #-} rcoerce' = rmap coerce- {-# INLINE rcoerce' #-} conjoined__ _ f = f ixcontramap ij (IxStarA point k) = IxStarA point $ \i -> k (ij i)- {-# INLINE conjoined__ #-}- {-# INLINE ixcontramap #-} instance Functor f => Profunctor (IxStar f) where dimap f g (IxStar k) = IxStar (\i -> fmap g . k i . f) lmap f (IxStar k) = IxStar (\i -> k i . f) rmap g (IxStar k) = IxStar (\i -> fmap g . k i)- {-# INLINE dimap #-}- {-# INLINE lmap #-}- {-# INLINE rmap #-} rcoerce' = rmap coerce- {-# INLINE rcoerce' #-} conjoined__ _ f = f ixcontramap ij (IxStar k) = IxStar $ \i -> k (ij i)- {-# INLINE conjoined__ #-}- {-# INLINE ixcontramap #-} instance Profunctor (IxForget r) where dimap f _ (IxForget k) = IxForget (\i -> k i . f) lmap f (IxForget k) = IxForget (\i -> k i . f) rmap _g (IxForget k) = IxForget k- {-# INLINE dimap #-}- {-# INLINE lmap #-}- {-# INLINE rmap #-} conjoined__ _ f = f ixcontramap ij (IxForget k) = IxForget $ \i -> k (ij i)- {-# INLINE conjoined__ #-}- {-# INLINE ixcontramap #-} instance Profunctor (IxForgetM r) where dimap f _ (IxForgetM k) = IxForgetM (\i -> k i . f) lmap f (IxForgetM k) = IxForgetM (\i -> k i . f) rmap _g (IxForgetM k) = IxForgetM k- {-# INLINE dimap #-}- {-# INLINE lmap #-}- {-# INLINE rmap #-} conjoined__ _ f = f ixcontramap ij (IxForgetM k) = IxForgetM $ \i -> k (ij i)- {-# INLINE conjoined__ #-}- {-# INLINE ixcontramap #-} instance Profunctor IxFunArrow where dimap f g (IxFunArrow k) = IxFunArrow (\i -> g . k i . f) lmap f (IxFunArrow k) = IxFunArrow (\i -> k i . f) rmap g (IxFunArrow k) = IxFunArrow (\i -> g . k i)- {-# INLINE dimap #-}- {-# INLINE lmap #-}- {-# INLINE rmap #-} conjoined__ _ f = f ixcontramap ij (IxFunArrow k) = IxFunArrow $ \i -> k (ij i)- {-# INLINE conjoined__ #-}- {-# INLINE ixcontramap #-} ---------------------------------------- @@ -313,7 +258,6 @@ ((\(Context bt a) -> (a, bt)) . f (Context id)) (\(b, bt) -> bt b) . first'- {-# INLINE linear #-} -- There are a few places where default implementation is good enough. ilinear@@ -326,109 +270,73 @@ -> p j a b -> p (i -> j) s t ilinear f = coerce . linear (\afb -> f $ \_ -> afb)- {-# INLINE ilinear #-} instance Functor f => Strong (StarA f) where first' (StarA point k) = StarA point $ \ ~(a, c) -> (\b' -> (b', c)) <$> k a second' (StarA point k) = StarA point $ \ ~(c, a) -> (,) c <$> k a- {-# INLINE first' #-}- {-# INLINE second' #-} linear f (StarA point k) = StarA point (f k)- {-# INLINE linear #-} instance Functor f => Strong (Star f) where first' (Star k) = Star $ \ ~(a, c) -> (\b' -> (b', c)) <$> k a second' (Star k) = Star $ \ ~(c, a) -> (,) c <$> k a- {-# INLINE first' #-}- {-# INLINE second' #-} linear f (Star k) = Star (f k)- {-# INLINE linear #-} instance Strong (Forget r) where first' (Forget k) = Forget (k . fst) second' (Forget k) = Forget (k . snd)- {-# INLINE first' #-}- {-# INLINE second' #-} linear f (Forget k) = Forget (getConst #. f (Const #. k))- {-# INLINE linear #-} instance Strong (ForgetM r) where first' (ForgetM k) = ForgetM (k . fst) second' (ForgetM k) = ForgetM (k . snd)- {-# INLINE first' #-}- {-# INLINE second' #-} linear f (ForgetM k) = ForgetM (getConst #. f (Const #. k))- {-# INLINE linear #-} instance Strong FunArrow where first' (FunArrow k) = FunArrow $ \ ~(a, c) -> (k a, c) second' (FunArrow k) = FunArrow $ \ ~(c, a) -> (c, k a)- {-# INLINE first' #-}- {-# INLINE second' #-} linear f (FunArrow k) = FunArrow $ runIdentity #. f (Identity #. k)- {-# INLINE linear #-} instance Functor f => Strong (IxStarA f) where first' (IxStarA point k) = IxStarA point $ \i ~(a, c) -> (\b' -> (b', c)) <$> k i a second' (IxStarA point k) = IxStarA point $ \i ~(c, a) -> (,) c <$> k i a- {-# INLINE first' #-}- {-# INLINE second' #-} linear f (IxStarA point k) = IxStarA point $ \i -> f (k i) ilinear f (IxStarA point k) = IxStarA point $ \ij -> f $ \i -> k (ij i)- {-# INLINE linear #-}- {-# INLINE ilinear #-} instance Functor f => Strong (IxStar f) where first' (IxStar k) = IxStar $ \i ~(a, c) -> (\b' -> (b', c)) <$> k i a second' (IxStar k) = IxStar $ \i ~(c, a) -> (,) c <$> k i a- {-# INLINE first' #-}- {-# INLINE second' #-} linear f (IxStar k) = IxStar $ \i -> f (k i) ilinear f (IxStar k) = IxStar $ \ij -> f $ \i -> k (ij i)- {-# INLINE linear #-}- {-# INLINE ilinear #-} instance Strong (IxForget r) where first' (IxForget k) = IxForget $ \i -> k i . fst second' (IxForget k) = IxForget $ \i -> k i . snd- {-# INLINE first' #-}- {-# INLINE second' #-} linear f (IxForget k) = IxForget $ \i -> getConst #. f (Const #. k i) ilinear f (IxForget k) = IxForget $ \ij -> getConst #. f (\i -> Const #. k (ij i))- {-# INLINE linear #-}- {-# INLINE ilinear #-} instance Strong (IxForgetM r) where first' (IxForgetM k) = IxForgetM $ \i -> k i . fst second' (IxForgetM k) = IxForgetM $ \i -> k i . snd- {-# INLINE first' #-}- {-# INLINE second' #-} linear f (IxForgetM k) = IxForgetM $ \i -> getConst #. f (Const #. k i) ilinear f (IxForgetM k) = IxForgetM $ \ij -> getConst #. f (\i -> Const #. k (ij i))- {-# INLINE linear #-}- {-# INLINE ilinear #-} instance Strong IxFunArrow where first' (IxFunArrow k) = IxFunArrow $ \i ~(a, c) -> (k i a, c) second' (IxFunArrow k) = IxFunArrow $ \i ~(c, a) -> (c, k i a)- {-# INLINE first' #-}- {-# INLINE second' #-} linear f (IxFunArrow k) = IxFunArrow $ \i -> runIdentity #. f (Identity #. k i) ilinear f (IxFunArrow k) = IxFunArrow $ \ij -> runIdentity #. f (\i -> Identity #. k (ij i))- {-# INLINE linear #-}- {-# INLINE ilinear #-} ---------------------------------------- @@ -445,64 +353,44 @@ instance Functor f => Choice (StarA f) where left' (StarA point k) = StarA point $ either (fmap Left . k) (point . Right) right' (StarA point k) = StarA point $ either (point . Left) (fmap Right . k)- {-# INLINE left' #-}- {-# INLINE right' #-} instance Applicative f => Choice (Star f) where left' (Star k) = Star $ either (fmap Left . k) (pure . Right) right' (Star k) = Star $ either (pure . Left) (fmap Right . k)- {-# INLINE left' #-}- {-# INLINE right' #-} instance Monoid r => Choice (Forget r) where left' (Forget k) = Forget $ either k (const mempty) right' (Forget k) = Forget $ either (const mempty) k- {-# INLINE left' #-}- {-# INLINE right' #-} instance Choice (ForgetM r) where left' (ForgetM k) = ForgetM $ either k (const Nothing) right' (ForgetM k) = ForgetM $ either (const Nothing) k- {-# INLINE left' #-}- {-# INLINE right' #-} instance Choice FunArrow where left' (FunArrow k) = FunArrow $ either (Left . k) Right right' (FunArrow k) = FunArrow $ either Left (Right . k)- {-# INLINE left' #-}- {-# INLINE right' #-} instance Functor f => Choice (IxStarA f) where left' (IxStarA point k) = IxStarA point $ \i -> either (fmap Left . k i) (point . Right) right' (IxStarA point k) = IxStarA point $ \i -> either (point . Left) (fmap Right . k i)- {-# INLINE left' #-}- {-# INLINE right' #-} instance Applicative f => Choice (IxStar f) where left' (IxStar k) = IxStar $ \i -> either (fmap Left . k i) (pure . Right) right' (IxStar k) = IxStar $ \i -> either (pure . Left) (fmap Right . k i)- {-# INLINE left' #-}- {-# INLINE right' #-} instance Monoid r => Choice (IxForget r) where left' (IxForget k) = IxForget $ \i -> either (k i) (const mempty) right' (IxForget k) = IxForget $ \i -> either (const mempty) (k i)- {-# INLINE left' #-}- {-# INLINE right' #-} instance Choice (IxForgetM r) where left' (IxForgetM k) = IxForgetM $ \i -> either (k i) (const Nothing) right' (IxForgetM k) = IxForgetM $ \i -> either (const Nothing) (k i)- {-# INLINE left' #-}- {-# INLINE right' #-} instance Choice IxFunArrow where left' (IxFunArrow k) = IxFunArrow $ \i -> either (Left . k i) Right right' (IxFunArrow k) = IxFunArrow $ \i -> either Left (Right . k i)- {-# INLINE left' #-}- {-# INLINE right' #-} ---------------------------------------- @@ -513,26 +401,18 @@ instance Cochoice (Forget r) where unleft (Forget k) = Forget (k . Left) unright (Forget k) = Forget (k . Right)- {-# INLINE unleft #-}- {-# INLINE unright #-} instance Cochoice (ForgetM r) where unleft (ForgetM k) = ForgetM (k . Left) unright (ForgetM k) = ForgetM (k . Right)- {-# INLINE unleft #-}- {-# INLINE unright #-} instance Cochoice (IxForget r) where unleft (IxForget k) = IxForget $ \i -> k i . Left unright (IxForget k) = IxForget $ \i -> k i . Right- {-# INLINE unleft #-}- {-# INLINE unright #-} instance Cochoice (IxForgetM r) where unleft (IxForgetM k) = IxForgetM (\i -> k i . Left) unright (IxForgetM k) = IxForgetM (\i -> k i . Right)- {-# INLINE unleft #-}- {-# INLINE unright #-} ---------------------------------------- @@ -563,76 +443,55 @@ -> p j a b -> p (i -> j) s t ivisit f = coerce . visit (\point afb -> f point $ \_ -> afb)- {-# INLINE ivisit #-} instance Functor f => Visiting (StarA f) where visit f (StarA point k) = StarA point $ f point k ivisit f (StarA point k) = StarA point $ f point (\_ -> k)- {-# INLINE visit #-}- {-# INLINE ivisit #-} instance Applicative f => Visiting (Star f) where visit f (Star k) = Star $ f pure k ivisit f (Star k) = Star $ f pure (\_ -> k)- {-# INLINE visit #-}- {-# INLINE ivisit #-} instance Monoid r => Visiting (Forget r) where visit f (Forget k) = Forget $ getConst #. f pure (Const #. k) ivisit f (Forget k) = Forget $ getConst #. f pure (\_ -> Const #. k)- {-# INLINE visit #-}- {-# INLINE ivisit #-} instance Visiting (ForgetM r) where visit f (ForgetM k) = ForgetM $ getConst #. f (\_ -> Const Nothing) (Const #. k) ivisit f (ForgetM k) = ForgetM $ getConst #. f (\_ -> Const Nothing) (\_ -> Const #. k)- {-# INLINE visit #-}- {-# INLINE ivisit #-} instance Visiting FunArrow where visit f (FunArrow k) = FunArrow $ runIdentity #. f pure (Identity #. k) ivisit f (FunArrow k) = FunArrow $ runIdentity #. f pure (\_ -> Identity #. k)- {-# INLINE visit #-}- {-# INLINE ivisit #-} instance Functor f => Visiting (IxStarA f) where visit f (IxStarA point k) = IxStarA point $ \i -> f point (k i) ivisit f (IxStarA point k) = IxStarA point $ \ij -> f point $ \i -> k (ij i)- {-# INLINE visit #-}- {-# INLINE ivisit #-} instance Applicative f => Visiting (IxStar f) where visit f (IxStar k) = IxStar $ \i -> f pure (k i) ivisit f (IxStar k) = IxStar $ \ij -> f pure $ \i -> k (ij i)- {-# INLINE visit #-}- {-# INLINE ivisit #-} instance Monoid r => Visiting (IxForget r) where visit f (IxForget k) = IxForget $ \i -> getConst #. f pure (Const #. k i) ivisit f (IxForget k) = IxForget $ \ij -> getConst #. f pure (\i -> Const #. k (ij i))- {-# INLINE visit #-}- {-# INLINE ivisit #-} instance Visiting (IxForgetM r) where visit f (IxForgetM k) = IxForgetM $ \i -> getConst #. f (\_ -> Const Nothing) (Const #. k i) ivisit f (IxForgetM k) = IxForgetM $ \ij -> getConst #. f (\_ -> Const Nothing) (\i -> Const #. k (ij i))- {-# INLINE visit #-}- {-# INLINE ivisit #-} instance Visiting IxFunArrow where visit f (IxFunArrow k) = IxFunArrow $ \i -> runIdentity #. f pure (Identity #. k i) ivisit f (IxFunArrow k) = IxFunArrow $ \ij -> runIdentity #. f pure (\i -> Identity #. k (ij i))- {-# INLINE visit #-}- {-# INLINE ivisit #-} ---------------------------------------- @@ -649,42 +508,30 @@ instance Applicative f => Traversing (Star f) where wander f (Star k) = Star $ f k iwander f (Star k) = Star $ f (\_ -> k)- {-# INLINE wander #-}- {-# INLINE iwander #-} instance Monoid r => Traversing (Forget r) where wander f (Forget k) = Forget $ getConst #. f (Const #. k) iwander f (Forget k) = Forget $ getConst #. f (\_ -> Const #. k)- {-# INLINE wander #-}- {-# INLINE iwander #-} instance Traversing FunArrow where wander f (FunArrow k) = FunArrow $ runIdentity #. f (Identity #. k) iwander f (FunArrow k) = FunArrow $ runIdentity #. f (\_ -> Identity #. k)- {-# INLINE wander #-}- {-# INLINE iwander #-} instance Applicative f => Traversing (IxStar f) where wander f (IxStar k) = IxStar $ \i -> f (k i) iwander f (IxStar k) = IxStar $ \ij -> f $ \i -> k (ij i)- {-# INLINE wander #-}- {-# INLINE iwander #-} instance Monoid r => Traversing (IxForget r) where wander f (IxForget k) = IxForget $ \i -> getConst #. f (Const #. k i) iwander f (IxForget k) = IxForget $ \ij -> getConst #. f (\i -> Const #. k (ij i))- {-# INLINE wander #-}- {-# INLINE iwander #-} instance Traversing IxFunArrow where wander f (IxFunArrow k) = IxFunArrow $ \i -> runIdentity #. f (Identity #. k i) iwander f (IxFunArrow k) = IxFunArrow $ \ij -> runIdentity #. f (\i -> Identity #. k (ij i))- {-# INLINE wander #-}- {-# INLINE iwander #-} ---------------------------------------- @@ -701,14 +548,10 @@ instance Mapping FunArrow where roam f (FunArrow k) = FunArrow $ f k iroam f (FunArrow k) = FunArrow $ f (const k)- {-# INLINE roam #-}- {-# INLINE iroam #-} instance Mapping IxFunArrow where roam f (IxFunArrow k) = IxFunArrow $ \i -> f (k i) iroam f (IxFunArrow k) = IxFunArrow $ \ij -> f $ \i -> k (ij i)- {-# INLINE roam #-}- {-# INLINE iroam #-} -- | Type to represent the components of an isomorphism.@@ -719,9 +562,6 @@ dimap ss tt (Exchange sa bt) = Exchange (sa . ss) (tt . bt) lmap ss (Exchange sa bt) = Exchange (sa . ss) bt rmap tt (Exchange sa bt) = Exchange sa (tt . bt)- {-# INLINE dimap #-}- {-# INLINE lmap #-}- {-# INLINE rmap #-} -- | Type to represent the components of a lens. data Store a b i s t = Store (s -> a) (s -> b -> t)@@ -730,30 +570,21 @@ dimap f g (Store get set) = Store (get . f) (\s -> g . set (f s)) lmap f (Store get set) = Store (get . f) (\s -> set (f s)) rmap g (Store get set) = Store get (\s -> g . set s)- {-# INLINE dimap #-}- {-# INLINE lmap #-}- {-# INLINE rmap #-} instance Strong (Store a b) where first' (Store get set) = Store (get . fst) (\(s, c) b -> (set s b, c)) second' (Store get set) = Store (get . snd) (\(c, s) b -> (c, set s b))- {-# INLINE first' #-}- {-# INLINE second' #-} -- | Type to represent the components of a prism. data Market a b i s t = Market (b -> t) (s -> Either t a) instance Functor (Market a b i s) where fmap f (Market bt seta) = Market (f . bt) (either (Left . f) Right . seta)- {-# INLINE fmap #-} instance Profunctor (Market a b) where dimap f g (Market bt seta) = Market (g . bt) (either (Left . g) Right . seta . f) lmap f (Market bt seta) = Market bt (seta . f) rmap g (Market bt seta) = Market (g . bt) (either (Left . g) Right . seta)- {-# INLINE dimap #-}- {-# INLINE lmap #-}- {-# INLINE rmap #-} instance Choice (Market a b) where left' (Market bt seta) = Market (Left . bt) $ \sc -> case sc of@@ -766,8 +597,6 @@ Right s -> case seta s of Left t -> Left (Right t) Right a -> Right a- {-# INLINE left' #-}- {-# INLINE right' #-} -- | Type to represent the components of an affine traversal. data AffineMarket a b i s t = AffineMarket (s -> b -> t) (s -> Either t a)@@ -782,9 +611,6 @@ rmap g (AffineMarket sbt seta) = AffineMarket (\s b -> g (sbt s b)) (either (Left . g) Right . seta)- {-# INLINE dimap #-}- {-# INLINE lmap #-}- {-# INLINE rmap #-} instance Choice (AffineMarket a b) where left' (AffineMarket sbt seta) = AffineMarket@@ -797,8 +623,6 @@ (\sc -> case sc of Left c -> Left (Left c) Right s -> bimap Right id (seta s))- {-# INLINE left' #-}- {-# INLINE right' #-} instance Strong (AffineMarket a b) where first' (AffineMarket sbt seta) = AffineMarket@@ -807,42 +631,31 @@ second' (AffineMarket sbt seta) = AffineMarket (\(c, a) b -> (c, sbt a b)) (\(c, a) -> bimap (c,) id (seta a))- {-# INLINE first' #-}- {-# INLINE second' #-} bimap :: (a -> b) -> (c -> d) -> Either a c -> Either b d bimap f g = either (Left . f) (Right . g) instance Visiting (AffineMarket a b) - -- | Tag a value with not one but two phantom type parameters (so that 'Tagged' -- can be used as an indexed profunctor). newtype Tagged i a b = Tagged { unTagged :: b } instance Functor (Tagged i a) where fmap f = Tagged #. f .# unTagged- {-# INLINE fmap #-} instance Profunctor Tagged where dimap _f g = Tagged #. g .# unTagged lmap _f = coerce rmap g = Tagged #. g .# unTagged- {-# INLINE dimap #-}- {-# INLINE lmap #-}- {-# INLINE rmap #-} instance Choice Tagged where left' = Tagged #. Left .# unTagged right' = Tagged #. Right .# unTagged- {-# INLINE left' #-}- {-# INLINE right' #-} instance Costrong Tagged where unfirst (Tagged bd) = Tagged (fst bd) unsecond (Tagged db) = Tagged (snd db)- {-# INLINE unfirst #-}- {-# INLINE unsecond #-} data Context a b t = Context (b -> t) a@@ -854,7 +667,6 @@ (#.) :: Coercible b c => (b -> c) -> (a -> b) -> (a -> c) (#.) _f = coerce infixl 8 .#-{-# INLINE (#.) #-} -- | Composition operator where the second argument must be an -- identity function up to representational equivalence (e.g. a@@ -862,4 +674,3 @@ (.#) :: Coercible a b => (b -> c) -> (a -> b) -> (a -> c) (.#) f _g = coerce f infixr 9 #.-{-# INLINE (.#) #-}