@@ -0,0 +1,123 @@
1+{-# LANGUAGE Rank2Types #-}
2+{-# LANGUAGE TupleSections #-}
3+{- |
4+Module : Data.Lens.SemiIso
5+Description : Semi-isomorphisms.
6+Copyright : (c) Paweł Nowak
7+License : MIT
8+
9+Maintainer : Paweł Nowak <pawel834@gmail.com>
10+Stability : experimental
11+
12+Semi-isomorphisms were motivated by reversible parsing/pretty printing. For example
13+we can map a number 12 to a string "12" (and the other way around). But the isomorphism
14+is partial - we cannot map the string "forty-two" to a number.
15+
16+Another example: when parsing a list of numbers like "12_53___42" we want to skip underscores
17+between numbers (and forget about them). During pretty printing we have to decide how many
18+underscores should we insert between numbers. Let's say we insert a single underscore. But now
19+@prettyPrint (parse "12_53___42") = "12_53_42"@ and not "12_53___42". We have to weaken
20+isomorphism laws to allow such semi-iso. Notice that
21+
22+> parse (prettyPrint (parse "12_53___42")) = parse "12_53___42"
23+> prettyPrint (parse (prettyPrint [12, 53, 42])) = prettyPrint [12, 53, 42]
24+
25+Our semi-isomorphisms will obey weakened laws:
26+
27+> apply i >=> unapply i >=> apply i = apply i
28+> unapply i >=> apply i >=> unapply i = unapply i
29+
30+When you see an "Either String a", the String is usually an error message.
31+
32+Disclaimer: the name "semi-isomorphism" is fictitious and made up for this library.
33+Any resemblance to known mathematical objects of the same name is purely coincidental.
34+-}
35+module Control.Lens.SemiIso (
36+ -- * Semi-isomorphism types.
37+ SemiIso,
38+ SemiIso',
39+ ASemiIso,
40+ ASemiIso',
41+
42+ -- * Constructing semi-isos.
43+ semiIso,
44+
45+ -- * Consuming semi-isos.
46+ withSemiIso,
47+ fromSemi,
48+ apply,
49+ unapply,
50+
51+ -- * Common semi-isomorphisms and isomorphisms.
52+ unit,
53+ swapped,
54+ associated,
55+ constant
56+ ) where
57+
58+import Control.Lens.Internal.SemiIso
59+import Control.Lens.Iso
60+import Data.Functor.Identity
61+import Data.Traversable
62+
63+-- | A semi-isomorphism is a partial isomorphism with weakened laws.
64+--
65+-- Should satisfy laws:
66+--
67+-- > apply i >=> unapply i >=> apply i = apply i
68+-- > unapply i >=> apply i >=> unapply i = unapply i
69+--
70+-- Every 'Prism' is a 'SemiIso'.
71+-- Every 'Iso' is a 'Prism'.
72+type SemiIso s t a b = forall p f. (Failure p, Traversable f) => p a (f b) -> p s (f t)
73+
74+-- | Non-polymorphic variant of 'SemiIso'.
75+type SemiIso' s a = SemiIso s s a a
76+
77+-- | When you see this as an argument to a function, it expects a 'SemiIso'.
78+type ASemiIso s t a b = Barter a b a (Identity b) -> Barter a b s (Identity t)
79+
80+-- | When you see this as an argument to a function, it expects a 'SemiIso''.
81+type ASemiIso' s a = ASemiIso s s a a
82+
83+-- | Constructs a semi isomorphism from a pair of functions that can
84+-- fail with an error message.
85+semiIso :: (s -> Either String a) -> (b -> Either String t) -> SemiIso s t a b
86+semiIso sa bt = tie . dimap sa (sequenceA . fmap bt) . attach
87+
88+-- | Extracts the two functions that characterize the 'SemiIso'.
89+withSemiIso :: ASemiIso s t a b
90+ -> ((s -> Either String a) -> (b -> Either String t) -> r)
91+ -> r
92+withSemiIso ai k = case ai (Barter Right (Right . Identity)) of
93+ Barter sa bt -> k sa (rmap (runIdentity . sequenceA) bt)
94+
95+-- | Applies the 'SemiIso'.
96+apply :: ASemiIso s t a b -> s -> Either String a
97+apply ai = withSemiIso ai $ \l _ -> l
98+
99+-- | Applies the 'SemiIso' in the opposite direction.
100+unapply :: ASemiIso s t a b -> b -> Either String t
101+unapply ai = withSemiIso ai $ \_ r -> r
102+
103+-- | Reverses a 'SemiIso'.
104+fromSemi :: ASemiIso s t a b -> SemiIso b a t s
105+fromSemi ai = withSemiIso ai $ \l r -> semiIso r l
106+
107+-- | A trivial isomorphism between a and (a, ()).
108+unit :: Iso' a (a, ())
109+unit = iso (, ()) fst
110+
111+-- | Products are associative.
112+associated :: Iso' (a, (b, c)) ((a, b), c)
113+associated = iso (\(a, (b, c)) -> ((a, b), c)) (\((a, b), c) -> (a, (b, c)))
114+
115+-- | \-> Always returns the argument.
116+--
117+-- \<- Filters out all values not equal to the argument.
118+constant :: Eq a => a -> SemiIso' () a
119+constant x = semiIso f g
120+ where
121+ f _ = Right x
122+ g y | x == y = Right ()
123+ | otherwise = Left "constant: not equal"