applicative-fail 0.0.3 → 1.0.0

raw patch · 6 files changed

+508/−92 lines, 6 filesdep +QuickCheckdep +applicative-faildep +checkersdep ~basePVP ok

version bump matches the API change (PVP)

Dependencies added: QuickCheck, applicative-fail, checkers, dlist, mtl, tasty, tasty-quickcheck, transformers, transformers-base

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• CHANGELOG.md +27/−0
• README.md +39/−32
• applicative-fail.cabal +44/−5
• src/Control/Applicative/Fail.hs +90/−55
• src/Control/Monad/Fail.hs +221/−0
• test/Test.hs +87/−0

@@ -0,0 +1,27 @@+# CHANGELOG++## 1.0.0++### Added++* Module `Control.Monad.Fail` containing monadic version of+  `Control.Applicative.Fail`+* Tests added: all properties (Monad, Applicative, Monoid laws) are+  prooved with QuickCheck and package `checkers`+* `runFail` and `runDLFail`: functions to unwrap `Fail`+* dependencies added: `dlist`, `mtl`, `transformers`++### Removed++* `fsucc`: use `return` / `pure` instead+* `bindFail` and `composeFail`: use monadic fail instead++### Changed++* `ffail` and `fwarn` renamed to `afail` and `awarn`+* `afail` and `awarn` are more generic now+* documentation strictly improoved++## 0.0.3++First usable version

