74954e5 · semi-iso-optics

src/Control/Category/Structures.hs+6−1

compare with master

unifiedsplit

@@ -15,7 +15,12 @@ way then "Control.Arrow".

15

16Unfortunately names in this module clash with "Control.Arrow".

17-}

18−module Control.Category.Structures where

18+module Control.Category.Structures

19+ ( Products(..)

20+ , Coproducts(..)

21+ , CatPlus(..)

22+ , CatTrans(..)

23+ ) where

19

24

20import Control.Arrow (Kleisli(..))

25import Control.Arrow (Kleisli(..))

21import qualified Control.Arrow as BadArrow

26import qualified Control.Arrow as BadArrow

src/Control/Lens/Internal/SemiIso.hs+5−3

@@ -9,7 +9,9 @@ License : MIT

9Maintainer : Paweł Nowak <pawel834@gmail.com>

10Stability : experimental

11-}

12−module Control.Lens.Internal.SemiIso where

12+module Control.Lens.Internal.SemiIso

13+ ( Retail(..)

14+ ) where

13

15

14import Control.Monad

16import Control.Monad

15import Data.Profunctor

17import Data.Profunctor

@@ -25,9 +27,9 @@ instance Profunctor (Retail s t) where

25 rmap f (Retail l r) = Retail l (fmap f . r)

27 rmap f (Retail l r) = Retail l (fmap f . r)

26

28

27instance Choice (Retail s t) where

29instance Choice (Retail s t) where

28− left' (Retail as st) = Retail

30+ left' (Retail as st) = Retail

29 (either as (\_ -> Left "semi-iso failed")) (fmap Left . st)

31 (either as (\_ -> Left "semi-iso failed")) (fmap Left . st)

30− right' (Retail as st) = Retail

32+ right' (Retail as st) = Retail

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

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

32

34

33-- Proof of 'Exposed' laws:

35-- Proof of 'Exposed' laws:

src/Control/Lens/SemiIso.hs+6

@@ -4,6 +4,8 @@

4{-# LANGUAGE ViewPatterns #-}

5{-# LANGUAGE PatternSynonyms #-}

6{-# LANGUAGE FlexibleContexts #-}

7+

8+{-# OPTIONS_GHC -Wno-incomplete-patterns #-}

7{- |

9{- |

8Module : Control.Lens.SemiIso

10Module : Control.Lens.SemiIso

9Description : Semi-isomorphisms.

11Description : Semi-isomorphisms.

@@ -133,6 +135,10 @@ type ASemiIso' s a = ASemiIso s s a a

133

135

134-- | A nice pattern synonym for SemiIso's. Gives you the two functions, just like

136-- | A nice pattern synonym for SemiIso's. Gives you the two functions, just like

135-- 'viewSemiIso' or 'fromSemiIso'.

137-- 'viewSemiIso' or 'fromSemiIso'.

138+pattern SemiIso

139+ :: (s -> Either String a)

140+ -> (b -> Either String t)

141+ -> ASemiIso s t a b

136pattern SemiIso sa bt <- (viewSemiIso -> (sa, bt))

142pattern SemiIso sa bt <- (viewSemiIso -> (sa, bt))

137

143

138-- | A semi-iso stored in a container.

144-- | A semi-iso stored in a container.

src/Control/Tuple/Morph.hs+1−1

@@ -16,7 +16,7 @@

16 FlexibleContexts

17 #-}

18

19−{-# OPTIONS_GHC -Wno-incomplete-patterns #-}

19+{-# OPTIONS_GHC -Wno-incomplete-patterns -Wno-redundant-constraints #-}

20

21module Control.Tuple.Morph

22 ( morphTuples

src/Data/Profunctor/Exposed.hs+6−4

@@ -9,18 +9,20 @@ License : MIT

9Maintainer : Paweł Nowak <pawel834@gmail.com>

10Stability : experimental

11-}

12−module Data.Profunctor.Exposed where

12+module Data.Profunctor.Exposed

13+ ( Exposed(..)

14+ ) where

13

15

14import Data.Profunctor

16import Data.Profunctor

15

17

16-- | Exposes structure of a Kleisli category beneath a profunctor.

18-- | Exposes structure of a Kleisli category beneath a profunctor.

17−--

19+--

18-- Should obey laws:

20-- Should obey laws:

19−--

21+--

20-- prop> merge . rmap return = id

22-- prop> merge . rmap return = id

21-- prop> lmap return . expose = id

23-- prop> lmap return . expose = id

22-- prop> rmap (>>= f) = merge . rmap (fmap f)

24-- prop> rmap (>>= f) = merge . rmap (fmap f)

23-- prop> lmap (fmap f) . expose = expose . lmap f

25-- prop> lmap (fmap f) . expose = expose . lmap f

24class (Monad m, Profunctor p) => Exposed m p | p -> m where

26class (Monad m, Profunctor p) => Exposed m p | p -> m where

25 expose :: p a b -> p (m a) b

27 expose :: p a b -> p (m a) b

26− merge :: p a (m b) -> p a b

28+ merge :: p a (m b) -> p a b