git.iko.soy/generic-lens
on master help sign in
Small cleanups in prism code
commit954471aad4bac4d90fbe0582cfb126d77a1ee042 authorOleg Grenrus <oleg.grenrus@iki.fi> dateThu 27 Sep 2018, 02:48 (8 years ago) parent238b01d
2 files changed+8−10
compare with master
unifiedsplit
src/Data/Generics/Internal/Profunctor/Prism.hs+6−8 src/Data/Generics/Sum/Internal/Constructors.hs+2−2
src/Data/Generics/Internal/Profunctor/Prism.hs+6−8
@@ -21,6 +21,7 @@
2121-----------------------------------------------------------------------------
2222module Data.Generics.Internal.Profunctor.Prism where
2323
24+import Data.Bifunctor (bimap)
2425import Data.Profunctor (Choice(..), Profunctor(..))
2526import Data.Tagged
2627import Data.Profunctor.Unsafe ((#.), (.#))
@@ -44,12 +45,12 @@ prism :: (b -> t) -> (s -> Either t a) -> Prism s t a b
4445prism bt seta eta = dimap seta (either id bt) (right' eta)
4546
4647_Left :: Prism (Either a c) (Either b c) a b
47−_Left = prism Left $ either Right (Left . Right)
48+_Left = left'
4849
4950_Right :: Prism (Either c a) (Either c b) a b
50−_Right = prism Right $ either (Left . Left) Right
51+_Right = right'
5152
52−prismPRavel :: (Market a b a b -> Market a b s t) -> Prism s t a b
53+prismPRavel :: APrism s t a b -> Prism s t a b
5354prismPRavel l pab = (prism2prismp $ l idPrism) pab
5455
5556build :: (Tagged b b -> Tagged t t) -> b -> t
@@ -65,9 +66,7 @@ without' :: Prism s t a b -> Prism s t c d -> Prism s t (Either a c) (Either b d
6566without' k =
6667 withPrism k $ \bt _ k' ->
6768 withPrism k' $ \dt setc ->
68− prism (foldEither bt dt) $ \s -> fmap Right (setc s)
69− where foldEither _ g (Right r) = g r
70− foldEither f _ (Left l) = f l
69+ prism (either bt dt) $ \s -> fmap Right (setc s)
7170{-# INLINE without' #-}
7271
7372withPrism :: APrism s t a b -> ((b -> t) -> (s -> Either t a) -> r) -> r
@@ -85,8 +84,7 @@ gsum f _ (L1 x) = f x
8584gsum _ g (R1 y) = g y
8685
8786plus :: (a -> b) -> (c -> d) -> Either a c -> Either b d
88−plus f _ (Left x) = Left (f x)
89−plus _ g (Right y) = Right (g y)
87+plus = bimap
9088
9189--------------------------------------------------------------------------------
9290-- Market
src/Data/Generics/Sum/Internal/Constructors.hs+2−2
@@ -31,6 +31,7 @@ module Data.Generics.Sum.Internal.Constructors
3131
3232import Data.Generics.Internal.Families
3333import Data.Generics.Product.Internal.HList
34+import Data.Profunctor (Profunctor(..))
3435
3536import GHC.Generics
3637import GHC.TypeLits (Symbol)
@@ -52,10 +53,9 @@ instance
5253 , ListTuple b bs
5354 ) => GAsConstructor ctor (M1 C ('MetaCons ctor fixity fields) f) (M1 C ('MetaCons ctor fixity fields) g) a b where
5455
55− _GCtor = prism (M1 . view (fromIso glist) . tupleToList) (Right . listToTuple . view glist . unM1)
56+ _GCtor = dimap (listToTuple . view glist . unM1) (M1 . view (fromIso glist) . tupleToList)
5657 {-# INLINE[0] _GCtor #-}
5758
58−
5959instance GSumAsConstructor ctor (HasCtorP ctor l) l r l' r' a b => GAsConstructor ctor (l :+: r) (l' :+: r') a b where
6060 _GCtor = _GSumCtor @ctor @(HasCtorP ctor l)
6161 {-# INLINE[0] _GCtor #-}