@@ -3,12 +3,12 @@ Assume you have some type  ```haskell-data Animal =-    Animal+data Animal = Animal     { species :: String     , weight  :: Double-    , age     :: NominalDiffTime-    }+    , age     :: Int+    } deriving (Show)+ ```  And you would like to produce this value from some data (e.g. query@@ -19,44 +19,51 @@ Like that:  ```haskell-spc = "Parastratiosphecomyia stratiosphecomyioides"-w = 100-a = 27234--animal = Animal-         <$> (if length spc > 20-              then fwarn "Name is too long" spc-              else if spc == ""-                   then ffail "Name can not be empty"-                   else fsucc spc)-         <*> (if w < 0-              then ffail "Weight can not be negative"-              else fsucc w)-         <*> (if a < 0-              then ffail "Age can not be negative"-              else fsucc a)+let spc = "Parastratiosphecomyia stratiosphecomyioides"+    w = 100+    a = 27234+    animal :: Fail [String] Animal+    animal = Animal+             <$> (if length spc > 20+                  then awarn "Name is too long" spc+                  else if spc == ""+                       then afail "Name can not be empty"+                       else pure spc)+             <*> (if w < 0+                  then afail "Weight can not be negative"+                  else pure w)+             <*> (if a < 0+                  then afail "Age can not be negative"+                  else pure a) ```  Now you can inspect the value we have got  ```haskell-λ> animal+>>> animal Fail ["Name is too long"] (Just (Animal {species = "Parastratiosphecomyia stratiosphecomyioides", weight = 100.0, age = 27234}))-λ> getSucc animal++>>> getSucc animal Just (Animal {species = "Parastratiosphecomyia stratiosphecomyioides", weight = 100.0, age = 27234})-λ> getFail animal++>>> getFail animal Just ["Name is too long"] ``` -Here is another simple examples:+Now this example can be rewritten with monadic syntax inside field+checkers using module `Control.Monad.Fail`:  ```haskell-λ> (,) <$> ffail "oups" <*> ffail "duh"-Fail ["oups","duh"] Nothing-λ> (,) <$> fwarn "oups" "hello" <*> fwarn "duh" "world"-Fail ["oups","duh"] (Just ("hello","world"))-λ> (,) <$> fsucc "hello" <*> fwarn "duh" "world"-Fail ["duh"] (Just ("hello","world"))-λ> (,) <$> fsucc "hello" <*> fsucc "world"-Success ("hello","world")+let animal :: Fail [String] Animal+    animal = Animal+             <$> (runFailI $ do+                          when (length spc > 20) $ mwarn "Name is too long"+                          when (spc == "") $ mfail "Name can not be empty"+                          return spc)+             <*> (runFailI $ do+                          when (w < 0) $ mfail "Weight can not be negative"+                          return w)+             <*> (runFailI $ do+                          when (a < 0) $ mfail "Age can not be negative"+                          return a) ```

@@ -1,9 +1,9 @@ name:                applicative-fail-version:             0.0.3-synopsis:            Applicative functor which collects all your fails+version:             1.0.0+synopsis:            Applicative functor and monad which collects all your fails  description: Applicative functor to perform parse-like actions and-             collect wanrings/failures+             collect wanrings/failures.  license:             BSD3 license-file:        LICENSE@@ -15,7 +15,8 @@  cabal-version:       >=1.10 -extra-source-files:  README.md+extra-source-files:  CHANGELOG.md+                   , README.md  homepage: https://bitbucket.org/s9gf4ult/applicative-fail source-repository head@@ -26,15 +27,53 @@   default-language:    Haskell2010   hs-source-dirs:      src -  default-extensions:  DeriveDataTypeable+  default-extensions:  CPP+                     , DeriveDataTypeable                      , DeriveFoldable                      , DeriveFunctor                      , DeriveGeneric                      , DeriveTraversable+                     , FlexibleContexts+                     , FlexibleInstances+                     , GeneralizedNewtypeDeriving+                     , LambdaCase+                     , MultiParamTypeClasses+                     , ScopedTypeVariables+                     , StandaloneDeriving+                     , TupleSections+                     , TypeSynonymInstances+                     , UndecidableInstances+                     , ViewPatterns    build-depends:       base >=4.6 && <4.8                      , bifunctors+                     , dlist+                     , mtl+                     , transformers+                     , transformers-base    exposed-modules:     Control.Applicative.Fail+                     , Control.Monad.Fail++  ghc-options: -Wall++test-suite test+  default-language: Haskell2010+  type:            exitcode-stdio-1.0+  hs-source-dirs:  test++  default-extensions: FlexibleInstances+                    , ScopedTypeVariables+                    , TemplateHaskell++  main-is:         Test.hs++  build-depends:   base >= 3 && < 5+                 , QuickCheck+                 , applicative-fail+                 , checkers+                 , mtl+                 , tasty+                 , tasty-quickcheck    ghc-options: -Wall

@@ -1,56 +1,93 @@ module Control.Applicative.Fail-       ( Fail(..)-       , ffail-       , fwarn-       , fsucc+       ( -- * Intro+         -- $intro++         -- * Fail+         Fail(..)+       , runFail+       , runDLFail+       , afail+       , awarn+       , fNull        , getFail        , getSucc          -- * Combinators        , failEither        , joinFail-       , bindFail-       , composeFail        ) where  import Control.Applicative import Data.Bifunctor+import Data.DList ( DList ) import Data.Foldable import Data.Monoid import Data.Traversable import Data.Typeable import GHC.Generics +import qualified Data.DList as DL -{-| Applicative functor which collects all the fails instead of-immediate returning first fail like `Either`. It can not be a monad-because of differenct logic in Applicative.  Applicative instance of-Fail continue to fold fails even when 'Fail e Nothing' pattern is-met. Monad instance can not behave like that, so 'Fail' have no Monad-instance+{- $intro -Example usage:+Assume you have some type ->>> (,,) <$> Fail [10] (Just 10) <*> Success 10 <*> Success 20-Fail [10] (Just (10,10,20))->>> (,) <$> Fail [1] Nothing <*> Success 10-Fail [1] Nothing->>> (,) <$> Fail [1] (Just 10) <*> Fail [2] (Just 20)-Fail [1,2] (Just (10,20))+>>> :{+data Animal = Animal+    { species :: String+    , weight  :: Double+    , age     :: Int+    } deriving (Show)+:} -or like that:+And you would like to produce this value from some data (e.g. query+parameters). There can be some warnigns or value can not be produced+at all. It would be great to have some simple tool to notify about+warnings and/or fail computation. ->>> (,) <$> ffail "oups" <*> fsucc 10-Fail ["oups"] Nothing->>> (,,) <$> fwarn "oups" 10 <*> fwarn "meh" 20 <*> fsucc 30-Fail ["oups","meh"] (Just (10,20,30))->>> (,,) <$> ffail "oups" <*> ffail "meh" <*> fsucc 30-Fail ["oups","meh"] Nothing+Like that: -This type is usefull for form parsing and returning your own type of-errors+>>> let spc = "Parastratiosphecomyia stratiosphecomyioides"+>>> let w = 100+>>> let a = 27234+>>> :{+let animal :: Fail [String] Animal+    animal = Animal+             <$> (if length spc > 20+                  then awarn "Name is too long" spc+                  else if spc == ""+                       then afail "Name can not be empty"+                       else pure spc)+             <*> (if w < 0+                  then afail "Weight can not be negative"+                  else pure w)+             <*> (if a < 0+                  then afail "Age can not be negative"+                  else pure a)+:} +>>> animal+Fail ["Name is too long"] (Just (Animal {species = "Parastratiosphecomyia stratiosphecomyioides", weight = 100.0, age = 27234}))++>>> getSucc animal+Just (Animal {species = "Parastratiosphecomyia stratiosphecomyioides", weight = 100.0, age = 27234})++>>> getFail animal+Just ["Name is too long"]++Now you can build your own parser-like things+ -} ++{- | Applicative functor which collects all the fails instead of+immediate returning first fail like `Either`. It can not be a monad+because of differenct logic in Applicative.  Applicative instance of+Fail continue to fold fails even when 'Fail e Nothing' pattern is+met. Monad instance can not behave like that, so 'Fail' have no Monad+instance++-}+ data Fail e a     = Fail e (Maybe a) -- ^ (Just a) when checking may proceed in Applicative     | Success a@@ -75,29 +112,47 @@     mappend res@(Fail{}) (Success{}) = res -- fail always win     mappend (Success{}) res@(Fail{}) = res -ffail :: e -> Fail [e] a-ffail e = Fail (pure e) Nothing+-- | Unwraps 'Fail' to tuple of error and value. If pattern is+-- 'Success' then return 'mempty' in error part.+runFail :: (Monoid e) => Fail e a -> (e, Maybe a)+runFail (Success a) = (mempty, Just a)+runFail (Fail e a)  = (e, a) -fwarn :: e -> a -> Fail [e] a-fwarn e a = Fail [e] (Just a)+-- | Unwraps 'Fail' and constrain error container to 'DList' for type+-- inference+runDLFail :: Fail (DList e) a -> ([e], Maybe a)+runDLFail = first DL.toList . runFail -fsucc :: a -> Fail e a-fsucc a = Success a+-- | Return True if pattern does not contain not success value nor+-- fails, i.e. (Fail mempty Nothing)+fNull :: (Eq e, Monoid e) => Fail e a -> Bool+fNull (Fail ((== mempty) -> True) Nothing) = True+fNull _                                    = False +afail :: Applicative f => e -> Fail (f e) a+afail e = Fail (pure e) Nothing++awarn :: Applicative f => e -> a -> Fail (f e) a+awarn e a = Fail (pure e) (Just a)++-- | Return 'Right' if there is value (including pattern '(Fail e+-- (Just a))'). If there is no value return 'Left' failEither :: Fail e a -> Either e a failEither (Success a)       = Right a failEither (Fail _ (Just a)) = Right a failEither (Fail e Nothing)  = Left e +-- | Return fail part if exists getFail :: Fail e a -> Maybe e getFail (Fail e _) = Just e getFail _ = Nothing +-- | Return success part if exists getSucc :: Fail e a -> Maybe a getSucc (Success a) = Just a getSucc (Fail _ a) = a --- | Join two fails like monad does+-- | Join two fails like monad does. This function still match to 'Applicative' joinFail :: (Monoid e)          => Fail e (Fail e a)          -> Fail e a@@ -107,23 +162,3 @@              (a >>= getFail)         aa = a >>= getSucc     in Fail ee aa----- | This is a monadic-like bind. It breaks computation like--- Maybe and does not correspond to Applicative instance--- behaviour. So, instead of implementing Monad instance we--- just implement separate 'bind' operator-bindFail :: (Monoid e)-         => Fail e a-         -> (a -> Fail e b)-         -> Fail e b-bindFail a f = joinFail $ fmap f a-infixl 1 `bindFail`--composeFail :: (Monoid e)-            => (a -> Fail e b)-            -> (b -> Fail e c)-            -> a-            -> Fail e c-composeFail l r a = bindFail (l a) r-infixl 1 `composeFail`

@@ -0,0 +1,221 @@+module Control.Monad.Fail+       ( -- * Intro+         -- $intro++         -- * Failing monad+         FailT(..)+       , runFailC+       , runFailI+        -- * Helper functions+       , mfail+       , mwarn+       ) where++import Control.Applicative+import Control.Applicative.Fail+import Control.Monad+import Control.Monad.Base+import Control.Monad.Reader+import Control.Monad.State+import Control.Monad.Writer+import Data.Foldable+import Data.Functor.Compose+import Data.Functor.Identity+import Data.Monoid+import Data.Traversable+import Data.Tuple+import Data.Typeable+import GHC.Generics++#if MIN_VERSION_mtl(2,2,1)+import Control.Monad.Except+#else+import Control.Monad.Error+#endif++{- $intro++Failing monad transformer, which behaves in general like+'EitherT' but it also supports warnings. In short, it behaves like+combination of 'EitherT' and 'WriterT' transformers and built on+'Fail' applicative functor.++>>> runFailT $ do {a <- return 10; b <- return 20; return (a, b)}+Success (10,20)++>>> runFailT $ (,) <$> pure 10 <*> pure 20+Success (10,20)++>>> fmap runDLFail $ runFailT $ do {a <- mfail 10 ; b <- mfail 20; return (a, b)}+([10],Nothing)++>>> fmap runDLFail $ runFailT $ (,) <$> mfail 10 <*> mfail 20+([10],Nothing)++Note, that Applicative instance behaves just like Monad: it fails+immediately. 'FailT' also supports warning like 'Fail' does:++>>> fmap runDLFail $ runFailT $ do {a <- mwarn 10 *> return 15; b <- return 20; return (a, b)}+([10],Just (15,20))++>>> fmap runDLFail $ runFailT $ (,) <$> (mwarn 10 *> return 15) <*> return 20+([10],Just (15,20))++You can also combine 'FailT' with 'Fail' using 'Compose' like that:++>>> let check10 = do {liftBase $ print "checking 10"; return 10}+>>> let check20 = do {liftBase $ print "checking 20"; mwarn "oups"; return 20}+>>> fmap runDLFail $ getCompose $ (,) <$> runFailC check10 <*> runFailC check20+"checking 10"+"checking 20"+(["oups"],Just (10,20))++Note how 'Compose' functor is used here.++>>> let fail10 = do {liftBase $ print "failing 10"; mfail "10 is failed"}+>>> fmap runDLFail $ getCompose $ (,) <$> runFailC fail10 <*> runFailC check20+"failing 10"+"checking 20"+(["10 is failed","oups"],Nothing)++Note how second checker was runned even after first checker failed+(got "oups" message). This is because internal (monadic) checkers+unrolled back to __IO (Fail e a)__ and wrapped to 'Compose' so infered+type of __runFailC fail10__ is __Compose IO (Fail (DList String)) a__++Example from "Control.Applicative.Fail" can be also rewritten more convenient:++>>> :{+data Animal = Animal+    { species :: String+    , weight  :: Double+    , age     :: Int+    } deriving (Show)+:}++>>> let spc = "Parastratiosphecomyia stratiosphecomyioides"+>>> let w = 100+>>> let a = 27234+>>> :{+let animal :: Fail [String] Animal+    animal = Animal+             <$> (runFailI $ do+                          when (length spc > 20) $ mwarn "Name is too long"+                          when (spc == "") $ mfail "Name can not be empty"+                          return spc)+             <*> (runFailI $ do+                          when (w < 0) $ mfail "Weight can not be negative"+                          return w)+             <*> (runFailI $ do+                          when (a < 0) $ mfail "Age can not be negative"+                          return a)+:}++>>> animal+Fail ["Name is too long"] (Just (Animal {species = "Parastratiosphecomyia stratiosphecomyioides", weight = 100.0, age = 27234}))++Monadic interface is much more comfortable here+-}+++newtype FailT e m a = FailT+    { runFailT :: m (Fail e a)+    } deriving ( Functor, Foldable, Traversable+               , Typeable, Generic )++-- | Unwraps 'FailT' and wraps result into 'Compose' functor. Usable+-- for convenient composition of 'Fail' where 'FailT' works inside.+runFailC :: FailT e m a -> Compose m (Fail e) a+runFailC = Compose . runFailT+{-# INLINEABLE runFailC #-}++runFailI :: FailT e Identity a -> Fail e a+runFailI = runIdentity . runFailT+{-# INLINEABLE runFailI #-}++deriving instance Eq (m (Fail e a)) => Eq (FailT e m a)+deriving instance Ord (m (Fail e a)) => Ord (FailT e m a)+deriving instance Show (m (Fail e a)) => Show (FailT e m a)++instance (Applicative m, Monoid a, Monoid e) => Monoid (FailT e m a) where+    mempty = FailT $ pure $ mempty+    {-# INLINEABLE mempty #-}+    mappend (FailT a) (FailT b) = FailT $ mappend <$> a <*> b+    {-# INLINEABLE mappend #-}++-- | NOTE: This instance behaves not like 'Applicative' for+-- 'Fail'. This applicative does not try to collect all posible fails,+-- it returns fast like 'EitherT' to match the 'Monad' isntance+-- behaviour.+instance (Monoid e, Functor m, Monad m) => Applicative (FailT e m) where+    pure a = return a+    {-# INLINEABLE pure #-}+    mf <*> ma = mf >>= \f -> fmap f ma+    {-# INLINEABLE (<*>) #-}++instance (Monoid e, Monad m) => Monad (FailT e m) where+    return a = FailT $ return $ pure a+    {-# INLINEABLE return #-}++    x >>= f = FailT $ runFailT x >>= \case+        Success a -> runFailT $ f a+        Fail e (Just a) -> runFailT (f a) >>= \case+            Success b -> return $ Fail e (Just b)+            Fail e' mb -> return $ Fail (e <> e') mb+        Fail e Nothing -> return $ Fail e Nothing+    {-# INLINEABLE (>>=) #-}++instance MonadTrans (FailT e) where+    lift ma = FailT $ liftM Success ma+    {-# INLINEABLE lift #-}++instance (Monoid e, MonadBase b m) => MonadBase b (FailT e m) where+    liftBase = lift . liftBase+    {-# INLINEABLE liftBase #-}++instance (MonadReader r m, Monoid e) => MonadReader r (FailT e m) where+    ask = lift ask+    {-# INLINEABLE ask #-}+    local f action = FailT $ do+        local f (runFailT action)+    {-# INLINEABLE local #-}+    reader = lift . reader+    {-# INLINEABLE reader #-}++instance (MonadState s m, Monoid e) => MonadState s (FailT e m) where+    get = lift get+    {-# INLINEABLE get #-}+    put = lift . put+    {-# INLINEABLE put #-}+    state = lift . state+    {-# INLINEABLE state #-}++instance (MonadWriter w m, Monoid e) => MonadWriter w (FailT e m) where+    writer = lift . writer+    {-# INLINEABLE writer #-}+    tell = lift . tell+    {-# INLINEABLE tell #-}+    listen action = FailT $ do+        (f, w) <- listen (runFailT action)+        return $ fmap (,w) f+    {-# INLINEABLE listen #-}+    pass action = FailT $ do+        a <- runFailT action+        let x = sequenceA $ fmap swap a+        pass $ return $ swap x+    {-# INLINEABLE pass #-}++instance (Monad m, Monoid e) => MonadError e (FailT e m) where+    throwError e = FailT $ return $ Fail e Nothing+    catchError ma handler = FailT $ runFailT ma >>= \case+        res@(Success _) -> return res+        (Fail e _)      -> runFailT $ handler e+++mfail :: (Applicative f, Applicative m) => e -> FailT (f e) m a+mfail e = FailT $ pure $ afail e+{-# INLINEABLE mfail #-}++mwarn :: (Applicative f, Applicative m) => e -> FailT (f e) m ()+mwarn e = FailT $ pure $ awarn e ()+{-# INLINEABLE mwarn #-}

@@ -0,0 +1,87 @@+{-# OPTIONS -fno-warn-orphans #-}+module Main where++import Control.Applicative+import Control.Applicative.Fail+import Control.Monad.Fail+import Control.Monad.Identity+import Test.QuickCheck hiding ( Success )+import Test.QuickCheck.Checkers+import Test.QuickCheck.Classes+import Test.Tasty+import Test.Tasty.QuickCheck hiding ( Success )++tastyUnbatch :: String -> TestBatch -> TestTree+tastyUnbatch name b =+    let u = unbatch b+    in testGroup name $ map (uncurry testProperty) u++instance (Arbitrary e, Arbitrary a) => Arbitrary (Fail e a) where+    arbitrary = oneof+        [ Success <$> arbitrary+        , Fail <$> arbitrary <*> arbitrary ]++instance (Eq e, Eq a) => EqProp (Fail e a) where+    a =-= b = eq a b++instance Arbitrary a => Arbitrary (Identity a) where+    arbitrary = Identity <$> arbitrary++instance (Arbitrary e, Arbitrary a) => Arbitrary (FailT e Identity a) where+    arbitrary = FailT <$> arbitrary++instance (Eq e, Eq a) => EqProp (FailT e Identity a) where+    a =-= b = eq a b++prop_FunctorFail :: TestTree+prop_FunctorFail = tastyUnbatch "Functor"+    $ functor (undefined :: Fail [Int] (Int, Int, Int))++prop_ApplicativeFail :: TestTree+prop_ApplicativeFail  = tastyUnbatch "Applicative"+    $ applicative (undefined :: Fail [Int] (Int, Int, Int))++prop_MonoidFail :: TestTree+prop_MonoidFail = tastyUnbatch "Monoid"+    $ monoid (undefined :: Fail [Int] [Int])++prop_FunctorFailT :: TestTree+prop_FunctorFailT = tastyUnbatch "Function"+    $ functor (undefined :: FailT Int Identity (Int, Int, Int))++prop_ApplicativeFailT :: TestTree+prop_ApplicativeFailT  = tastyUnbatch "Applicative"+    $ applicative (undefined :: FailT [Int] Identity (Int, Int, Int))++prop_MonoidFailT :: TestTree+prop_MonoidFailT = tastyUnbatch "Monoid"+    $ monoid (undefined :: FailT [Int] Identity [Int])++prop_MonadFailT :: TestTree+prop_MonadFailT = tastyUnbatch "Monad"+    $ monad (undefined ::  FailT [Int] Identity (Int, Int, Int))++prop_MonadApplicativeFailT :: TestTree+prop_MonadApplicativeFailT = tastyUnbatch "Monad <-> Applicative"+    $ monadApplicative (undefined :: FailT [Int] Identity (Int, Int))++prop_MonadFunctorFailT :: TestTree+prop_MonadFunctorFailT = tastyUnbatch "Monad <-> Functor"+    $ monadFunctor (undefined :: FailT [Int] Identity (Int, Int))++main :: IO ()+main = defaultMain $ testGroup "properties"+    [ testGroup "Fail"+      [ prop_FunctorFail+      , prop_ApplicativeFail+      , prop_MonoidFail+      ]+    , testGroup "MFail"+      [ prop_FunctorFailT+      , prop_ApplicativeFailT+      , prop_MonoidFailT+      , prop_MonadFailT+      , prop_MonadFunctorFailT+      , prop_MonadApplicativeFailT+      ]+    ]