validation 1.2.1 → 1.2.2
raw patch · 4 files changed
+145/−4 lines, 4 files
Files
- changelog +6/−0
- src/Data/Validation.hs +70/−2
- test/hedgehog_tests.hs +68/−1
- validation.cabal +1/−1
changelog view
@@ -1,3 +1,9 @@+1.2.2++* Implement Either instances for ReviewFailure, AsFailure, ReviewSuccess,+ and AsSuccess+* Add hedgehog property tests for Either optic instances+ 1.2.1 * Updates to documentation.
src/Data/Validation.hs view
@@ -10,7 +10,7 @@ {-# LANGUAGE NoImplicitPrelude #-} {-# OPTIONS_GHC -Wall #-} --- $setup+-- \$setup -- >>> import Prelude hiding (either, id, (.)) -- >>> import Data.List.NonEmpty(NonEmpty(..)) -- >>> import Data.Semigroup(Semigroup((<>)))@@ -96,7 +96,7 @@ import Control.Arrow (Arrow (arr, first), ArrowApply (app), ArrowChoice (left, right)) import Control.Category (Category (..), (>>>)) import Control.DeepSeq (NFData (rnf))-import Control.Lens (Getter, Lens', Prism, Prism', Review, Wrapped (_Wrapped', type Unwrapped), Rewrapped, prism, prism')+import Control.Lens (Getter, Lens', Prism, Prism', Review, Rewrapped, Wrapped (_Wrapped', type Unwrapped), prism, prism') import Control.Lens.Iso (Iso, iso #if !MIN_VERSION_lens(4,20,0) , Swapped(..))@@ -495,6 +495,20 @@ reviewFailure = __Failure {-# INLINE reviewFailure #-} +-- |+-- >>> import Control.Lens((#))+-- >>> reviewFailure # "err" :: Either String Int+-- Left "err"+instance ReviewFailure (Either a b) a b where+ reviewFailure =+ prism'+ Left+ ( \case+ Left a -> Just a+ Right _ -> Nothing+ )+ {-# INLINE reviewFailure #-}+ -- | Class for types that have a 'Prism'' to an @err@ (as generated by @makeClassyPrisms@). class (ReviewFailure s err a) => AsFailure s err a | s -> err a where _Failure :: Prism' s err@@ -513,6 +527,26 @@ _Failure = __Failure {-# INLINE _Failure #-} +-- |+-- >>> import Control.Lens((^?), (#))+-- >>> _Failure # "err" :: Either String Int+-- Left "err"+--+-- >>> (Left "err" :: Either String Int) ^? _Failure+-- Just "err"+--+-- >>> (Right 1 :: Either String Int) ^? _Failure+-- Nothing+instance AsFailure (Either a b) a b where+ _Failure =+ prism'+ Left+ ( \case+ Left a -> Just a+ Right _ -> Nothing+ )+ {-# INLINE _Failure #-}+ -- | Class for types that have a 'Getter' to an @a@. class GetSuccess s err a | s -> err a where getSuccess :: Getter s a@@ -527,6 +561,20 @@ -- | -- >>> import Control.Lens((#))+-- >>> reviewSuccess # 1 :: Either String Int+-- Right 1+instance ReviewSuccess (Either a b) a b where+ reviewSuccess =+ prism'+ Right+ ( \case+ Right a -> Just a+ Left _ -> Nothing+ )+ {-# INLINE reviewSuccess #-}++-- |+-- >>> import Control.Lens((#)) -- >>> reviewSuccess # 1 :: Validation String Int -- Success 1 instance ReviewSuccess (Validation err a) err a where@@ -536,6 +584,26 @@ -- | Class for types that have a 'Prism'' to an @a@ (as generated by @makeClassyPrisms@). class (ReviewSuccess s err a) => AsSuccess s err a | s -> err a where _Success :: Prism' s a++-- |+-- >>> import Control.Lens((^?), (#))+-- >>> _Success # 1 :: Either String Int+-- Right 1+--+-- >>> (Right 1 :: Either String Int) ^? _Success+-- Just 1+--+-- >>> (Left "err" :: Either String Int) ^? _Success+-- Nothing+instance AsSuccess (Either a b) a b where+ _Success =+ prism'+ Right+ ( \case+ Right a -> Just a+ Left _ -> Nothing+ )+ {-# INLINE _Success #-} -- | -- >>> import Control.Lens((^?), (#))
test/hedgehog_tests.hs view
@@ -62,7 +62,15 @@ ("prop_validator_semigroupoid_assoc", prop_validator_semigroupoid_assoc), ("prop_validator_apply_accumulates", prop_validator_apply_accumulates), ("prop_validator_alt_accumulates", prop_validator_alt_accumulates),- ("prop_validator_alt_left_success", prop_validator_alt_left_success)+ ("prop_validator_alt_left_success", prop_validator_alt_left_success),+ ("prop_either_reviewFailure", prop_either_reviewFailure),+ ("prop_either_asFailure_hit", prop_either_asFailure_hit),+ ("prop_either_asFailure_miss", prop_either_asFailure_miss),+ ("prop_either_reviewSuccess", prop_either_reviewSuccess),+ ("prop_either_asSuccess_hit", prop_either_asSuccess_hit),+ ("prop_either_asSuccess_miss", prop_either_asSuccess_miss),+ ("prop_either_failure_roundtrip", prop_either_failure_roundtrip),+ ("prop_either_success_roundtrip", prop_either_success_roundtrip) ] unless result exitFailure@@ -384,3 +392,62 @@ let f = Validator (Success . (+ 1)) :: Validator' [String] Int Int g = Validator (\_ -> Failure ["e2"]) :: Validator' [String] Int Int runV (f <!> g) x === Success (x + 1)++-- Either instances: ReviewFailure, AsFailure, ReviewSuccess, AsSuccess++genEither :: Gen a -> Gen b -> Gen (Prelude.Either a b)+genEither ga gb = Gen.choice [fmap Left ga, fmap Right gb]++prop_either_reviewFailure :: Property+prop_either_reviewFailure =+ property $ do+ e <- forAll genStrings+ (reviewFailure # e :: Prelude.Either [String] Int) === Left e++prop_either_asFailure_hit :: Property+prop_either_asFailure_hit =+ property $ do+ e <- forAll genStrings+ (Left e :: Prelude.Either [String] Int) ^? _Failure === Just e++prop_either_asFailure_miss :: Property+prop_either_asFailure_miss =+ property $ do+ a <- forAll genInt+ (Right a :: Prelude.Either [String] Int) ^? _Failure === Nothing++prop_either_reviewSuccess :: Property+prop_either_reviewSuccess =+ property $ do+ a <- forAll genInt+ (reviewSuccess # a :: Prelude.Either [String] Int) === Right a++prop_either_asSuccess_hit :: Property+prop_either_asSuccess_hit =+ property $ do+ a <- forAll genInt+ (Right a :: Prelude.Either [String] Int) ^? _Success === Just a++prop_either_asSuccess_miss :: Property+prop_either_asSuccess_miss =+ property $ do+ e <- forAll genStrings+ (Left e :: Prelude.Either [String] Int) ^? _Success === Nothing++prop_either_failure_roundtrip :: Property+prop_either_failure_roundtrip =+ property $ do+ x <- forAll (genEither genStrings genInt)+ let reviewed = x ^? _Failure+ case x of+ Left e -> reviewed === Just e+ Right _ -> reviewed === Nothing++prop_either_success_roundtrip :: Property+prop_either_success_roundtrip =+ property $ do+ x <- forAll (genEither genStrings genInt)+ let reviewed = x ^? _Success+ case x of+ Right a -> reviewed === Just a+ Left _ -> reviewed === Nothing
validation.cabal view
@@ -1,5 +1,5 @@ name: validation-version: 1.2.1+version: 1.2.2 license: BSD3 license-file: LICENCE author: Tony Morris <ʇǝu˙sıɹɹoɯʇ@ןןǝʞsɐɥ> <dibblego>, Nick Partridge <nkpart>