semi-iso 0.2.0.0 → 0.3.0.0

raw patch · 4 files changed

+239/−28 lines, 4 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Control/Lens/Internal/SemiIso.hs +49/−19
• Control/Lens/SemiIso.hs +162/−8
• Data/Profunctor/Exposed.hs +26/−0
• semi-iso.cabal +2/−1

@@ -1,5 +1,7 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-} {- |-Module      :  Data.Lens.Internal.SemiIso+Module      :  Control.Lens.Internal.SemiIso Description :  Internals of a SemiIso. Copyright   :  (c) Paweł Nowak License     :  MIT@@ -11,29 +13,57 @@  import Control.Monad import Data.Profunctor+import Data.Profunctor.Exposed  -- | Type used internally to access 'SemiIso'. -- -- Continues the naming tradition of @lens@.-data Barter s t a b = Barter (a -> Either String s) (t -> Either String b)+data Retail s t a b = Retail (a -> Either String s) (t -> Either String b) -instance Profunctor (Barter s t) where-    lmap f (Barter l r) = Barter (l . f) r-    rmap f (Barter l r) = Barter l (fmap f . r)+instance Profunctor (Retail s t) where+    lmap f (Retail l r) = Retail (l . f) r+    rmap f (Retail l r) = Retail l (fmap f . r) -instance Choice (Barter s t) where-    left' (Barter as st) = Barter -        (either as (\_ -> Left "partial iso failed")) (fmap Left . st)-    right' (Barter as st) = Barter -        (either (\_ -> Left "partial iso failed") as) (fmap Right . st)+instance Choice (Retail s t) where+    left' (Retail as st) = Retail +        (either as (\_ -> Left "semi-iso failed")) (fmap Left . st)+    right' (Retail as st) = Retail +        (either (\_ -> Left "semi-iso failed") as) (fmap Right . st) --- | Provides a profunctor the ability to fail with an error message.+-- Proof of 'Exposed' laws: ----- This class could use some laws. It is certainly a bit ad-hoc.-class Profunctor p => Failure p where-    tie :: p a (Either String b) -> p a b-    attach :: p a b -> p (Either String a) b--instance Failure (Barter s t) where-    tie (Barter f g) = Barter f (join . g)-    attach (Barter f g) = Barter (>>= f) g+-- > merge . rmap return = id+--+-- merge . rmap return $ Retail l r =+-- merge $ Retail l (return . r) =+-- Retail l (join . return . r) =+-- Retail l r+--+-- > lmap return . expose = id+--+-- lmap return . expose $ Retail l r =+-- lmap return $ Retail (>>= l) r =+-- Retail ((>>= l) . return) r =+-- Retail (join . fmap l . return) r =+-- Retail (join . return . l) r =+-- Retail l r+--+-- > rmap (>>= f) = merge . rmap (fmap f)+--+-- rmap (>>= f) $ Retail l r =+-- Retail l ((>>= f) . r) =+-- Retail l (join . fmap f . r) =+-- merge $ Retail l (fmap f . r) =+-- merge . rmap (fmap f) $ Retail l r+--+-- > lmap (fmap f) . expose = expose . lmap f+--+-- lmap (fmap f) . expose $ Retail l r =+-- lmap (fmap f) $ Retail (>>= l) r =+-- Retail ((>>= l) . fmap f) r =+-- Retail (>>= (l . f)) r =+-- expose $ Retail (l . f) r =+-- expose . lmap f $ Retail l r+instance Exposed (Either String) (Retail s t) where+    expose (Retail l r) = Retail (>>= l) r+    merge (Retail l r) = Retail l (join . r)

@@ -1,7 +1,8 @@ {-# LANGUAGE Rank2Types #-} {-# LANGUAGE TupleSections #-}+{-# LANGUAGE FlexibleContexts #-} {- |-Module      :  Data.Lens.SemiIso+Module      :  Control.Lens.SemiIso Description :  Semi-isomorphisms. Copyright   :  (c) Paweł Nowak License     :  MIT@@ -42,8 +43,16 @@     -- * Constructing semi-isos.     semiIso, -    -- * Consuming semi-isos.+    -- * Transforming semi-isos.     withSemiIso,+    attempt,+    attemptAp,+    attemptUn,+    attempt_,+    attemptAp_,+    attemptUn_,++    -- * Consuming semi-isos.     fromSemi,     apply,     unapply,@@ -53,12 +62,28 @@     swapped,     associated,     constant,-    exact+    exact,++    -- * Folds.+    foldlM1,+    foldrM1,+    unfoldlM,+    unfoldlM1,+    unfoldrM,+    unfoldrM1,++    -- * Bidirectional folds.+    bifoldr,+    bifoldr1,+    bifoldl,+    bifoldl1     ) where  import Control.Lens.Internal.SemiIso import Control.Lens.Iso+import Data.Foldable import Data.Functor.Identity+import Data.Profunctor.Exposed import Data.Traversable  -- | A semi-isomorphism is a partial isomorphism with weakened laws.@@ -70,13 +95,13 @@ -- -- Every 'Prism' is a 'SemiIso'. -- Every 'Iso' is a 'Prism'.-type SemiIso s t a b = forall p f. (Failure p, Traversable f) => p a (f b) -> p s (f t)+type SemiIso s t a b = forall p f. (Exposed (Either String) p, Traversable f) => p a (f b) -> p s (f t)  -- | Non-polymorphic variant of 'SemiIso'. type SemiIso' s a = SemiIso s s a a  -- | When you see this as an argument to a function, it expects a 'SemiIso'.-type ASemiIso s t a b = Barter a b a (Identity b) -> Barter a b s (Identity t)+type ASemiIso s t a b = Retail a b a (Identity b) -> Retail a b s (Identity t)  -- | When you see this as an argument to a function, it expects a 'SemiIso''. type ASemiIso' s a = ASemiIso s s a a@@ -84,15 +109,47 @@ -- | 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 = tie . dimap sa (sequenceA . fmap bt) . attach+semiIso sa bt = merge . dimap sa (sequenceA . fmap bt) . expose  -- | Extracts the two functions that characterize the 'SemiIso'. withSemiIso :: ASemiIso s t a b              -> ((s -> Either String a) -> (b -> Either String t) -> r)              -> r-withSemiIso ai k = case ai (Barter Right (Right . Identity)) of-                        Barter sa bt -> k sa (rmap (runIdentity . sequenceA) bt)+withSemiIso ai k = case ai (Retail Right (Right . Identity)) of+                        Retail sa bt -> k sa (rmap (runIdentity . sequenceA) bt) +-- | 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@.+attempt :: ASemiIso s t a b -> SemiIso s (Either String t) (Either String a) b+attempt = attemptAp . attemptUn++-- | Transforms the semi-iso so that applying it in direction (->) never fails,+-- but instead catches any errors and returns them as an @Either String a@.+attemptAp :: ASemiIso s t a b -> SemiIso s t (Either String a) b+attemptAp ai = withSemiIso ai $ \l r -> semiIso (Right . l) r++-- | Transforms the semi-iso so that applying it in direction (<-) never fails,+-- but instead catches any errors and returns them as an @Either String a@.+attemptUn :: ASemiIso s t a b -> SemiIso s (Either String t) a b+attemptUn ai = withSemiIso ai $ \l r -> semiIso l (Right . r)++discard :: Either a b -> Maybe b+discard = either (const Nothing) Just++-- | Transforms the semi-iso like 'attempt', but ignores the error message.+attempt_ :: ASemiIso s t a b -> SemiIso s (Maybe t) (Maybe a) b+attempt_ ai = rmap (fmap discard) . attempt ai . lmap discard++-- | Transforms the semi-iso like 'attemptAp', but ignores the error message.+--+-- Very useful when you want to bifold using a prism.+attemptAp_ :: ASemiIso s t a b -> SemiIso s t (Maybe a) b+attemptAp_ ai = attemptAp ai . lmap discard++-- | Transforms the semi-iso like 'attemptUn', but ignores the error message.+attemptUn_ :: ASemiIso s t a b -> SemiIso s (Maybe t) a b+attemptUn_ ai = rmap (fmap discard) . attemptUn ai+ -- | Applies the 'SemiIso'. apply :: ASemiIso s t a b -> s -> Either String a apply ai = withSemiIso ai $ \l _ -> l@@ -134,3 +191,100 @@     f _ = Right x     g y | x == y    = Right ()         | otherwise = Left "exact: not equal"++-- | Monadic counterpart of 'foldl1' (or non-empty list counterpart of 'foldlM').+foldlM1 :: Monad m => (a -> a -> m a) -> [a] -> m a+foldlM1 f (x:xs) = foldlM f x xs+foldlM1 _ []     = fail "foldlM1: empty list"++-- | Monadic counterpart of 'foldr1' (or non-empty list counterpart of 'foldrM').+foldrM1 :: Monad m => (a -> a -> m a) -> [a] -> m a+foldrM1 _ [x]    = return x+foldrM1 f (x:xs) = foldrM1 f xs >>= f x+foldrM1 _ []     = fail "foldrM1: empty list"++-- | Monadic counterpart of 'unfoldr'.+unfoldrM :: Monad m => (a -> m (Maybe (b, a))) -> a -> m (a, [b])+unfoldrM f a = do+    r <- f a+    case r of+      Just (b, new_a) -> do+          (final_a, bs) <- unfoldrM f new_a+          return (final_a, b : bs)+      Nothing -> return (a, [])++-- | A variant of 'unfoldrM' that always produces a non-empty list.+unfoldrM1 :: Monad m => (a -> m (Maybe (a, a))) -> a -> m [a]+unfoldrM1 f a = do+    r <- f a+    case r of+      Just (b, new_a) -> do+          bs <- unfoldrM1 f new_a+          return (b : bs)+      Nothing -> return [a]++-- | Monadic counterpart of 'unfoldl'.+unfoldlM :: Monad m => (a -> m (Maybe (a, b))) -> a -> m (a, [b])+unfoldlM f a0 = go a0 []+  where+    go a bs = do+        r <- f a+        case r of+          Just (new_a, b) -> go new_a (b : bs)+          Nothing -> return (a, bs)++-- | A variant of 'unfoldlM' that always produces a non-empty list.+unfoldlM1 :: Monad m => (a -> m (Maybe (a, a))) -> a -> m [a]+unfoldlM1 f a0 = go a0 []+  where+    go a bs = do+        r <- f a+        case r of+          Just (new_a, b) -> go new_a (b : bs)+          Nothing -> return (a : bs)++-- | Constructs a bidirectional fold.+--+-- \-> Right unfolds using the (->) part of the given semi-iso.+--+-- \<- Right folds using the (<-) part of the given semi-iso.+bifoldr :: ASemiIso a a (Maybe (b, a)) (b, a) -> SemiIso' a (a, [b])+bifoldr ai = semiIso (uf ai) (f ai)+  where+    f = uncurry . foldrM . curry . unapply+    uf = unfoldrM . apply++-- | Constructs a bidirectional fold.+--+-- \-> Right unfolds using the (->) part of the given semi-iso. It should+-- produce an non-empty list.+--+-- \<- Right folds a non-empty list using the (<-) part of the given semi-iso.+bifoldr1 :: ASemiIso a a (Maybe (a, a)) (a, a) -> SemiIso' a [a]+bifoldr1 ai = semiIso (uf ai) (f ai)+  where+    f = foldrM1 . curry . unapply+    uf = unfoldrM1 . apply++-- | Constructs a bidirectional fold.+--+-- \-> Left unfolds using the (->) part of the given semi-iso.+--+-- \<- Left folds using the (<-) part of the given semi-iso.+bifoldl :: ASemiIso a a (Maybe (a, b)) (a, b) -> SemiIso' a (a, [b])+bifoldl ai = semiIso (uf ai) (f ai)+  where+    f = uncurry . foldlM . curry . unapply+    uf = unfoldlM . apply++-- | Constructs a bidirectional fold.+--+-- \-> Left unfolds using the (->) part of the given semi-iso. It should+-- produce an non-empty list.+--+-- \<- Left folds a non-empty list using the (<-) part of the given semi-iso.+bifoldl1 :: ASemiIso a a (Maybe (a, a)) (a, a) -> SemiIso' a [a]+bifoldl1 ai = semiIso (uf ai) (f ai)+  where+    f = foldlM1 . curry . unapply+    uf = unfoldlM1 . apply

@@ -0,0 +1,26 @@+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{- |+Module      :  Data.Profunctor.Exposed+Description :  Exposes Kleisli category structure beneath a profunctor.+Copyright   :  (c) Paweł Nowak+License     :  MIT++Maintainer  :  Paweł Nowak <pawel834@gmail.com>+Stability   :  experimental+-}+module Data.Profunctor.Exposed where++import Data.Profunctor++-- | Exposes structure of a Kleisli category beneath a profunctor.+-- +-- Should obey laws:+-- +-- > merge . rmap return = id+-- > lmap return . expose = id+-- > rmap (>>= f) = merge . rmap (fmap f)+-- > 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 

@@ -1,5 +1,5 @@ name:                semi-iso-version:             0.2.0.0+version:             0.3.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,5 +23,6 @@   exposed-modules:     Control.Lens.SemiIso                        Control.Lens.Internal.SemiIso                        Data.SemiIsoFunctor+                       Data.Profunctor.Exposed   build-depends:       base >= 4 && < 5, profunctors, transformers, lens   default-language:    Haskell2010