applicative-fail (empty) → 0.0.1
raw patch · 4 files changed
+195/−0 lines, 4 filesdep +basesetup-changed
Dependencies added: base
Files
- LICENSE +30/−0
- Setup.hs +2/−0
- applicative-fail.cabal +35/−0
- src/Control/Applicative/Fail.hs +128/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2015, Aleksey Uimanov++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Aleksey Uimanov nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ applicative-fail.cabal view
@@ -0,0 +1,35 @@+name: applicative-fail+version: 0.0.1+synopsis: Applicative functor which collects all your fails++description: Applicative functor to perform parse-like actions and+ collect wanrings/failures while++license: BSD3+license-file: LICENSE+author: Aleksey Uimanov+maintainer: s9gf4ult@gmail.com++category: Control+build-type: Simple++cabal-version: >=1.10++homepage: https://bitbucket.org/s9gf4ult/applicative-fail+source-repository head+ type: git+ location: git@bitbucket.org:s9gf4ult/applicative-fail.git++library+ default-language: Haskell2010+ hs-source-dirs: src++ default-extensions: DeriveDataTypeable+ , DeriveFoldable+ , DeriveFunctor+ , DeriveGeneric+ , DeriveTraversable++ build-depends: base >=4.6 && <4.8++ exposed-modules: Control.Applicative.Fail
+ src/Control/Applicative/Fail.hs view
@@ -0,0 +1,128 @@+module Control.Applicative.Fail+ ( Fail(..)+ , ffail+ , fwarn+ , fsucc+ , getFail+ , getSucc+ -- * Combinators+ , failEither+ , mapFail+ , joinFail+ , bindFail+ , composeFail+ ) where++import Control.Applicative+import Data.Foldable+import Data.Monoid+import Data.Traversable+import Data.Typeable+import GHC.Generics+++{-| 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++Example usage:++>>> (,,) <$> 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))++or like that:++>>> (,) <$> 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++This type is usefull for form parsing and returning your own type of+errors++-}++data Fail e a+ = Fail e (Maybe a) -- ^ (Just a) when checking may proceed in Applicative+ | Success a+ deriving ( Eq, Ord, Show, Read, Functor+ , Foldable, Traversable+ , Typeable, Generic )++instance (Monoid e) => Applicative (Fail e) where+ pure a = Success a+ (Success f) <*> a = fmap f a+ (Fail e1 f) <*> (Fail e2 a) = Fail (e1 <> e2) (f <*> a)+ (Fail e f) <*> (Success a) = Fail e (fmap ($ a) f)++instance (Monoid e, Monoid a) => Monoid (Fail e a) where+ mempty = Success mempty+ mappend (Success a) (Success b) = Success $ a <> b+ mappend (Fail e1 a) (Fail e2 b) = Fail (e1 <> e2) (mappend <$> a <*> b)+ mappend res@(Fail{}) (Success{}) = res -- fail always win+ mappend (Success{}) res@(Fail{}) = res++ffail :: e -> Fail [e] a+ffail e = Fail (pure e) Nothing++fwarn :: e -> a -> Fail [e] a+fwarn e a = Fail [e] (Just a)++fsucc :: a -> Fail e a+fsucc a = Success a++failEither :: Fail e a -> Either e a+failEither (Success a) = Right a+failEither (Fail e _) = Left e++getFail :: Fail e a -> Maybe e+getFail (Fail e _) = Just e+getFail _ = Nothing++getSucc :: Fail e a -> Maybe a+getSucc (Success a) = Just a+getSucc _ = Nothing++mapFail :: (e -> e') -> Fail e a -> Fail e' a+mapFail _ (Success a) = Success a+mapFail f (Fail e a) = Fail (f e) a++-- | Join two fails like monad does+joinFail :: (Monoid e)+ => Fail e (Fail e a)+ -> Fail e a+joinFail (Success a) = a+joinFail (Fail e a) =+ let ee = maybe e (e <>)+ (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`