validation-micro (empty) → 0.1.0.0

raw patch · 6 files changed

+1031/−0 lines, 6 filesdep +basedep +deepseqsetup-changed

Dependencies added: base, deepseq

Files

• CHANGELOG.md +13/−0
• LICENSE +28/−0
• README.md +38/−0
• Setup.hs +2/−0
• src/Validation/Micro.hs +884/−0
• validation-micro.cabal +66/−0

@@ -0,0 +1,13 @@+# Changelog for `validation-micro`++All notable changes to this project will be documented in this file.++The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/),+and this project adheres to the+[Haskell Package Versioning Policy](https://pvp.haskell.org/).++## Unreleased++## 0.1.0.0++First version

@@ -0,0 +1,28 @@+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 Author name here 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.

@@ -0,0 +1,38 @@+# validation-micro++[![GitHub CI](https://github.com/unfoldml/validation-micro/workflows/CI/badge.svg)](https://github.com/unfoldml/validation-micro/actions)++Lightweight pure data validation based on `Applicative` .++`validation-micro` is built around the following data type:++```haskell+data Validation e a+    = Failure e+    | Success a+```++This data type is similar to `Either` but allows accumulating all+errors instead of short-circuiting on the first one.++## Comparison with other packages++`validation-micro` is not the only package that provides the `Validation` data type. +Here are some differences and commonalities to other validation packages:+++ **Lightweight**. `validation-micro` depends only on `base` and+  `deepseq`, which make it fast to build. +  So adding validation capabilities to your+  library or application doesn't contribute much to your dependency+  footprint.++ **Future-proof**. Both `base` and `deepseq` are GHC boot packages, which means that `validation-micro` can be imported as long as GHC can run.++ **No Selective instance**. This means you cannot choose which validation to use based on the value. On the other hand, we don't need to depend on `selective` which is a somewhat experimental package.++ **No Monad instance** - but there is a `bindValidation` utility function which behaves like `(>>=)`.++## Copyright++Copyright:  (c) 2014 Chris Allen, Edward Kmett+            (c) 2018-2023 Kowainik+            (c) 2023 Marco Zocca, UnfoldML+License: BSD3+Maintainer:  oss@unfoldml.com

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,884 @@+{-# LANGUAGE DeriveAnyClass       #-}+{-# LANGUAGE DeriveDataTypeable   #-}+{-# language DerivingStrategies #-}+{-# language DeriveGeneric #-}+{-# language LambdaCase #-}++{- |+Copyright:  (c) 2014 Chris Allen+            (c) 2014 Edward Kmett+            (c) 2018-2023 Kowainik+            (c) 2023 Marco Zocca, UnfoldML+SPDX-License-Identifier: BSD-3-Clause+Maintainer:  oss@unfoldml.com+Stability:   Stable+Portability: Portable++Lightweight pure data validation based on 'Applicative' functors.++'Validation' allows to accumulate all errors instead of+short-circuting on the first error so you can display all possible+errors at once.++Common use-cases include:++1. Validating each input of a form with multiple inputs.+2. Performing multiple validations of a single value.++'Validation' provides __modular__ and __composable__ interface which+means that you can implement validations for different pieces of your+data independently, and then combine smaller parts into the validation+of a bigger type. The below table illustrates main ways to combine two+'Validation's:+++---------------+-------------+---------------------------+---------------------------+---------------------------+---------------------------++|   Typeclass   | Operation ○ | 'Failure' e ○ 'Failure' d | 'Success' a ○ 'Success' b | 'Failure' e ○ 'Success' a | 'Success' a ○ 'Failure' e |++===============+=============+===========================+===========================+===========================+===========================++| 'Semigroup'   | '<>'        | 'Failure' (e '<>' d)      | 'Success' (a '<>' b)      | 'Failure' e               | 'Failure' e               |++---------------+-------------+---------------------------+---------------------------+---------------------------+---------------------------++| 'Applicative' | '<*>'       | 'Failure' (e '<>' d)      | 'Success' (a b)           | 'Failure' e               | 'Failure' e               |++---------------+-------------+---------------------------+---------------------------+---------------------------+---------------------------++| 'Alternative' | '<|>'       | 'Failure' (e '<>' d)      | 'Success' a               | 'Success' a               | 'Success' a               |++---------------+-------------+---------------------------+---------------------------+---------------------------+---------------------------++++In other words, instances of different standard typeclasses provide+various semantics which can be useful in different use-cases:++1. 'Semigroup': accumulate both 'Failure' and 'Success' with '<>'.+2. 'Monoid': 'Success' that stores 'mempty'.+3. 'Functor': change the type inside 'Success'.+4. 'Bifunctor': change both 'Failure' and 'Success'.+5. 'Applicative': apply function to values inside 'Success' and accumulate+   errors inside 'Failure'.+6. 'Alternative': return the first 'Success' or accumulate all errors+   inside 'Failure'.+-}++module Validation.Micro (+  -- * Type+         Validation (..)++         -- * How to use+         -- $use++         -- * Interface functions+       , isFailure+       , isSuccess+       , validation+       , failures+       , successes+       , partitionValidations+       , fromFailure+       , fromSuccess+       , bindValidation++         -- ** 'NonEmpty' combinators+         -- $nonEmptyCombinators+       , failure+       , failureIf+       , failureUnless++         -- ** 'Either' conversion+         -- $either+       , validationToEither+       , eitherToValidation++         -- * Combinators+       , validateAll++      -- * When* functions+    , whenSuccess+    , whenFailure+    , whenSuccess_+    , whenFailure_+    , whenSuccessM+    , whenFailureM+    , whenSuccessM_+    , whenFailureM_++      -- * 'Maybe' conversion+    , failureToMaybe+    , successToMaybe+    , maybeToFailure+    , maybeToSuccess+  ) where++import Control.Applicative (Alternative (..), Applicative (..))+import Data.Bifoldable (Bifoldable (..))+import Data.Bifunctor (Bifunctor (..))+import Data.Bitraversable (Bitraversable (..))+import Data.Data (Data)+import Control.DeepSeq (NFData, NFData1, NFData2(..))+import Data.Foldable (Foldable (..))+import Data.List.NonEmpty (NonEmpty (..))++import GHC.Generics (Generic(..), Generic1(..))++{- | 'Validation' is a sum type for storing either all+validation failures or validation success. Unlike 'Either', which+returns only the first error, 'Validation' accumulates all errors+using the 'Semigroup' typeclass.++Usually type variables in @'Validation' e a@ are used as follows:++* @e@: is a list or set of failure messages or values of some error data type.+* @a@: is some domain type denoting successful validation result.++Some typical use-cases:++* @'Validation' ['String'] User@++    * Either list of 'String' error messages or a validated value of a+      custom @User@ type.++* @'Validation' ('NonEmpty' UserValidationError) User@++    * Similar to previous example, but list of failures guaranteed to+      be non-empty in case of validation failure, and it stores values+      of some custom error type.+-}+data Validation e a+    = Failure e+    -- ^ Validation failure. The @e@ type is supposed to implement the 'Semigroup' instance.+    | Success a+    -- ^ Successful validation result of type @a@.+    deriving stock (Eq, Ord, Show, Generic, Generic1, Data)+    deriving anyclass (NFData, NFData1)++{- | Allows changing the value inside 'Success' with a given function.++__Examples__++>>> fmap (+1) (Success 9)+Success 10+>>> fmap (+1) (Failure ["wrong"])+Failure ["wrong"]+-}+instance Functor (Validation e) where+    -- fmap :: (a -> b) -> Validation e a -> Validation e b+    fmap _ (Failure e) = Failure e+    fmap f (Success a) = Success (f a)+    {-# INLINE fmap #-}++    -- (<$) :: a -> Validation e b -> Validation e a+    x <$ Success _ = Success x+    _ <$ Failure e = Failure e+    {-# INLINE (<$) #-}+++{- | 'Semigroup' allows merging multiple 'Validation's into single one+by combining values inside both 'Failure' and 'Success'. The '<>'+operator merges two 'Validation's following the below rules:++1. If both values are 'Failure's, returns a new 'Failure' with+accumulated errors.+2. If both values are 'Success'ful, returns a new 'Success' with+combined success using 'Semigroup' for values inside 'Success'.+3. If one value is 'Failure' and another one is 'Success', then+'Failure' is returned.++__Examples__++>>> success1 = Success [9] :: Validation [String] [Int]+>>> success2 = Success [15] :: Validation [String] [Int]+>>> failure1 = Failure ["WRONG"] :: Validation [String] [Int]+>>> failure2 = Failure ["FAIL"]  :: Validation [String] [Int]++>>> success1 <> success2+Success [9,15]+>>> failure1 <> failure2+Failure ["WRONG","FAIL"]+>>> success1 <> failure1+Failure ["WRONG"]+>>> failure2 <> success1 <> success2 <> failure1+Failure ["FAIL","WRONG"]+-}+instance (Semigroup e, Semigroup a) => Semigroup (Validation e a) where+    -- (<>) :: Validation e a -> Validation e a -> Validation e a+    (<>) = liftA2 (<>)+    {-# INLINE (<>) #-}++{- | @'mempty' :: 'Validation' e a@ is @Success@ which stores+@'mempty' :: a@ to be consistent with the 'Semigroup' instance.++__Examples__++>>> mempty :: Validation String [Bool]+Success []+-}+instance (Semigroup e, Monoid a) => Monoid (Validation e a) where+    mempty = Success mempty+    {-# INLINE mempty #-}++    mappend = (<>)+    {-# INLINE mappend #-}++++{- | This instance is the most important instance for the 'Validation' data+type. It's responsible for the many implementations. And it allows to accumulate+errors while performing validation or combining the results in the applicative+style.++__Examples__++>>> success1 = Success 9 :: Validation [String] Int+>>> success2 = Success 15 :: Validation [String] Int+>>> successF = Success (* 2) :: Validation [String] (Int -> Int)+>>> failure1 = Failure ["WRONG"] :: Validation [String] Int+>>> failure2 = Failure ["FAIL"]  :: Validation [String] Int++>>> successF <*> success1+Success 18+>>> successF <*> failure1+Failure ["WRONG"]+>>> (+) <$> success1 <*> success2+Success 24+>>> (+) <$> failure1 <*> failure2+Failure ["WRONG","FAIL"]+>>> liftA2 (+) success1 failure1+Failure ["WRONG"]+>>> liftA3 (,,) failure1 success1 failure2+Failure ["WRONG","FAIL"]++Implementations of all functions are lazy and they correctly work if some+arguments are not fully evaluated.++>>> failure1 *> failure2+Failure ["WRONG","FAIL"]+>>> isFailure $ failure1 *> failure2+True+>>> epicFail = error "Impossible validation" :: Validation [String] Int+>>> isFailure $ failure1 *> epicFail+True+-}+instance Semigroup e => Applicative (Validation e) where+    -- pure :: a -> Validation e a+    pure = Success+    {-# INLINE pure #-}++    Failure e1 <*> b = Failure $ case b of+        Failure e2 -> e1 <> e2+        Success _  -> e1+    Success _ <*> Failure e = Failure e+    Success f <*> Success a = Success (f a)+    {-# INLINE (<*>) #-}++    Failure e1 *> b = Failure $ case b of+        Failure e2 -> e1 <> e2+        Success _  -> e1+    Success _ *> Failure e = Failure e+    Success _ *> Success b = Success b+    {-# INLINE (*>) #-}++    Failure e1 <* b = Failure $ case b of+        Failure e2 -> e1 <> e2+        Success _  -> e1+    Success _ <* Failure e = Failure e+    Success a <* Success _ = Success a+    {-# INLINE (<*) #-}++    liftA2 _ (Failure e1) b = Failure $ case b of+        Failure e2 -> e1 <> e2+        Success _  -> e1+    liftA2 _ (Success _) (Failure e) = Failure e+    liftA2 f (Success a) (Success b) = Success (f a b)+    {-# INLINE liftA2 #-}++-- | NB Validation is not a monad though+bindValidation :: Validation e a -> (a -> Validation e b) -> Validation e b+bindValidation v f = case v of+  Failure e -> Failure e+  Success a -> f a+++{- | This instance implements the behaviour when the first 'Success'+is returned. Otherwise all 'Failure's are combined.++__Examples__++>>> success1 = Success [9] :: Validation [String] [Int]+>>> success2 = Success [15] :: Validation [String] [Int]+>>> failure1 = Failure ["WRONG"] :: Validation [String] [Int]+>>> failure2 = Failure ["FAIL"]  :: Validation [String] [Int]++>>> success1 <|> success2+Success [9]+>>> failure1 <|> failure2+Failure ["WRONG","FAIL"]+>>> failure2 <|> success2+Success [15]+-}+instance (Monoid e) => Alternative (Validation e) where+    -- empty :: Validation e a+    empty = Failure mempty+    {-# INLINE empty #-}++    -- (<|>) :: Validation e a -> Validation e a -> Validation e a+    s@Success{} <|> _        = s+    _ <|> s@Success{}        = s+    Failure e <|> Failure e' = Failure (e <> e')+    {-# INLINE (<|>) #-}++++{- | 'Foldable' for 'Validation' allows folding values inside 'Success'.++__Examples__++>>> fold (Success [16])+[16]+>>> fold (Failure "WRONG!" :: Validation String [Int])+[]+-}+instance Foldable (Validation e) where+    fold = \case+        Failure _ -> mempty+        Success a -> a+    {-# INLINE fold #-}++    foldMap f = \case+        Failure _ -> mempty+        Success a -> f a+    {-# INLINE foldMap #-}++    foldr f x = \case+        Failure _ -> x+        Success a -> f a x+    {-# INLINE foldr #-}++    foldr' = foldr+    {-# INLINE foldr' #-}++    foldl f x = \case+        Failure _ -> x+        Success a -> f x a+    {-# INLINE foldl #-}++    foldl' = foldl+    {-# INLINE foldl' #-}++    toList = \case+        Failure _ -> []+        Success a -> [a]+    {-# INLINE toList #-}++    null = \case+        Failure _ -> True+        Success _ -> False+    {-# INLINE null #-}++    length = \case+        Failure _ -> 0+        Success _ -> 1+    {-# INLINE length #-}++    elem x = \case+        Failure _ -> False+        Success a -> x == a+    {-# INLINE elem #-}++    sum = \case+        Failure _ -> 0+        Success a -> a+    {-# INLINE sum #-}++    product = \case+        Failure _ -> 1+        Success a -> a+    {-# INLINE product #-}++++{- | Traverse values inside 'Success' with some effectful computation.++__Examples__++>>> parseInt = readMaybe :: String -> Maybe Int+>>> traverse parseInt (Success "42")+Just (Success 42)+>>> traverse parseInt (Success "int")+Nothing+>>> traverse parseInt (Failure ["42"])+Just (Failure ["42"])+-}+instance Traversable (Validation e) where+    traverse f (Success a) = Success <$> f a+    traverse _ (Failure e) = pure (Failure e)+    {-# INLINE traverse #-}++    sequenceA = \case+        Failure e -> pure (Failure e)+        Success f -> Success <$> f+    {-# INLINE sequenceA #-}++{- | Similar to 'Functor' but allows mapping of values inside both+'Failure' and 'Success'.++__Examples__++>>> bimap length show (Success 50)+Success "50"+>>> bimap length show (Failure ["15", "9"])+Failure 2+-}+instance Bifunctor Validation where+    bimap f _ (Failure e) = Failure (f e)+    bimap _ g (Success a) = Success (g a)+    {-# INLINE bimap #-}++    first f (Failure e) = Failure (f e)+    first _ (Success a) = Success a+    {-# INLINE first #-}++    second _ (Failure e) = Failure e+    second g (Success a) = Success (g a)+    {-# INLINE second #-}+++++{- | Similar to 'Foldable' but allows folding both 'Failure' and+'Success' to the same monoidal value according to given functions.++__Examples__++>>> one x = [x]+>>> bifoldMap id (one . show) (Success 15)+["15"]+>>> bifoldMap id (one . show) (Failure ["Wrong", "Fail"])+["Wrong","Fail"]+-}+instance Bifoldable Validation where+    bifoldMap f _ (Failure e) = f e+    bifoldMap _ g (Success a) = g a+    {-# INLINE bifoldMap #-}++{- | Similar to 'Traversable' but traverses both 'Failure' and+'Success' with given effectful computations.++__Examples__++>>> parseInt = readMaybe :: String -> Maybe Int+>>> bitraverse listToMaybe parseInt (Success "42")+Just (Success 42)+>>> bitraverse listToMaybe parseInt (Success "int")+Nothing+>>> bitraverse listToMaybe parseInt (Failure [15])+Just (Failure 15)+>>> bitraverse listToMaybe parseInt (Failure [])+Nothing+-}+instance Bitraversable Validation where+    bitraverse f _ (Failure e) = Failure <$> f e+    bitraverse _ g (Success a) = Success <$> g a+    {-# INLINE bitraverse #-}++instance NFData2 Validation where+    liftRnf2 f _s (Failure x) = f x+    liftRnf2 _f s (Success y) = s y+++++{- |+== Combinators++We are providing several functions for better integration with the 'Either'+related code in this section.+-}++{- | Transform a 'Validation' into an 'Either'.++>>> validationToEither (Success "whoop")+Right "whoop"++>>> validationToEither (Failure "nahh")+Left "nahh"+-}+validationToEither :: Validation e a -> Either e a+validationToEither = \case+    Failure e -> Left e+    Success a -> Right a+{-# INLINE validationToEither #-}++{- | Transform an 'Either' into a 'Validation'.++>>> eitherToValidation (Right "whoop")+Success "whoop"++>>> eitherToValidation (Left "nahh")+Failure "nahh"+-}+eitherToValidation :: Either e a -> Validation e a+eitherToValidation = \case+    Left e  -> Failure e+    Right a -> Success a+{-# INLINE eitherToValidation #-}++++----------------------------------------------------------------------------+-- Interface+----------------------------------------------------------------------------++{- | Predicate on if the given 'Validation' is 'Failure'.++>>> isFailure (Failure 'e')+True+>>> isFailure (Success 'a')+False+-}+isFailure :: Validation e a -> Bool+isFailure = \case+    Failure _ -> True+    Success _ -> False++{- | Predicate on if the given 'Validation' is 'Success'.++>>> isSuccess (Success 'a')+True+>>> isSuccess (Failure 'e')+False+-}+isSuccess :: Validation e a -> Bool+isSuccess = \case+    Success _ -> True+    Failure _ -> False++{- | Transforms the value of the given 'Validation' into @x@ using provided+functions that can transform 'Failure' and 'Success' value into the resulting+type respectively.++>>> let myValidation = validation (<> " world!") (show . (* 10))+>>> myValidation (Success 100)+"1000"+>>> myValidation (Failure "Hello")+"Hello world!"+-}+validation :: (e -> x) -> (a -> x) -> Validation e a -> x+validation fe fa = \case+    Success a -> fa a+    Failure e -> fe e++{- | Filters out all 'Failure' values into the new list of @e@s from the given+list of 'Validation's.++Note that the order is preserved.++>>> failures [Failure "Hello", Success 1, Failure "world", Success 2, Failure "!" ]+["Hello","world","!"]+-}+failures :: [Validation e a] -> [e]+failures v = [e | Failure e <- v]+{-# INLINE failures #-}++{- | Filters out all 'Success' values into the new list of @a@s from the given+list of 'Validation's.++Note that the order is preserved.++>>> successes [Failure "Hello", Success 1, Failure "world", Success 2, Failure "!" ]+[1,2]+-}+successes :: [Validation e a] -> [a]+successes v = [a | Success a <- v]+{-# INLINE successes #-}++{- | Redistributes the given list of 'Validation's into two lists of @e@s and+@e@s, where the first list contains all values of 'Failure's and the second+one — 'Success'es correspondingly.++Note that the order is preserved.++>>> partitionValidations [Failure "Hello", Success 1, Failure "world", Success 2, Failure "!" ]+(["Hello","world","!"],[1,2])+-}+partitionValidations :: [Validation e a] -> ([e], [a])+partitionValidations = go+  where+    go :: [Validation e a] -> ([e], [a])+    go []               = ([], [])+    go (Failure e:rest) = first  (e:) $ go rest+    go (Success a:rest) = second (a:) $ go rest++{- | Returns the contents of a 'Failure'-value or a default value otherwise.++>>> fromFailure "default" (Failure "failure")+"failure"+>>> fromFailure "default" (Success 1)+"default"+-}+fromFailure :: e -> Validation e a -> e+fromFailure _ (Failure e) = e+fromFailure e _           = e++{- | Returns the contents of a 'Success'-value or a default value otherwise.++>>> fromSuccess 42 (Success 1)+1+>>> fromSuccess 42 (Failure "failure")+42+-}+fromSuccess :: a -> Validation e a -> a+fromSuccess _ (Success a) = a+fromSuccess a _           = a++----------------------------------------------------------------------------+-- NonEmpty Combinators+----------------------------------------------------------------------------++{- $nonEmptyCombinators++When using 'Validation', we often work with the 'NonEmpty' list of errors, and+those lists will be concatenated later.++The following functions aim to help with writing more concise code.++For example, instead of (perfectly fine) code like:++>>> :{+validateNameVerbose :: String -> Validation (NonEmpty String) String+validateNameVerbose name+    | null name = Failure ("Empty Name" :| [])+    | otherwise = Success name+:}++one can write simply:++>>> :{+validateNameSimple :: String -> Validation (NonEmpty String) String+validateNameSimple name = name <$ failureIf (null name) "Empty Name"+:}++-}++{- | Create a 'Failure' of 'NonEmpty' list with a single given error.++>>> failure "I am a failure"+Failure ("I am a failure" :| [])+-}+failure :: e -> Validation (NonEmpty e) a+failure e = Failure (e :| [])+{-# INLINE failure #-}++{- | Returns a 'Failure' in case of the given predicate is 'True'.+Returns @'Success' ()@ otherwise.++>>> let shouldFail = (==) "I am a failure"+>>> failureIf (shouldFail "I am a failure") "I told you so"+Failure ("I told you so" :| [])+>>> failureIf (shouldFail "I am NOT a failure") "okay"+Success ()+-}+failureIf :: Bool -> e -> Validation (NonEmpty e) ()+failureIf p e+    | p = failure e+    | otherwise = Success ()+{-# INLINE failureIf #-}++{- | Returns a 'Failure' unless the given predicate is 'True'.+Returns @'Success' ()@ in case of the predicate is satisfied.++Similar to 'failureIf' with the reversed predicate.++@+'failureUnless' p ≡ 'failureIf' (not p)+@++>>> let shouldFail = (==) "I am a failure"+>>> failureUnless (shouldFail "I am a failure") "doesn't matter"+Success ()+>>> failureUnless (shouldFail "I am NOT a failure") "I told you so"+Failure ("I told you so" :| [])+-}+failureUnless :: Bool -> e -> Validation (NonEmpty e) ()+failureUnless p e+    | p = Success ()+    | otherwise = failure e+{-# INLINE failureUnless #-}++++{- | Validate all given checks in a 'Foldable'. Returns the 'Success' of the+start element when all checks are successful.+++A basic example of usage could look like this:++@+> __let__ validatePassword = 'validateAll'+        [ validateEmptyPassword+        , validateShortPassword+        ]++> 'validateAll' \"VeryStrongPassword\"+'Success' \"VeryStrongPassword\"++> 'validateAll' ""+'Failure' (EmptyPassword :| [ShortPassword])+@+-}+validateAll+    :: (Foldable f, Semigroup e)+    => f (a -> Validation e b)+    -> a+    -> Validation e a+validateAll fs a = foldl' (\res f -> res <* f a) (Success a) fs+{-# INLINE validateAll #-}++{- | Applies the given action to 'Validation' if it is 'Failure' and returns the+result. In case of 'Success' the default value is returned.++>>> whenFailure "bar" (Failure 42) (\a -> "foo" <$ print a)+42+"foo"++>>> whenFailure "bar" (Success 42) (\a -> "foo" <$ print a)+"bar"+-}+whenFailure :: Applicative f => x -> Validation e a -> (e -> f x) -> f x+whenFailure _ (Failure e) f = f e+whenFailure a (Success _) _ = pure a+{-# INLINE whenFailure #-}++{- | Applies given action to the 'Validation' content if it is 'Failure'.++Similar to 'whenFailure' but the default value is @()@.++>>> whenFailure_ (Success 42) putStrLn+>>> whenFailure_ (Failure "foo") putStrLn+foo+-}+whenFailure_ :: Applicative f => Validation e a -> (e -> f ()) -> f ()+whenFailure_ = whenFailure ()+{-# INLINE whenFailure_ #-}++{- | Monadic version of 'whenFailure'.+Applies monadic action to the given 'Validation' in case of 'Failure'.+Returns the resulting value, or provided default.++>>> whenFailureM "bar" (pure $ Failure 42) (\a -> "foo" <$ print a)+42+"foo"++>>> whenFailureM "bar" (pure $ Success 42) (\a -> "foo" <$ print a)+"bar"+-}+whenFailureM :: Monad m => x -> m (Validation e a) -> (e -> m x) -> m x+whenFailureM x mv f = mv >>= \v -> whenFailure x v f+{-# INLINE whenFailureM #-}++{- | Monadic version of 'whenFailure_'.+Applies monadic action to the given 'Validation' in case of 'Failure'.+Similar to 'whenFailureM' but the default is @()@.++>>> whenFailureM_ (pure $ Success 42) putStrLn+>>> whenFailureM_ (pure $ Failure "foo") putStrLn+foo+-}+whenFailureM_ :: Monad m => m (Validation e a) -> (e -> m ()) -> m ()+whenFailureM_ mv f = mv >>= \v -> whenFailure_ v f+{-# INLINE whenFailureM_ #-}++{- | Applies the given action to 'Validation' if it is 'Success' and returns the+result. In case of 'Failure' the default value is returned.++>>> whenSuccess "bar" (Failure "foo") (\a -> "success!" <$ print a)+"bar"++>>> whenSuccess "bar" (Success 42) (\a -> "success!" <$ print a)+42+"success!"+-}+whenSuccess :: Applicative f => x -> Validation e a -> (a -> f x) -> f x+whenSuccess x (Failure  _) _ = pure x+whenSuccess _ (Success a) f  = f a+{-# INLINE whenSuccess #-}++{- | Applies given action to the 'Validation' content if it is 'Success'.++Similar to 'whenSuccess' but the default value is @()@.++>>> whenSuccess_ (Failure "foo") print+>>> whenSuccess_ (Success 42) print+42+-}+whenSuccess_ :: Applicative f => Validation e a -> (a -> f ()) -> f ()+whenSuccess_ = whenSuccess ()+{-# INLINE whenSuccess_ #-}++{- | Monadic version of 'whenSuccess'.+Applies monadic action to the given 'Validation' in case of 'Success'.+Returns the resulting value, or provided default.++>>> whenSuccessM "bar" (pure $ Failure "foo") (\a -> "success!" <$ print a)+"bar"++>>> whenSuccessM "bar" (pure $ Success 42) (\a -> "success!" <$ print a)+42+"success!"+-}+whenSuccessM :: Monad m => x -> m (Validation e a) -> (a -> m x) -> m x+whenSuccessM x mv f = mv >>= \v -> whenSuccess x v f+{-# INLINE whenSuccessM #-}++{- | Monadic version of 'whenSuccess_'.+Applies monadic action to the given 'Validation' in case of 'Success'.+Similar to 'whenSuccessM' but the default is @()@.++>>> whenSuccessM_ (pure $ Failure "foo") print+>>> whenSuccessM_ (pure $ Success 42) print+42+-}+whenSuccessM_ :: Monad m => m (Validation e a) -> (a -> m ()) -> m ()+whenSuccessM_ mv f = mv >>= \v -> whenSuccess_ v f+{-# INLINE whenSuccessM_ #-}+++{- | Maps 'Failure' of 'Validation' to 'Just'.++>>> failureToMaybe (Failure True)+Just True+>>> failureToMaybe (Success "aba")+Nothing+-}+failureToMaybe :: Validation e a -> Maybe e+failureToMaybe = validation Just (const Nothing)+{-# INLINE failureToMaybe #-}++{- | Maps 'Success' of 'Validation' to 'Just'.++>>> successToMaybe (Failure True)+Nothing+>>> successToMaybe (Success "aba")+Just "aba"+-}+successToMaybe :: Validation e a -> Maybe a+successToMaybe = validation (const Nothing) Just+{-# INLINE successToMaybe #-}++{- | Maps 'Just' to 'Failure' In case of 'Nothing' it wraps the given default+value into 'Success'.++>>> maybeToFailure True (Just "aba")+Failure "aba"+>>> maybeToFailure True Nothing+Success True+-}+maybeToFailure :: a -> Maybe e -> Validation e a+maybeToFailure a = maybe (Success a) Failure+{-# INLINE maybeToFailure #-}++{- | Maps 'Just' to 'Success'. In case of 'Nothing' it wraps the given default+value into 'Failure'++>>> maybeToSuccess True (Just "aba")+Success "aba"+>>> maybeToSuccess True Nothing+Failure True+-}+maybeToSuccess :: e -> Maybe a -> Validation e a+maybeToSuccess e = maybe (Failure e) Success+{-# INLINE maybeToSuccess #-}

@@ -0,0 +1,66 @@+name:                validation-micro+version:             0.1.0.0+synopsis:            Lighweight pure data validation based on Applicative+description:+    Lighweight pure data validation based on Applicative. The library provides the+    following Either-like data type with suitable instances like Semigroup to accumulate validation errors in the `Failure` branch :+    .+    @+    __data__ Validation e a+    \    = Failure e+    \    | Success a+    @+    .++homepage:            https://github.com/unfoldml/validation-micro+license:             BSD3+license-file:        LICENSE+author:              Marco Zocca+maintainer:          oss@unfoldml.com+copyright:           2023 Marco Zocca+category:            Validation+build-type:          Simple+extra-source-files:  README.md+                     CHANGELOG.md+                     LICENSE+cabal-version:       >=1.10+tested-with:         GHC == 9.2.8++library+  default-language:    Haskell2010+  hs-source-dirs:      src+  exposed-modules:     Validation.Micro+  build-depends:       base >= 4.7 && < 5+                     , deepseq+  ghc-options:         -Wall+                       -Wcompat+                       -Widentities+                       -Wincomplete-record-updates+                       -Wincomplete-uni-patterns+                       -Wmissing-export-lists+                       -Wpartial-fields+                       -Wredundant-constraints++-- test-suite spec+--   default-language:    Haskell2010+--   type:                exitcode-stdio-1.0+--   hs-source-dirs:      test+--   main-is:             Spec.hs+--   other-modules:       LibSpec+--   build-depends:       base+--                      , validation-micro+--                      , hspec+--                      , QuickCheck+--   ghc-options:         -Wall+--                        -Wcompat+--                        -Widentities+--                        -Wincomplete-record-updates+--                        -Wincomplete-uni-patterns+--                        -Wmissing-export-lists+--                        -Wmissing-home-modules+--                        -Wpartial-fields+--                        -Wredundant-constraints++source-repository head+  type:     git+  location: https://github.com/unfoldml/validation-micro