semi-iso 0.5.0.0 → 1.0.0.0

raw patch · 7 files changed

+445/−258 lines, 7 filesdep +semigroupoidsPVP ok

version bump matches the API change (PVP)

Dependencies added: semigroupoids

API changes (from Hackage documentation)

Files

• Control/Category/Reader.hs +47/−0
• Control/Category/Structures.hs +113/−0
• Control/Lens/SemiIso.hs +28/−7
• Control/SIArrow.hs +206/−0
• Data/SemiIsoFunctor.hs +0/−204
• Data/SemiIsoFunctor/Wrapped.hs +0/−37
• semi-iso.cabal +51/−10

@@ -0,0 +1,47 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeFamilies #-}+{- |+Module      :  Control.Category.Reader+Description :  Reader category transformer.+Copyright   :  (c) Paweł Nowak+License     :  MIT++Maintainer  :  Paweł Nowak <pawel834@gmail.com>+Stability   :  experimental++Provides a Reader category transformer.+-}+module Control.Category.Reader (+    ReaderCT(..)+    ) where++import Control.Category+import Control.Category.Structures+import Control.Lens.Iso+import Control.Lens.SemiIso+import Control.SIArrow+import Prelude hiding (id, (.))++newtype ReaderCT env cat a b = ReaderCT { runReaderCT :: env -> cat a b }++instance CatTrans (ReaderCT env) where+    clift = ReaderCT . const++instance Category cat => Category (ReaderCT env cat) where+    id = clift id+    ReaderCT f . ReaderCT g = ReaderCT $ \x -> f x . g x++instance Products cat => Products (ReaderCT env cat) where+    ReaderCT f *** ReaderCT g = ReaderCT $ \x -> f x *** g x++instance Coproducts cat => Coproducts (ReaderCT env cat) where+    ReaderCT f +++ ReaderCT g = ReaderCT $ \x -> f x +++ g x++instance CatPlus cat => CatPlus (ReaderCT env cat) where+    cempty = clift cempty+    ReaderCT f /+/ ReaderCT g = ReaderCT $ \x -> f x /+/ g x++instance SIArrow cat => SIArrow (ReaderCT env cat) where+    siarr = clift . siarr+    sibind ai = ReaderCT $ \env -> sibind+        (iso id (flip runReaderCT env) . cloneSemiIso ai . iso (flip runReaderCT env) id)

@@ -0,0 +1,113 @@+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE ConstraintKinds #-}+{- |+Module      :  Control.Category.Structures+Description :  Structures in a category.+Copyright   :  (c) Paweł Nowak+License     :  MIT++Maintainer  :  Paweł Nowak <pawel834@gmail.com>+Stability   :  experimental++This module defines some basic structures in a category in a more fine-grained+way then "Control.Arrow".++Unfortunately names in this module clash with "Control.Arrow".+-}+module Control.Category.Structures where++import           Control.Arrow (Kleisli(..))+import qualified Control.Arrow as BadArrow+import           Control.Category+import           Control.Monad+import           Data.Semigroupoid.Dual+import           Prelude hiding (id, (.))++infixl 3 ***+infixl 2 ++++infixl 3 /+/++-- | A category with finite products.+class Category cat => Products cat where+    -- | Send the first component of the input through the argument arrow, and copy the rest unchanged to the output.+    --+    -- @first a@ is equal to @a *** id@.+    first :: cat a b -> cat (a, c) (b, c)+    first a = a *** id++    -- | A mirror image of 'first'.+    --+    -- @second a@ is equal to @id *** a@.+    second :: cat a b -> cat (c, a) (c, b)+    second a = id *** a++    -- | A product of two arrows.+    -- Split the input between the two argument arrows and combine their output.+    (***) :: cat a b -> cat c d -> cat (a, c) (b, d)+    a *** b = first a >>> second b++    {-# MINIMAL (***) | first, second #-}++instance Monad m => Products (Kleisli m) where+    (***) = (BadArrow.***)++instance Products cat => Products (Dual cat) where+    Dual f *** Dual g = Dual $ second g >>> first f++instance Products (->) where+    (***) = (BadArrow.***)++-- | A category with finite coproducts.+class Category cat => Coproducts cat where+    -- | Feed marked inputs through the argument arrow, passing the rest through unchanged to the output.+    --+    -- @left a@ is equal to @a +++ id@.+    left :: cat a b -> cat (Either a c) (Either b c)+    left a = a +++ id++    -- | A mirror image of left.+    --+    -- @right a@ is equal to @id +++ a@.+    right :: cat a b -> cat (Either c a) (Either c b)+    right a = id +++ a++    -- | A coproduct of two arrows.+    -- Split the input between the two argument arrows, retagging and merging their outputs.+    (+++) :: cat a b -> cat c d -> cat (Either a c) (Either b d)+    a +++ b = left a >>> right b++    {-# MINIMAL (+++) | left, right #-}++instance Monad m => Coproducts (Kleisli m) where+    (+++) = (BadArrow.+++)++instance Coproducts cat => Coproducts (Dual cat) where+    Dual f +++ Dual g = Dual $ right g >>> left f++instance Coproducts (->) where+    (+++) = (BadArrow.+++)++-- | A category @cat@ is a CatPlus when @cat a b@ is a monoid for all a, b.+class Category cat => CatPlus cat where+    -- | The identity of '/+/'.+    cempty :: cat a b+    -- | An associative operation on arrows.+    (/+/) :: cat a b -> cat a b -> cat a b++    {-# MINIMAL cempty, (/+/) #-}++instance MonadPlus m => CatPlus (Kleisli m) where+    cempty = BadArrow.zeroArrow+    (/+/)  = (BadArrow.<+>)++instance CatPlus cat => CatPlus (Dual cat) where+    cempty = Dual cempty+    Dual f /+/ Dual g = Dual $ f /+/ g++-- | A category transformer.+class CatTrans t where+    -- | Lift an arrow from the base category.+    clift :: Category cat => cat a b -> t cat a b++    {-# MINIMAL clift #-}

