packages feed

validation-selective 0.0.0.0 → 0.1.0.0

raw patch · 6 files changed

+282/−6 lines, 6 filesdep ~basedep ~doctestdep ~text

Dependency ranges changed: base, doctest, text

Files

CHANGELOG.md view
@@ -3,6 +3,14 @@ `validation-selective` uses [PVP Versioning][1]. The changelog is available [on GitHub][2]. +## 0.1.0.0 — May 5, 2020++* [#41](https://github.com/kowainik/relude/issues/41):+  Support GHC-8.10.1.+* [#24](https://github.com/kowainik/relude/issues/24):+  Add `validationAll`, `when*` and `maybe*` combinators into+  `Validation.Combinators`.+ ## 0.0.0.0  * Initially created.
src/Validation.hs view
@@ -82,6 +82,25 @@          -- $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 (..))@@ -97,7 +116,9 @@ import GHC.Generics (Generic, Generic1) import GHC.TypeLits (ErrorMessage (..), TypeError) +import Validation.Combinators + -- $setup -- >>> import Control.Applicative (liftA3) -- >>> import Control.Selective (ifS)@@ -250,6 +271,7 @@     validateShortPassword password *> validatePasswordDigit password :} + Let's see how it works:  >>> validatePassword "abcd"@@ -259,6 +281,17 @@ >>> validatePassword "abcd12345" Success "abcd12345" +The @validation@ library provides several convenient combinators, so+you can write the password check in a shorter way:++@+validatePassword :: 'String' -> 'Validation' ('NonEmpty' FormValidationError) Password+validatePassword = 'fmap' Password . 'validateAll'+    [ (\`'failureIf'\`     ShortPassword)   . (< 8) . 'length'+    , (\`'failureUnless'\` NoDigitPassword) . 'any' isDigit+    ]+@+ After we've implemented validations for all fields, we can compose them together to produce validation for the whole @User@. As before, we are going to use the 'Applicative' instance:@@ -1108,7 +1141,7 @@ {-# INLINE failure #-}  {- | Returns a 'Failure' in case of the given predicate is 'True'.-Returns @'Success' '()'@ otherwise.+Returns @'Success' ()@ otherwise.  >>> let shouldFail = (==) "I am a failure" >>> failureIf (shouldFail "I am a failure") "I told you so"@@ -1123,7 +1156,7 @@ {-# INLINE failureIf #-}  {- | Returns a 'Failure' unless the given predicate is 'True'.-Returns @'Success' '()'@ in case of the predicate is satisfied.+Returns @'Success' ()@ in case of the predicate is satisfied.  Similar to 'failureIf' with the reversed predicate.
+ src/Validation.hs-boot view
@@ -0,0 +1,13 @@+module Validation+    ( Validation (..)+    , validation+    ) where+++data Validation e a+    = Failure e+    | Success a++instance (Semigroup e) => Applicative (Validation e)++validation :: (e -> x) -> (a -> x) -> Validation e a -> x
+ src/Validation/Combinators.hs view
@@ -0,0 +1,216 @@+{- |+Copyright:  (c) 2020 Kowainik+SPDX-License-Identifier: MPL-2.0+Maintainer: Kowainik <xrom.xkov@gmail.com>++Helpful combinators to work with 'Validation' data type.+-}++module Validation.Combinators+    ( validateAll++      -- * When* functions+    , whenSuccess+    , whenFailure+    , whenSuccess_+    , whenFailure_+    , whenSuccessM+    , whenFailureM+    , whenSuccessM_+    , whenFailureM_++      -- * 'Maybe' conversion+    , failureToMaybe+    , successToMaybe+    , maybeToFailure+    , maybeToSuccess++    ) where++import Data.Foldable (foldl')++import {-# SOURCE #-} Validation (Validation (..), validation)+++{- | 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+    :: forall e b a f+    .  (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 #-}
test/Doctest.hs view
@@ -23,4 +23,6 @@     : "-XRecordWildCards"     : "-XScopedTypeVariables"     : "-XTypeApplications"-    : [ "src/Validation.hs" ]+    : [ "src/Validation.hs"+      , "src/Validation/Combinators.hs"+      ]
validation-selective.cabal view
@@ -1,6 +1,6 @@ cabal-version:       2.4 name:                validation-selective-version:             0.0.0.0+version:             0.1.0.0 synopsis:            Lighweight pure data validation based on Applicative and Selective functors description:     Lighweight pure data validation based on Applicative and Selective@@ -28,13 +28,14 @@ tested-with:         GHC == 8.4.4                      GHC == 8.6.5                      GHC == 8.8.3+                     GHC == 8.10.1  source-repository head   type:                git   location:            https://github.com/kowainik/validation-selective.git  common common-options-  build-depends:       base >= 4.11.1.0 && < 4.14+  build-depends:       base >= 4.11.1.0 && < 4.15    ghc-options:         -Wall                        -Wcompat@@ -49,6 +50,8 @@                        -Wpartial-fields   if impl(ghc >= 8.8)     ghc-options:       -Wmissing-deriving-strategies+  if impl(ghc >= 8.10)+    ghc-options:       -Wunused-packages    default-language:    Haskell2010   default-extensions:  ConstraintKinds@@ -70,6 +73,7 @@   import:              common-options   hs-source-dirs:      src   exposed-modules:     Validation+                         Validation.Combinators   build-depends:       deepseq ^>= 1.4.3.0                      , selective >= 0.3 && < 0.5 @@ -86,7 +90,7 @@                      , hspec ^>= 2.7.1                      , hspec-hedgehog ^>= 0.0.1.1                      , selective-                     , text ^>= 1.2.4+                     , text ^>= 1.2.3   ghc-options:         -threaded                        -rtsopts                        -with-rtsopts=-N