git.iko.soy/semi-iso-optics
on master help sign in
Refactoring, added SemiIso pattern synonym.
d5cf2a9Paweł Nowak
Control/Lens/SemiIso.hs+102−56
compare with master
unifiedsplit
@@ -1,5 +1,7 @@
1{-# LANGUAGE Rank2Types #-}
1{-# LANGUAGE Rank2Types #-}
2{-# LANGUAGE TupleSections #-}
2{-# LANGUAGE TupleSections #-}
3+{-# LANGUAGE ViewPatterns #-}
4+{-# LANGUAGE PatternSynonyms #-}
3{-# LANGUAGE FlexibleContexts #-}
5{-# LANGUAGE FlexibleContexts #-}
4{- |
6{- |
5Module : Control.Lens.SemiIso
7Module : Control.Lens.SemiIso
@@ -39,24 +41,19 @@ module Control.Lens.SemiIso (
39 SemiIso',
41 SemiIso',
40 ASemiIso,
42 ASemiIso,
41 ASemiIso',
43 ASemiIso',
42−
44+
45+ -- * Patterns.
46+ pattern SemiIso,
47+
43 -- * Constructing semi-isos.
48 -- * Constructing semi-isos.
44 semiIso,
49 semiIso,
45
50
46− -- * Transforming semi-isos.
47− withSemiIso,
48− attempt,
49− attemptAp,
50− attemptUn,
51− attempt_,
52− attemptAp_,
53− attemptUn_,
54−
55 -- * Consuming semi-isos.
51 -- * Consuming semi-isos.
56− fromSemi,
57 apply,
52 apply,
58 unapply,
53 unapply,
59−
54+ withSemiIso,
55+ viewSemiIso,
56+
60 -- * Common semi-isomorphisms and isomorphisms.
57 -- * Common semi-isomorphisms and isomorphisms.
61 unit,
58 unit,
62 swapped,
59 swapped,
@@ -64,6 +61,22 @@ module Control.Lens.SemiIso (
64 constant,
61 constant,
65 exact,
62 exact,
66
63
64+ -- * Semi-isos for numbers.
65+ _Negative,
66+ _Positive,
67+
68+ -- * Transforming semi-isos.
69+ rev,
70+ prod,
71+ elimFirst,
72+ elimSecond,
73+ attempt,
74+ attemptAp,
75+ attemptUn,
76+ attempt_,
77+ attemptAp_,
78+ attemptUn_,
79+
67 -- * Folds.
80 -- * Folds.
68 foldlM1,
81 foldlM1,
69 foldrM1,
82 foldrM1,
@@ -79,6 +92,7 @@ module Control.Lens.SemiIso (
79 bifoldl1
92 bifoldl1
80 ) where
93 ) where
81
94
95+import Control.Arrow
82import Control.Lens.Internal.SemiIso
96import Control.Lens.Internal.SemiIso
83import Control.Lens.Iso
97import Control.Lens.Iso
84import Data.Foldable
98import Data.Foldable
@@ -95,7 +109,8 @@ import Data.Traversable
95--
109--
96-- Every 'Prism' is a 'SemiIso'.
110-- Every 'Prism' is a 'SemiIso'.
97-- Every 'Iso' is a 'Prism'.
111-- Every 'Iso' is a 'Prism'.
98−type SemiIso s t a b = forall p f. (Exposed (Either String) p, Traversable f) => p a (f b) -> p s (f t)
112+type SemiIso s t a b = forall p f. (Exposed (Either String) p, Traversable f)
113+ => p a (f b) -> p s (f t)
99
114
100-- | Non-polymorphic variant of 'SemiIso'.
115-- | Non-polymorphic variant of 'SemiIso'.
101type SemiIso' s a = SemiIso s s a a
116type SemiIso' s a = SemiIso s s a a
@@ -106,11 +121,23 @@ type ASemiIso s t a b = Retail a b a (Identity b) -> Retail a b s (Identity t)
106-- | When you see this as an argument to a function, it expects a 'SemiIso''.
121-- | When you see this as an argument to a function, it expects a 'SemiIso''.
107type ASemiIso' s a = ASemiIso s s a a
122type ASemiIso' s a = ASemiIso s s a a
108
123
124+-- | A nice pattern synonym for SemiIso's. Gives you the two functions, just like
125+-- 'viewSemiIso' or 'fromSemiIso'.
126+pattern SemiIso sa bt <- (viewSemiIso -> (sa, bt))
127+
109-- | Constructs a semi isomorphism from a pair of functions that can
128-- | Constructs a semi isomorphism from a pair of functions that can
110-- fail with an error message.
129-- fail with an error message.
111semiIso :: (s -> Either String a) -> (b -> Either String t) -> SemiIso s t a b
130semiIso :: (s -> Either String a) -> (b -> Either String t) -> SemiIso s t a b
112semiIso sa bt = merge . dimap sa (sequenceA . fmap bt) . expose
131semiIso sa bt = merge . dimap sa (sequenceA . fmap bt) . expose
113
132
133+-- | Applies the 'SemiIso'.
134+apply :: ASemiIso s t a b -> s -> Either String a
135+apply (SemiIso sa _) = sa
136+
137+-- | Applies the 'SemiIso' in the opposite direction.
138+unapply :: ASemiIso s t a b -> b -> Either String t
139+unapply (SemiIso _ bt) = bt
140+
114-- | Extracts the two functions that characterize the 'SemiIso'.
141-- | Extracts the two functions that characterize the 'SemiIso'.
115withSemiIso :: ASemiIso s t a b
142withSemiIso :: ASemiIso s t a b
116 -> ((s -> Either String a) -> (b -> Either String t) -> r)
143 -> ((s -> Either String a) -> (b -> Either String t) -> r)
@@ -118,49 +145,9 @@ withSemiIso :: ASemiIso s t a b
118withSemiIso ai k = case ai (Retail Right (Right . Identity)) of
145withSemiIso ai k = case ai (Retail Right (Right . Identity)) of
119 Retail sa bt -> k sa (rmap (runIdentity . sequenceA) bt)
146 Retail sa bt -> k sa (rmap (runIdentity . sequenceA) bt)
120
147
121−-- | Transforms the semi-iso so that applying it in both directions never fails,
148+-- | Extracts the two functions that characterize the 'SemiIso'.
122−-- but instead catches any errors and returns them as an @Either String a@.
123−attempt :: ASemiIso s t a b -> SemiIso s (Either String t) (Either String a) b
124−attempt = attemptAp . attemptUn
125−
126−-- | Transforms the semi-iso so that applying it in direction (->) never fails,
127−-- but instead catches any errors and returns them as an @Either String a@.
128−attemptAp :: ASemiIso s t a b -> SemiIso s t (Either String a) b
129−attemptAp ai = withSemiIso ai $ \l r -> semiIso (Right . l) r
130−
131−-- | Transforms the semi-iso so that applying it in direction (<-) never fails,
132−-- but instead catches any errors and returns them as an @Either String a@.
133−attemptUn :: ASemiIso s t a b -> SemiIso s (Either String t) a b
134−attemptUn ai = withSemiIso ai $ \l r -> semiIso l (Right . r)
135−
136−discard :: Either a b -> Maybe b
137−discard = either (const Nothing) Just
138−
139−-- | Transforms the semi-iso like 'attempt', but ignores the error message.
140−attempt_ :: ASemiIso s t a b -> SemiIso s (Maybe t) (Maybe a) b
141−attempt_ ai = rmap (fmap discard) . attempt ai . lmap discard
142−
143−-- | Transforms the semi-iso like 'attemptAp', but ignores the error message.
144−--
145−-- Very useful when you want to bifold using a prism.
146−attemptAp_ :: ASemiIso s t a b -> SemiIso s t (Maybe a) b
147−attemptAp_ ai = attemptAp ai . lmap discard
148−
149−-- | Transforms the semi-iso like 'attemptUn', but ignores the error message.
150−attemptUn_ :: ASemiIso s t a b -> SemiIso s (Maybe t) a b
151−attemptUn_ ai = rmap (fmap discard) . attemptUn ai
152−
153−-- | Applies the 'SemiIso'.
154−apply :: ASemiIso s t a b -> s -> Either String a
149+viewSemiIso :: ASemiIso s t a b -> (s -> Either String a, b -> Either String t)
155−apply ai = withSemiIso ai $ \l _ -> l
156−
157−-- | Applies the 'SemiIso' in the opposite direction.
158−unapply :: ASemiIso s t a b -> b -> Either String t
159−unapply ai = withSemiIso ai $ \_ r -> r
150+viewSemiIso ai = withSemiIso ai (,)
160−
161−-- | Reverses a 'SemiIso'.
162−fromSemi :: ASemiIso s t a b -> SemiIso b a t s
163−fromSemi ai = withSemiIso ai $ \l r -> semiIso r l
164
151
165-- | A trivial isomorphism between a and (a, ()).
152-- | A trivial isomorphism between a and (a, ()).
166unit :: Iso' a (a, ())
153unit :: Iso' a (a, ())
@@ -192,6 +179,65 @@ exact x = semiIso f g
192 g y | x == y = Right ()
179 g y | x == y = Right ()
193 | otherwise = Left "exact: not equal"
180 | otherwise = Left "exact: not equal"
194
181
182+_Negative :: Num a => SemiIso' a a
183+_Negative = undefined
184+
185+_Positive :: Num a => SemiIso' a a
186+_Positive = undefined
187+
188+-- | Reverses a 'SemiIso'.
189+rev :: ASemiIso s t a b -> SemiIso b a t s
190+rev ai = withSemiIso ai $ \l r -> semiIso r l
191+
192+-- | A product of SemiIso's.
193+prod :: ASemiIso s t a b -> ASemiIso s' t' a' b'
194+ -> SemiIso (s, s') (t, t') (a, a') (b, b')
195+prod (SemiIso sa bt) (SemiIso sa' bt') = semiIso
196+ (runKleisli (Kleisli sa *** Kleisli sa'))
197+ (runKleisli (Kleisli bt *** Kleisli bt'))
198+
199+-- | In the non-polymorphic case uses an @SemiIso a ()@ to construct a
200+-- @SemiIso (a, b) b@, i.e. eliminates the first pair element.
201+elimFirst :: ASemiIso s' t' () () -> SemiIso (s', t) (t', t) t t
202+elimFirst ai = swapped . elimSecond ai
203+
204+-- | In the non-polymorphic case uses an @SemiIso b ()@ to construct a
205+-- @SemiIso (a, b) a@, i.e. eliminates the second pair element.
206+elimSecond :: ASemiIso s' t' () () -> SemiIso (t, s') (t, t') t t
207+elimSecond ai = prod id ai . rev unit
208+
209+-- | Transforms the semi-iso so that applying it in both directions never fails,
210+-- but instead catches any errors and returns them as an @Either String a@.
211+attempt :: ASemiIso s t a b -> SemiIso s (Either String t) (Either String a) b
212+attempt = attemptAp . attemptUn
213+
214+-- | Transforms the semi-iso so that applying it in direction (->) never fails,
215+-- but instead catches any errors and returns them as an @Either String a@.
216+attemptAp :: ASemiIso s t a b -> SemiIso s t (Either String a) b
217+attemptAp (SemiIso sa bt) = semiIso (Right . sa) bt
218+
219+-- | Transforms the semi-iso so that applying it in direction (<-) never fails,
220+-- but instead catches any errors and returns them as an @Either String a@.
221+attemptUn :: ASemiIso s t a b -> SemiIso s (Either String t) a b
222+attemptUn (SemiIso sa bt) = semiIso sa (Right . bt)
223+
224+discard :: Either a b -> Maybe b
225+discard = either (const Nothing) Just
226+
227+-- | Transforms the semi-iso like 'attempt', but ignores the error message.
228+attempt_ :: ASemiIso s t a b -> SemiIso s (Maybe t) (Maybe a) b
229+attempt_ ai = rmap (fmap discard) . attempt ai . lmap discard
230+
231+-- | Transforms the semi-iso like 'attemptAp', but ignores the error message.
232+--
233+-- Very useful when you want to bifold using a prism.
234+attemptAp_ :: ASemiIso s t a b -> SemiIso s t (Maybe a) b
235+attemptAp_ ai = attemptAp ai . lmap discard
236+
237+-- | Transforms the semi-iso like 'attemptUn', but ignores the error message.
238+attemptUn_ :: ASemiIso s t a b -> SemiIso s (Maybe t) a b
239+attemptUn_ ai = rmap (fmap discard) . attemptUn ai
240+
195-- | Monadic counterpart of 'foldl1' (or non-empty list counterpart of 'foldlM').
241-- | Monadic counterpart of 'foldl1' (or non-empty list counterpart of 'foldlM').
196foldlM1 :: Monad m => (a -> a -> m a) -> [a] -> m a
242foldlM1 :: Monad m => (a -> a -> m a) -> [a] -> m a
197foldlM1 f (x:xs) = foldlM f x xs
243foldlM1 f (x:xs) = foldlM f x xs
Data/SemiIsoFunctor.hs+4−4
@@ -42,12 +42,12 @@ infixl 5 /*/, /*, */
42class SemiIsoFunctor f where
42class SemiIsoFunctor f where
43 -- | The contravariant map.
43 -- | The contravariant map.
44 simap :: ASemiIso' a b -> f b -> f a
44 simap :: ASemiIso' a b -> f b -> f a
45− simap = simapCo . fromSemi
45+ simap = simapCo . rev
46−
46+
47 -- | The covariant map.
47 -- | The covariant map.
48 simapCo :: ASemiIso' a b -> f a -> f b
48 simapCo :: ASemiIso' a b -> f a -> f b
49− simapCo = simap . fromSemi
49+ simapCo = simap . rev
50−
50+
51 {-# MINIMAL simap | simapCo #-}
51 {-# MINIMAL simap | simapCo #-}
52
52
53-- | A infix operator for 'simap'.
53-- | A infix operator for 'simap'.
semi-iso.cabal+1−1
@@ -1,5 +1,5 @@
1name: semi-iso
1name: semi-iso
2−version: 0.3.0.0
2+version: 0.4.0.0
3synopsis: Weakened partial isomorphisms that work with lenses.
3synopsis: Weakened partial isomorphisms that work with lenses.
4description: Semi-isomorphisms are partial isomorphisms with weakened iso laws.
4description: Semi-isomorphisms are partial isomorphisms with weakened iso laws.
5 And they work with Iso and Prism from @lens@!
5 And they work with Iso and Prism from @lens@!