semi-iso 0.4.1.0 → 0.5.0.0

raw patch · 5 files changed

+158/−51 lines, 5 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Control/Lens/SemiIso.hs +58/−18
• Data/Profunctor/Exposed.hs +4/−4
• Data/SemiIsoFunctor.hs +57/−28
• Data/SemiIsoFunctor/Wrapped.hs +37/−0
• semi-iso.cabal +2/−1

@@ -48,7 +48,12 @@      -- * Constructing semi-isos.     semiIso,+    cloneSemiIso, +    -- * Reified semi-isos.+    ReifiedSemiIso'(..),+    reifySemiIso,+     -- * Consuming semi-isos.     apply,     unapply,@@ -92,7 +97,9 @@     bifoldl1_     ) where +import Prelude hiding (id, (.)) import Control.Arrow+import Control.Category import Control.Lens.Internal.SemiIso import Control.Lens.Iso import Data.Foldable@@ -126,11 +133,43 @@ -- 'viewSemiIso' or 'fromSemiIso'. pattern SemiIso sa bt <- (viewSemiIso -> (sa, bt)) +-- | A semi-iso stored in a container.+newtype ReifiedSemiIso' s a = ReifiedSemiIso' { runSemiIso :: SemiIso' s a }++instance Category ReifiedSemiIso' where+    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++    -- TODO: pattern synonyms dont work here for some reason+    first (ReifiedSemiIso' ai) = withSemiIso ai $ \f g ->+        ReifiedSemiIso' $ cloneSemiIso $+            semiIso (runKleisli $ first $ Kleisli f)+                    (runKleisli $ first $ Kleisli g)++    second (ReifiedSemiIso' ai) = withSemiIso ai $ \f g ->+        ReifiedSemiIso' $ cloneSemiIso $+            semiIso (runKleisli $ second $ Kleisli f)+                    (runKleisli $ second $ 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')+ -- | Constructs a semi isomorphism from a pair of functions that can -- fail with an error message. semiIso :: (s -> Either String a) -> (b -> Either String t) -> SemiIso s t a b semiIso sa bt = merge . dimap sa (sequenceA . fmap bt) . expose +-- | Clones a semi-iso.+cloneSemiIso :: ASemiIso s t a b -> SemiIso s t a b+cloneSemiIso (SemiIso sa bt) = semiIso sa bt+ -- | Applies the 'SemiIso'. apply :: ASemiIso s t a b -> s -> Either String a apply (SemiIso sa _) = sa@@ -150,6 +189,10 @@ viewSemiIso :: ASemiIso s t a b -> (s -> Either String a, b -> Either String t) viewSemiIso ai = withSemiIso ai (,) +-- | Reifies a semi-iso.+reifySemiIso :: ASemiIso' s a -> ReifiedSemiIso' s a+reifySemiIso ai = ReifiedSemiIso' $ cloneSemiIso ai+ -- | A trivial isomorphism between a and (a, ()). unit :: Iso' a (a, ()) unit = iso (, ()) fst@@ -178,15 +221,15 @@ constant :: a -> SemiIso' () a constant x = semiIso (\_ -> Right x) (\_ -> Right ()) --- | \-> Always returns the argument.+-- | \-> Filters out all values not equal to the argument. ----- \<- Filters out all values not equal to the argument.-exact :: Eq a => a -> SemiIso' () a+-- \<- Always returns the argument.+exact :: Eq a => a -> SemiIso' a () exact x = semiIso f g   where-    f _ = Right x-    g y | x == y    = Right ()+    f y | x == y    = Right ()         | otherwise = Left "exact: not equal"+    g _ = Right x  -- | Like 'filtered' but checks the predicate in both ways. bifiltered :: (a -> Bool) -> SemiIso' a a@@ -213,22 +256,19 @@ rev :: ASemiIso s t a b -> SemiIso b a t s rev ai = withSemiIso ai $ \l r -> semiIso r l --- | A product of SemiIso's.-prod :: ASemiIso s t a b -> ASemiIso s' t' a' b' -     -> SemiIso (s, s') (t, t') (a, a') (b, b')-prod (SemiIso sa bt) (SemiIso sa' bt') = semiIso-    (runKleisli (Kleisli sa *** Kleisli sa')) -    (runKleisli (Kleisli bt *** Kleisli bt'))+-- | A product of semi-isos.+prod :: ASemiIso' s a -> ASemiIso' t b -> SemiIso' (s, t) (a, b)+prod a b = runSemiIso (reifySemiIso a *** reifySemiIso b) --- | In the non-polymorphic case uses an @SemiIso a ()@ to construct a--- @SemiIso (a, b) b@, i.e. eliminates the first pair element.-elimFirst :: ASemiIso s' t' () () -> SemiIso (s', t) (t', t) t t+-- | Uses an @SemiIso' a ()@ to construct a @SemiIso' (a, b) b@,+-- i.e. eliminates the first pair element.+elimFirst :: ASemiIso' s () -> SemiIso' (s, t) t elimFirst ai = swapped . elimSecond ai --- | In the non-polymorphic case uses an @SemiIso b ()@ to construct a--- @SemiIso (a, b) a@, i.e. eliminates the second pair element.-elimSecond :: ASemiIso s' t' () () -> SemiIso (t, s') (t, t') t t-elimSecond ai = prod id ai . rev unit+-- | Uses an @SemiIso b ()@ to construct a @SemiIso (a, b) a@,+-- i.e. eliminates the second pair element.+elimSecond :: ASemiIso' s () -> SemiIso' (t, s) t+elimSecond ai = runSemiIso (id *** reifySemiIso ai) . rev unit  -- | Transforms the semi-iso so that applying it in both directions never fails, -- but instead catches any errors and returns them as an @Either String a@.

@@ -17,10 +17,10 @@ --  -- Should obey laws: -- --- > merge . rmap return = id--- > lmap return . expose = id--- > rmap (>>= f) = merge . rmap (fmap f)--- > lmap (fmap f) . expose = expose . lmap f+-- prop> merge . rmap return = id+-- prop> lmap return . expose = id+-- prop> rmap (>>= f) = merge . rmap (fmap f)+-- prop> lmap (fmap f) . expose = expose . lmap f class (Monad m, Profunctor p) => Exposed m p | p -> m where     expose :: p a b -> p (m a) b     merge  :: p a (m b) -> p a b 

@@ -11,9 +11,8 @@  Defines a functor from the category of semi-isomoprihsms to Hask. -The most interesting property of that class is that 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+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@@ -23,25 +22,34 @@ import Control.Lens.SemiIso import Data.Tuple.Morph -infixl 3 /|/+infixl 3 /|/, /?/ infixl 4 /$/, ~$/, /$~, ~$~ infixl 5 /*/, /*, */ infixl 1 //= infixr 1 =// --- | A functor from the category of semi-isomorphisms to Hask.------ It is both covariant and contravariant in its single arugment.+-- | 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: -- --- > simap id      = id--- > simap (f . g) = simap g . simap f--- > simap         = simapCo . fromSemi--- > simapCo       = simap   . fromSemi+-- [/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@@ -66,17 +74,13 @@ (/$~) :: (SemiIsoFunctor f, HFoldable b', HFoldable b,           HUnfoldable b', HUnfoldable b, Rep b' ~ Rep b)       => ASemiIso' a b' -> f b -> f a--- TODO GHC 7.10: haddock doesn't work with pattern synynonyms yet--- (SemiIso f g) /$~ h = semiIso f g . morphed /$/ h-ai /$~ h = withSemiIso ai $ \f g -> semiIso f g . morphed /$/ h+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--- TODO GHC 7.10: haddock doesn't work with pattern synynonyms yet---(SemiIso f g) ~$/ h = morphed . semiIso f g /$/ h-ai ~$/ h = withSemiIso ai $ \f g -> morphed . semiIso f g /$/ h+ai ~$/ h = morphed . cloneSemiIso ai /$/ h  -- | > ai ~$~ f = morphed . ai . morphed /$/ f (~$~) :: (SemiIsoFunctor f,@@ -85,18 +89,33 @@           HFoldable b', HUnfoldable b',           Rep b' ~ Rep b, Rep b' ~ Rep a)       => ASemiIso b' b' b' b' -> f b -> f a--- TODO GHC 7.10: haddock doesn't work with pattern synynonyms yet---(SemiIso f g) ~$~ h = morphed . semiIso f g . morphed /$/ h-ai ~$~ h = withSemiIso ai $ \f g -> morphed . semiIso f g . morphed /$/ h+ai ~$~ h = morphed . cloneSemiIso ai . morphed /$/ h --- | Equivalent of 'Applicative' for 'SemiIsoFunctor'.------ However, this class implements uncurried application, unlike --- 'Control.Applicative' which gives you curried application.+-- | An applicative semi-iso functor, i. e. a lax monoidal functor from @SemiIso@+-- to @Hask@. -- -- Instances should satisfy laws: -- --- > TODO (they should be fine)+-- [/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@@ -137,6 +156,10 @@      {-# 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\"@@ -163,13 +186,19 @@     {-# MINIMAL sifix | (=//=) #-}  -- | Equivalent of 'sequence'.------ Note that it is not possible to write sequence_, because--- you cannot void a SemiIsoFunctor. 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)

@@ -0,0 +1,37 @@+{-# 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,5 +1,5 @@ name:                semi-iso-version:             0.4.1.0+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@!@@ -23,6 +23,7 @@   exposed-modules:     Control.Lens.SemiIso                        Control.Lens.Internal.SemiIso                        Data.SemiIsoFunctor+                       Data.SemiIsoFunctor.Wrapped                        Data.Profunctor.Exposed   build-depends:       base >= 4 && < 5, profunctors, transformers, lens, tuple-morph   default-language:    Haskell2010