Validation (empty) → 0.0.1
raw patch · 4 files changed
+268/−0 lines, 4 filesdep +HUnitdep +QuickCheckdep +Semigroupsetup-changed
Dependencies added: HUnit, QuickCheck, Semigroup, base, category-extras, test-framework, test-framework-hunit, test-framework-quickcheck2
Files
- Data/Validation.hs +206/−0
- LICENSE +27/−0
- Setup.hs +3/−0
- Validation.cabal +32/−0
+ Data/Validation.hs view
@@ -0,0 +1,206 @@+{-# LANGUAGE DeriveDataTypeable #-}++-- | Data types similar to @Data.Either@ that are explicit about failure and success.+module Data.Validation+(+ AccValidation+, Validation+, ValidationT+, Validate(..)+, FoldValidate(..)+, runValidationT+, fromFailure+, fromSuccess+, getFailure+, getSuccess+, getFailureOr+, getSuccessOr+) where++import Control.Functor.Pointed+import Control.Applicative+import Data.Semigroup+import Data.Maybe+import Data.Typeable+import Data.Data++-- | A value of the type @err@ or @a@, however, the @Applicative@ instance+-- accumulates values. This is witnessed by the @Semigroup@ context on the instance.+-- /Note that there is no @Monad@ such that @ap = (<*>)./+--+-- * @success (+1) <*> success 7 == AccSuccess 8@+--+-- * @failure ["f1"] <*> success 7 == AccFailure ["f1"]@+--+-- * @success (+1) <*> failure ["f2"] == AccFailure ["f2"]@+--+-- * @failure ["f1"] <*> failure ["f2"] == AccFailure ["f1","f2"]@+data AccValidation err a =+ AccFailure err+ | AccSuccess a+ deriving (Eq, Ord, Show, Data, Typeable)++instance Functor (AccValidation err) where+ fmap _ (AccFailure e) = AccFailure e+ fmap f (AccSuccess a) = AccSuccess (f a)++instance Pointed (AccValidation err) where+ point = AccSuccess++instance Semigroup err => Applicative (AccValidation err) where+ pure = point+ AccFailure e1 <*> AccFailure e2 = AccFailure (e1 .++. e2)+ AccFailure e1 <*> AccSuccess _ = AccFailure e1+ AccSuccess _ <*> AccFailure e2 = AccFailure e2+ AccSuccess f <*> AccSuccess a = AccSuccess (f a)++-- | A value of the type @err@ or @a@ and isomorphic to @Data.Either@.+data Validation err a =+ Failure err+ | Success a+ deriving (Eq, Ord, Show, Data, Typeable)++instance Functor (Validation err) where+ fmap _ (Failure e) = Failure e+ fmap f (Success a) = Success (f a)++instance Pointed (Validation err) where+ point = Success++instance Applicative (Validation err) where+ pure = point+ Failure e1 <*> Failure _ = Failure e1+ Failure e1 <*> Success _ = Failure e1+ Success _ <*> Failure e2 = Failure e2+ Success f <*> Success a = Success (f a)++instance Monad (Validation err) where+ return = point+ Failure e >>= _ = Failure e+ Success a >>= f = f a++-- | The transformer version of @Validation@.+data ValidationT m err a =+ ValidationT {+ runValidationT :: m (Validation err a)+ }++instance Functor m => Functor (ValidationT m err) where+ fmap f (ValidationT k) =+ ValidationT (fmap (fmap f) k)++instance Pointed m => Pointed (ValidationT m err) where+ point = ValidationT . point . point++instance Applicative m => Applicative (ValidationT m err) where+ pure = ValidationT . pure . point+ ValidationT f <*> ValidationT a = ValidationT (liftA2 (<*>) f a)++instance Monad m => Monad (ValidationT m err) where+ return = ValidationT . return . point+ ValidationT v >>= f = ValidationT (v >>= \w -> case w+ of Failure e -> return (Failure e)+ Success a -> runValidationT (f a))++-- | Construction for validation values.+class Validate v where+ -- | Construct a success validation value.+ success ::+ a+ -> v err a+ -- | Construct a failure validation value.+ failure ::+ err+ -> v err a++-- | Reduction for validation values.+class FoldValidate v where+ -- | Reduce a validation value /(catamorphism)/.+ foldValidate ::+ (err -> x) -- ^ The function to run if a failure value.+ -> (a -> x) -- ^ The function to run if a success value.+ -> v err a -- ^ The validation value.+ -> x++instance Validate AccValidation where+ success =+ point+ failure =+ AccFailure++instance FoldValidate AccValidation where+ foldValidate f _ (AccFailure err) =+ f err+ foldValidate _ g (AccSuccess a) =+ g a++instance Validate Validation where+ success =+ point+ failure =+ Failure++instance FoldValidate Validation where+ foldValidate f _ (Failure err) =+ f err+ foldValidate _ g (Success a) =+ g a++instance Pointed m => Validate (ValidationT m) where+ success =+ ValidationT . point . success+ failure =+ ValidationT . point . failure++-- | Returns the failure value or runs the given function on the success value to get a failure value.+fromFailure ::+ FoldValidate v =>+ (a -> err) -- ^ The function to run on the success value.+ -> v err a+ -> err+fromFailure =+ foldValidate id++-- | Returns the success value or runs the given function on the failure value to get a success value.+fromSuccess ::+ FoldValidate v =>+ (err -> a) -- ^ The function to run on the failure value.+ -> v err a+ -> a+fromSuccess =+ flip foldValidate id++-- | Returns the possible failure value if there is one.+getFailure ::+ FoldValidate v =>+ v err a+ -> Maybe err+getFailure =+ foldValidate Just (const Nothing)++-- | Returns the possible success value if there is one.+getSuccess ::+ FoldValidate v =>+ v err a+ -> Maybe a+getSuccess =+ foldValidate (const Nothing) Just++-- | Returns the failure value if there is one, otherwise returns the given default.+getFailureOr ::+ FoldValidate v =>+ err -- ^ The default to return if there is no failure value to return.+ -> v err a+ -> err+getFailureOr e =+ fromMaybe e . getFailure++-- | Returns the success value if there is one, otherwise returns the given default.+getSuccessOr ::+ FoldValidate v =>+ a -- ^ The default to return if there is no success value to return.+ -> v err a+ -> a+getSuccessOr a =+ fromMaybe a . getSuccess+
+ LICENSE view
@@ -0,0 +1,27 @@+Copyright 2010 Tony Morris++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:+1. Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.+2. 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.+3. Neither the name of the author nor the names of his contributors+ may be used to endorse or promote products derived from this software+ without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE REGENTS 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 AUTHORS 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,3 @@+import Distribution.Simple+main = defaultMain+
+ Validation.cabal view
@@ -0,0 +1,32 @@+Name: Validation+Version: 0.0.1+License: BSD3+License-File: LICENSE+Author: Tony Morris <ʇǝu˙sıɹɹoɯʇ@ןןǝʞsɐɥ>, Nick Partridge+Maintainer: Tony Morris, Nick Partridge+Synopsis: A data-type like Either but with an accumulating Applicative+Category: Data+Description: A data-type like Either but with an accumulating Applicative+Cabal-version: >= 1.2+Build-Type: Simple++Flag small_base+ Description: Choose the new, split-up base package.++Library+ Build-Depends:+ base < 5 && >= 4+ , Semigroup+ , category-extras+ , HUnit+ , QuickCheck+ , test-framework+ , test-framework-hunit+ , test-framework-quickcheck2++ GHC-Options:+ -Wall++ Exposed-Modules:+ Data.Validation+