@@ -97,9 +97,9 @@     bifoldl1_     ) where -import Prelude hiding (id, (.))-import Control.Arrow+import Control.Arrow (Kleisli(..)) import Control.Category+import Control.Category.Structures import Control.Lens.Internal.SemiIso import Control.Lens.Iso import Data.Foldable@@ -107,6 +107,7 @@ import Data.Profunctor.Exposed import Data.Traversable import Data.Tuple.Morph+import Prelude hiding (id, (.))  -- | A semi-isomorphism is a partial isomorphism with weakened laws. -- @@ -140,11 +141,7 @@     id = ReifiedSemiIso' id     ReifiedSemiIso' f . ReifiedSemiIso' g = ReifiedSemiIso' (g . f) --- | This in an __/incomplete/__ instance, 'arr' and '(&&&)' are undefined.-instance Arrow ReifiedSemiIso' where-    arr = undefined-    (&&&) = undefined-+instance Products ReifiedSemiIso' where     -- TODO: pattern synonyms dont work here for some reason     first (ReifiedSemiIso' ai) = withSemiIso ai $ \f g ->         ReifiedSemiIso' $ cloneSemiIso $@@ -160,6 +157,30 @@         withSemiIso ai $ \f g -> withSemiIso ai' $ \f' g' ->             semiIso (runKleisli $ Kleisli f *** Kleisli f')                     (runKleisli $ Kleisli g *** Kleisli g')++instance Coproducts ReifiedSemiIso' where+    left (ReifiedSemiIso' ai) = withSemiIso ai $ \f g ->+        ReifiedSemiIso' $ cloneSemiIso $+            semiIso (runKleisli $ left $ Kleisli f)+                    (runKleisli $ left $ Kleisli g)++    right (ReifiedSemiIso' ai) = withSemiIso ai $ \f g ->+        ReifiedSemiIso' $ cloneSemiIso $+            semiIso (runKleisli $ right $ Kleisli f)+                    (runKleisli $ right $ Kleisli g)++    ReifiedSemiIso' ai +++ ReifiedSemiIso' ai' = ReifiedSemiIso' $+        withSemiIso ai $ \f g -> withSemiIso ai' $ \f' g' ->+            semiIso (runKleisli $ Kleisli f +++ Kleisli f')+                    (runKleisli $ Kleisli g +++ Kleisli g')++instance CatPlus ReifiedSemiIso' where+    cempty = ReifiedSemiIso' $ alwaysFailing "cempty"++    ReifiedSemiIso' ai /+/ ReifiedSemiIso' ai' = ReifiedSemiIso' $+        withSemiIso ai $ \f g -> withSemiIso ai' $ \f' g' ->+            semiIso (runKleisli $ Kleisli f /+/ Kleisli f')+                    (runKleisli $ Kleisli g /+/ Kleisli g')  -- | Constructs a semi isomorphism from a pair of functions that can -- fail with an error message.

@@ -0,0 +1,206 @@+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ScopedTypeVariables #-}+{- |+Module      :  Control.SIArrow+Description :  Categories of reversible computations.+Copyright   :  (c) Paweł Nowak+License     :  MIT++Maintainer  :  Paweł Nowak <pawel834@gmail.com>+Stability   :  experimental++Categories of reversible computations.+-}+module Control.SIArrow (+    -- * Arrow.+    SIArrow(..),+    (^>>), (>>^), (^<<), (<<^),+    (#>>), (>>#), (#<<), (<<#),++    -- * Functor and applicative.+    (/$/), (/$~),+    (/*/), (/*), (*/),++    -- * Signaling errors.+    sifail, (/?/),++    -- * Combinators.+    sisequence,+    sisequence_,+    sireplicate,+    sireplicate_+    ) where++import Control.Arrow (Kleisli(..))+import Control.Category+import Control.Category.Structures+import Control.Lens.Cons+import Control.Lens.Empty+import Control.Lens.Iso+import Control.Lens.SemiIso+import Control.Monad+import Data.Semigroupoid.Dual+import Data.Tuple.Morph+import Prelude hiding (id, (.))++infixr 1 ^>>, ^<<, #>>, #<<+infixr 1 >>^, <<^, >>#, <<#+infixl 4 /$/, /$~+infixl 5 /*/, */, /*+infixl 3 /?/++-- | A category equipped with an embedding 'siarr' from @SemiIso@ into @cat@ and some+-- additional structure.+--+-- SIArrow abstracts categories of reversible computations+-- (with reversible side effects).+--+-- The category @cat@ should contain @SemiIso@ as a sort of+-- \"subcategory of pure computations\".+class (Products cat, Coproducts cat, CatPlus cat) => SIArrow cat where+    -- | Allows you to lift a SemiIso into @cat@. The resulting arrow should be+    -- in some sense minimal or \"pure\", similiar to 'pure', 'return' and+    -- 'arr' from "Control.Category".+    siarr :: ASemiIso' a b -> cat a b+    siarr = sipure . rev++    -- | Reversed version of 'siarr'.+    --+    -- Use this where you would use 'pure'.+    sipure :: ASemiIso' b a -> cat a b+    sipure = siarr . rev++    -- | Allows a computation to depend on a its input value.+    --+    -- I am not sure if this is the right way to get that ArrowApply or Monad+    -- like power. It seems quite easy to break the parser/pretty-printer inverse+    -- guarantee using this. On the other hand we have to be careful only when+    -- constructing the SemiIso using 'iso'/'semiIso' - and with an invalid SemiIso+    -- we could break everything anyway using 'siarr'.+    sibind :: ASemiIso a (cat a b) (cat a b) b -> cat a b++    -- | @sisome v@ repeats @v@ as long as possible, but no less then once.+    sisome :: cat () b -> cat () [b]+    sisome v = _Cons /$/ v /*/ simany v++    -- | @simany v@ repeats @v@ as long as possible.+    simany :: cat () b -> cat () [b]+    simany v = sisome v /+/ sipure _Empty++    {-# MINIMAL (siarr | sipure), sibind #-}++instance MonadPlus m => SIArrow (Kleisli m) where+    siarr ai = Kleisli $ either fail return . apply ai+    sibind ai = Kleisli $ \a -> either fail (($ a) . runKleisli) $ apply ai a++instance SIArrow cat => SIArrow (Dual cat) where+    siarr = Dual . sipure+    sibind ai = Dual $ sibind (iso id getDual . rev ai . iso getDual id)++instance SIArrow ReifiedSemiIso' where+    siarr = reifySemiIso+    sibind ai = ReifiedSemiIso' $+        semiIso (\a -> apply ai a >>= flip apply a . runSemiIso)+                (\b -> unapply ai b >>= flip unapply b . runSemiIso)++-- | Composes a SemiIso with an arrow.+(^>>) :: SIArrow cat => ASemiIso' a b -> cat b c -> cat a c+f ^>> a = a . siarr f++-- | Composes an arrow with a SemiIso.+(>>^) :: SIArrow cat => cat a b -> ASemiIso' b c -> cat a c+a >>^ f = siarr f . a++-- | Composes a SemiIso with an arrow, backwards.+(^<<) :: SIArrow cat => ASemiIso' b c -> cat a b -> cat a c+f ^<< a = siarr f . a++-- | Composes an arrow with a SemiIso, backwards.+(<<^) :: SIArrow cat => cat b c -> ASemiIso' a b -> cat a c+a <<^ f = a . siarr f++-- | Composes a reversed SemiIso with an arrow.+(#>>) :: SIArrow cat => ASemiIso' b a -> cat b c -> cat a c+f #>> a = a . sipure f++-- | Composes an arrow with a reversed SemiIso.+(>>#) :: SIArrow cat => cat a b -> ASemiIso' c b -> cat a c+a >># f = sipure f . a++-- | Composes a reversed SemiIso with an arrow, backwards.+(#<<) :: SIArrow cat => ASemiIso' c b -> cat a b -> cat a c+f #<< a = sipure f . a++-- | Composes an arrow with a reversed SemiIso, backwards.+(<<#) :: SIArrow cat => cat b c -> ASemiIso' b a -> cat a c+a <<# f = a . sipure f++-- | Postcomposes an arrow with a reversed SemiIso.+-- The analogue of '<$>' and synonym for '#<<'.+(/$/) :: SIArrow cat => ASemiIso' b' b -> cat a b -> cat a b'+(/$/) = (#<<)++-- | Convenient fmap.+--+-- > ai /$~ f = ai . morphed /$/ f+--+-- This operator handles all the hairy stuff with uncurried application:+-- it reassociates the argument tuple and removes unnecessary (or adds necessary)+-- units to match the function type. You don't have to use @/*@ and @*/@ with this+-- operator.+(/$~) :: (SIArrow cat, HFoldable b', HFoldable b,+           HUnfoldable b', HUnfoldable b, Rep b' ~ Rep b)+       => ASemiIso' a b' -> cat c b -> cat c a+ai /$~ h = cloneSemiIso ai . morphed /$/ h++-- | The product of two arrows with duplicate units removed. Side effect are+-- sequenced from left to right.+--+-- The uncurried analogue of '<*>'.+(/*/) :: SIArrow cat => cat () b -> cat () c -> cat () (b, c)+a /*/ b = unit ^>> (a *** b)++-- | The product of two arrows, where the second one has no input and no output+-- (but can have side effects), with duplicate units removed. Side effect are+-- sequenced from left to right.+--+-- The uncurried analogue of '<*'.+(/*)  :: SIArrow cat => cat () a -> cat () () -> cat () a+f /* g = unit /$/ f /*/ g++-- | The product of two arrows, where the first one has no input and no output+-- (but can have side effects), with duplicate units removed. Side effect are+-- sequenced from left to right.+--+-- The uncurried analogue of '*>'.+(*/)  :: SIArrow cat => cat () () -> cat () a -> cat () a+f */ g = unit . swapped /$/ f /*/ g++-- | An arrow that fails with an error message.+sifail :: SIArrow cat => String -> cat a b+sifail = siarr . alwaysFailing++-- | Provides an error message in the case of failure.+(/?/) :: SIArrow cat => cat a b -> String -> cat a b+f /?/ msg = f /+/ sifail msg++-- | Equivalent of 'sequence'.+sisequence :: SIArrow cat => [cat () a] -> cat () [a]+sisequence [] = sipure _Empty+sisequence (x:xs) = _Cons /$/ x /*/ sisequence xs++-- | Equivalent of 'sequence_', restricted to units.+sisequence_ :: SIArrow cat => [cat () ()] -> cat () ()+sisequence_ [] = sipure _Empty+sisequence_ (x:xs) = unit /$/ x /*/ sisequence_ xs++-- | Equivalent of 'replicateM'.+sireplicate :: SIArrow cat => Int -> cat () a -> cat () [a]+sireplicate n f = sisequence (replicate n f)++-- | Equivalent of 'replicateM_', restricted to units.+sireplicate_ :: SIArrow cat => Int -> cat () () -> cat () ()+sireplicate_ n f = sisequence_ (replicate n f)

@@ -1,204 +0,0 @@-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE PatternSynonyms #-}-{- |-Module      :  Data.SemiIsoFunctor-Description :  Functors from the category of semi-isomoprihsms to Hask.-Copyright   :  (c) Paweł Nowak-License     :  MIT--Maintainer  :  Paweł Nowak <pawel834@gmail.com>-Stability   :  experimental--Defines a functor from the category of semi-isomoprihsms to Hask.--It can be instantiated by both covariant (like Parser) and contravariant -(like Printer) functors. Therefore it can be used as a common interface to unify-parsing and pretty printing.--}-module Data.SemiIsoFunctor where--import Control.Lens.Cons-import Control.Lens.Empty-import Control.Lens.SemiIso-import Data.Tuple.Morph--infixl 3 /|/, /?/-infixl 4 /$/, ~$/, /$~, ~$~-infixl 5 /*/, /*, */-infixl 1 //=-infixr 1 =//---- | A functor from the category of semi-isomorphisms to Hask. We can think of it as--- if it was both covariant and contravariant in its single argument.------ The contravariant map is used by default to provide compatibility with --- Prisms (otherwise you would have to reverse them in most cases).------ This is really a pair of functors @F : SemiIso -> Hask@,--- @G : SemiIso^op -> Hask@ satisfying:------ > F(X) = G(X)--- > F(f) = G(f^-1)------ Instances should satisfy laws:--- --- [/functoriality/]------ prop> simap id = id--- prop> simap (f . g) = simap g . simap f------ [/inverse/]------ prop> simap f = simapCo (rev f)-class SemiIsoFunctor f where-    -- | The contravariant map.-    simap :: ASemiIso' a b -> f b -> f a-    simap = simapCo . rev--    -- | The covariant map.-    simapCo :: ASemiIso' a b -> f a -> f b-    simapCo = simap . rev--    {-# MINIMAL simap | simapCo #-}---- | A infix operator for 'simap'.-(/$/) :: SemiIsoFunctor f => ASemiIso' a b -> f b -> f a-(/$/) = simap---- | > ai /$~ f = ai . morphed /$/ f------ This operator handles all the hairy stuff with uncurried application:--- it reassociates the argument tuple and removes unnecessary (or adds necessary)--- units to match the function type. You don't have to use @/*@ and @*/@ with this--- operator.-(/$~) :: (SemiIsoFunctor f, HFoldable b', HFoldable b,-          HUnfoldable b', HUnfoldable b, Rep b' ~ Rep b)-      => ASemiIso' a b' -> f b -> f a-ai /$~ h = cloneSemiIso ai . morphed /$/ h---- | > ai ~$/ f = morphed . ai /$/ f-(~$/) :: (SemiIsoFunctor f, HFoldable a', HFoldable a,-          HUnfoldable a', HUnfoldable a, Rep a' ~ Rep a)-      => ASemiIso' a' b -> f b -> f a-ai ~$/ h = morphed . cloneSemiIso ai /$/ h---- | > ai ~$~ f = morphed . ai . morphed /$/ f-(~$~) :: (SemiIsoFunctor f,-          HFoldable a, HUnfoldable a,-          HFoldable b, HUnfoldable b,-          HFoldable b', HUnfoldable b',-          Rep b' ~ Rep b, Rep b' ~ Rep a)-      => ASemiIso b' b' b' b' -> f b -> f a-ai ~$~ h = morphed . cloneSemiIso ai . morphed /$/ h---- | An applicative semi-iso functor, i. e. a lax monoidal functor from @SemiIso@--- to @Hask@.------ Instances should satisfy laws:--- --- [/homomorphism/]------ prop> sipure f /*/ sipure g = sipure (f `prod` g)------ [/associativity/]------ prop> f /*/ (g /*/ h) = associated /$/ (f /*/ g) /*/ h------ [/unitality/]------ prop> siunit /*/ x = swapped . rev unit /$/ x--- prop> x /*/ siunit = rev unit /$/ x------ Additionally it should be consistent with the default implementation:------ prop> sipure ai = ai /$/ siunit--- prop> sipureCo ai = ai `simapCo` siunit------ prop> f /* g = unit /$/ f /*/ g--- prop> f */ g = unit . swapped /$/ f /*/ g-class SemiIsoFunctor f => SemiIsoApply f where-    siunit :: f ()-    siunit = sipure id--    sipure :: ASemiIso' a () -> f a-    sipure ai = ai /$/ siunit--    sipureCo :: ASemiIso' () a -> f a-    sipureCo ai = ai `simapCo` siunit--    (/*/) :: f a -> f b -> f (a, b)--    (/*)  :: f a -> f () -> f a-    f /* g = unit /$/ f /*/ g--    (*/)  :: f () -> f b -> f b-    f */ g = unit . swapped /$/ f /*/ g--    {-# MINIMAL (siunit | sipure), (/*/) #-}---- | Fails with a message.-sifail :: SemiIsoApply f => String -> f a-sifail msg = alwaysFailing msg /$/ siunit---- | Equivalent of 'Alternative' for 'SemiIsoFunctor'.------ @f a@ should form a monoid with identity 'siempty' and binary--- operation '/|/'.-class SemiIsoApply f => SemiIsoAlternative f where-    siempty :: f a-    (/|/) :: f a -> f a -> f a--    sisome :: f a -> f [a]-    sisome v = _Cons /$/ v /*/ simany v--    simany :: f a -> f [a]-    simany v = sisome v /|/ sipure _Empty--    {-# MINIMAL siempty, (/|/) #-}---- | Provides an error message in the case of failure.-(/?/) :: SemiIsoAlternative f => f a -> String -> f a-f /?/ msg = f /|/ sifail msg---- | An analogue of 'Monad' for 'SemiIsoFunctor'.------ Because of the 'no throwing away' rule bind has to \"return\"--- both @a@ and @b@.-class SemiIsoApply m => SemiIsoMonad m where-    (//=) :: m a -> (a -> m b) -> m (a, b)-    m //= f = swapped /$/ (f =// m)--    (=//) :: (b -> m a) -> m b -> m (a, b)-    f =// m = swapped /$/ (m //= f)--    {-# MINIMAL (//=) | (=//) #-}---- | A SemiIsoMonad with fixed point operator.-class SemiIsoMonad m => SemiIsoFix m where-    sifix :: (a -> m a) -> m a-    sifix f = dup /$/ (f =//= f)-      where dup = semiIso (\a -> Right (a, a)) (Right . fst)--    -- | Fixed point combined with bind, it's so symmetric!-    (=//=) :: (a -> m b) -> (b -> m a) -> m (a, b)-    f =//= g = sifix (\(a, b) -> g b /*/ f a)--    {-# MINIMAL sifix | (=//=) #-}---- | Equivalent of 'sequence'.-sisequence :: SemiIsoApply f => [f a] -> f [a]-sisequence [] = sipure _Empty-sisequence (x:xs) = _Cons /$/ x /*/ sisequence xs---- | Equivalent of 'sequence_', restricted to units.-sisequence_ :: SemiIsoApply f => [f ()] -> f ()-sisequence_ [] = sipure _Empty-sisequence_ (x:xs) = unit /$/ x /*/ sisequence_ xs---- | Equivalent of 'replicateM'.-sireplicate :: SemiIsoApply f => Int -> f a -> f [a]-sireplicate n f = sisequence (replicate n f)---- | Equivalent of 'replicateM_', restricted to units.-sireplicate_ :: SemiIsoApply f => Int -> f () -> f ()-sireplicate_ n f = sisequence_ (replicate n f)

@@ -1,37 +0,0 @@-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{- |-Module      :  Data.SemiIsoFunctor.Wrapped-Description :  SemiIso instances for wrapped monads.-Copyright   :  (c) Paweł Nowak-License     :  MIT--Maintainer  :  Paweł Nowak <pawel834@gmail.com>-Stability   :  experimental--Every monad (with fail) is a SemiIsoMonad.--}-module Data.SemiIsoFunctor.Wrapped where--import Control.Applicative-import Control.Lens.SemiIso-import Control.Monad-import Data.SemiIsoFunctor---- | A wrapped covariant functor.-newtype WrappedCovariant m a = WrappedCovariant { runCovariant :: m a }-    deriving (Functor, Applicative, Alternative, Monad)--instance Monad m => SemiIsoFunctor (WrappedCovariant m) where-    simapCo ai m = m >>= either fail return . apply ai--instance Monad m => SemiIsoApply (WrappedCovariant m) where-    sipure ai = either fail return (unapply ai ())-    f /*/ g = liftM2 (,) f g--instance (Monad m, Alternative m) => SemiIsoAlternative (WrappedCovariant m) where-    siempty = empty-    f /|/ g = f <|> g--instance Monad m => SemiIsoMonad (WrappedCovariant m) where-    f //= g = f >>= (\x -> g x >>= \y -> return (x, y))

@@ -1,11 +1,51 @@ name:                semi-iso-version:             0.5.0.0-synopsis:            Weakened partial isomorphisms that work with lenses.-description:         Semi-isomorphisms are partial isomorphisms with weakened iso laws.-                     And they work with Iso and Prism from @lens@!-                     .-                     See first "Control.Lens.SemiIso" for semi-isomoprhisms.-                     After that look at "Data.SemiIsoFunctor".+version:             1.0.0.0+synopsis:            Weakened partial isomorphisms, reversible computations.+description:         +  Semi-isomorphisms are partial isomorphisms with weakened iso laws. They are a basic+  building block of reversible computations. And they work with Iso and Prism from @lens@!+  .+  The module "Control.Lens.SemiIso" defines semi-isomorphisms and provides some+  basic semi-isos and combinators. A @SemiIso' a b@ can be applied in both directions+  to get a @a -> Either String b@ and @b -> Either String a@. SemiIsos can be composed+  with Isos and Prisms (to get another SemiIso). Isos and Prisms can be directly+  used as SemiIsos.+  .+  Semi-isomorphisms obey weaker laws then isomorphisms. We require only+  .+  > apply f >=> unapply f >=> apply f = apply f+  > unapply f >=> apply f >=> unapply f = unapply f+  .+  instead of+  .+  > apply f >=> unapply f = f+  > unapply f >=> apply f = f+  .+  Modules "Control.SIArrow" and "Control.Category.Structures" define an @Arrow@-like class+  hierarchy. Unfortunately "Control.Arrow" cannot be used, as it is too restrictive (the+  dreaded @arr@).++  SIArrow abstracts categories of reversible computations (with reversible side effects). In+  the case of parsing and pretty-printing using the "syntax" library if we have an arrow+  @SIArrow cat => cat a b@ then we can:+  .+  * Evaluate it from left to right, turning a value of type @a@ into a value of type @b@,+  with the side effect of consuming a sequence. (Parsing)+  .+  * Evaluate it from right to left, turning a value of type @b@ into a value of type @a@,+  with the side effect of generating a sequence. (Pretty-printing)+  .+  In the particular case of parsing/pretty-printing the type @a@ will be usually @()@, e.g.+  we just produce a value during parsing and just consume a value during pretty-printing.+  To support this style we define a functor and applicative structure on @cat () b@, for example+  '/*/' (equivalent of '<*>') has type @(\/*\/) :: SIArrow cat => cat () a -> cat () b -> cat () (a, b)@.+  .+  When more power then applicative is needed - for example when the syntax depends on the+  parsed value - we turn back to arrow composition.+  .+  Module "Control.Category.Reader" defines a Reader category transformer. It is like a monad+  transformer, but for categories. The next version will include some more transformers and+  mtl-style classes. license:             MIT license-file:        LICENSE author:              Paweł Nowak@@ -22,9 +62,10 @@ library   exposed-modules:     Control.Lens.SemiIso                        Control.Lens.Internal.SemiIso-                       Data.SemiIsoFunctor-                       Data.SemiIsoFunctor.Wrapped+                       Control.SIArrow+                       Control.Category.Reader+                       Control.Category.Structures                        Data.Profunctor.Exposed-  build-depends:       base >= 4 && < 5, profunctors, transformers, lens, tuple-morph+  build-depends:       base >= 4 && < 5, profunctors, transformers, lens, tuple-morph, semigroupoids   default-language:    Haskell2010   ghc-options:         -Wall