6886ad1 · semi-iso-optics

git.iko.soy/semi-iso-optics

Generalize Failure to Exposed typeclass.

commit6886ad15ae7b5d0db1f30803808a704da35d49a5 authorPaweł Nowak <pawel834@gmail.com> dateThu 30 Oct 2014, 12:32 (12 years ago) parentbe10e53

3 files changed+47−15

compare with master

unifiedsplit

Control/Lens/Internal/SemiIso.hs+39−9 Control/Lens/SemiIso.hs+6−5 semi-iso.cabal+2−1

Control/Lens/Internal/SemiIso.hs+39−9

@@ -1,3 +1,5 @@

1+{-# LANGUAGE FlexibleInstances #-}

2+{-# LANGUAGE MultiParamTypeClasses #-}

13{- |

24Module : Data.Lens.Internal.SemiIso

35Description : Internals of a SemiIso.

@@ -11,6 +13,7 @@ module Control.Lens.Internal.SemiIso where

1113

1214import Control.Monad

1315import Data.Profunctor

16+import Data.Profunctor.Exposed

1417

1518-- | Type used internally to access 'SemiIso'.

1619--

@@ -27,13 +30,40 @@ instance Choice (Barter s t) where

2730 right' (Barter as st) = Barter

2831 (either (\_ -> Left "partial iso failed") as) (fmap Right . st)

2932

30−-- | Provides a profunctor the ability to fail with an error message.

33+-- Proof of 'Exposed' laws:

3134--

32−-- This class could use some laws. It is certainly a bit ad-hoc.

33−class Profunctor p => Failure p where

34− tie :: p a (Either String b) -> p a b

35− attach :: p a b -> p (Either String a) b

36−

37−instance Failure (Barter s t) where

38− tie (Barter f g) = Barter f (join . g)

39− attach (Barter f g) = Barter (>>= f) g

35+-- > merge . rmap return = id

36+--

37+-- merge . rmap return $ Barter l r =

38+-- merge $ Barter l (return . r) =

39+-- Barter l (join . return . r) =

40+-- Barter l r

41+--

42+-- > lmap return . expose = id

43+--

44+-- lmap return . expose $ Barter l r =

45+-- lmap return $ Barter (>>= l) r =

46+-- Barter ((>>= l) . return) r =

47+-- Barter (join . fmap l . return) r =

48+-- Barter (join . return . l) r =

49+-- Barter l r

50+--

51+-- > rmap (>>= f) = merge . rmap (fmap f)

52+--

53+-- rmap (>>= f) $ Barter l r =

54+-- Barter l ((>>= f) . r) =

55+-- Barter l (join . fmap f . r) =

56+-- merge $ Barter l (fmap f . r) =

57+-- merge . rmap (fmap f) $ Barter l r

58+--

59+-- > lmap (fmap f) . expose = expose . lmap f

60+--

61+-- lmap (fmap f) . expose $ Barter l r =

62+-- lmap (fmap f) $ Barter (>>= l) r =

63+-- Barter ((>>= l) . fmap f) r =

64+-- Barter (>>= (l . f)) r =

65+-- expose $ Barter (l . f) r =

66+-- expose . lmap f $ Barter l r

67+instance Exposed (Either String) (Barter s t) where

68+ expose (Barter l r) = Barter (>>= l) r

69+ merge (Barter l r) = Barter l (join . r)

Control/Lens/SemiIso.hs+6−5

@@ -1,5 +1,6 @@

11{-# LANGUAGE Rank2Types #-}

22{-# LANGUAGE TupleSections #-}

3+{-# LANGUAGE FlexibleContexts #-}

34{- |

45Module : Data.Lens.SemiIso

56Description : Semi-isomorphisms.

@@ -61,10 +62,10 @@ module Control.Lens.SemiIso (

6162

6263import Control.Lens.Internal.SemiIso

6364import Control.Lens.Iso

64−import Control.Monad

65+import Data.Foldable

6566import Data.Functor.Identity

67+import Data.Profunctor.Exposed

6668import Data.Traversable

67−import Data.Foldable

6869

6970-- | A semi-isomorphism is a partial isomorphism with weakened laws.

7071--

@@ -75,7 +76,7 @@ import Data.Foldable

7576--

7677-- Every 'Prism' is a 'SemiIso'.

7778-- Every 'Iso' is a 'Prism'.

78−type SemiIso s t a b = forall p f. (Failure p, Traversable f) => p a (f b) -> p s (f t)

79+type SemiIso s t a b = forall p f. (Exposed (Either String) p, Traversable f) => p a (f b) -> p s (f t)

7980

8081-- | Non-polymorphic variant of 'SemiIso'.

8182type SemiIso' s a = SemiIso s s a a

@@ -89,7 +90,7 @@ type ASemiIso' s a = ASemiIso s s a a

8990-- | Constructs a semi isomorphism from a pair of functions that can

9091-- fail with an error message.

9192semiIso :: (s -> Either String a) -> (b -> Either String t) -> SemiIso s t a b

92−semiIso sa bt = tie . dimap sa (sequenceA . fmap bt) . attach

93+semiIso sa bt = merge . dimap sa (sequenceA . fmap bt) . expose

9394

9495-- | Extracts the two functions that characterize the 'SemiIso'.

9596withSemiIso :: ASemiIso s t a b

@@ -158,4 +159,4 @@ bifoldr ai = semiIso (f ai) (g ai)

158159 Just (b, new_a) -> do

159160 (final_a, bs) <- unfoldrM f new_a

160161 return (final_a, b : bs)

161− Nothing -> return (a, [])

162+ Nothing -> return (a, [])

semi-iso.cabal+2−1

@@ -1,5 +1,5 @@

11name: semi-iso

2−version: 0.2.1.0

2+version: 0.3.0.0

33synopsis: Weakened partial isomorphisms that work with lenses.

44description: Semi-isomorphisms are partial isomorphisms with weakened iso laws.

55 And they work with Iso and Prism from @lens@!

@@ -23,5 +23,6 @@ library

2323 exposed-modules: Control.Lens.SemiIso

2424 Control.Lens.Internal.SemiIso

2525 Data.SemiIsoFunctor

26+ Data.Profunctor.Exposed

2627 build-depends: base >= 4 && < 5, profunctors, transformers, lens

2728 default-language: Haskell2010