validity 0.8.0.0 → 0.9.0.0

raw patch · 3 files changed

+50/−52 lines, 3 files

Files

• src/Data/Validity.hs +39/−25
• test/Data/ValiditySpec.hs +9/−25
• validity.cabal +2/−2

@@ -31,7 +31,7 @@     https://hackage.haskell.org/package/genvalidity ):      > instance Validity Prime where-    >     validate (Prime n) = isPrime n <?@> "The 'Int' is prime."+    >     validate (Prime n) = check (isPrime n) "The 'Int' is prime."      If certain typeclass invariants exist, you can make these explicit in the     validity instance as well.@@ -51,6 +51,8 @@     , decorateList     , invalid     , valid+    , validateNotNaN+    , validateNotInfinite     -- * Utilities     -- ** Utilities for validity checking     , isValid@@ -61,6 +63,8 @@     , Validation(..)     , ValidationChain(..)     , checkValidity+    , validationIsValid+    , prettyValidate     , prettyValidation     -- * Re-exports     , Monoid(..)@@ -424,28 +428,20 @@ instance Validity Word64 where     validate = trivialValidation --- | NOT trivially valid:------ * NaN is not valid.--- * Infinite values are not valid.+-- | Trivially valid: instance Validity Float where-    validate f =-        mconcat-            [ declare "The Float is not NaN." $ not (isNaN f)-            , declare "The Float is not infinite." $ not (isInfinite f)-            ]+    validate = trivialValidation --- | NOT trivially valid:------ * NaN is not valid.--- * Infinite values are not valid.+-- | Trivially valid: instance Validity Double where-    validate d =-        mconcat-            [ declare "The Double is not NaN." $ not (isNaN d)-            , declare "The Double is not infinite." $ not (isInfinite d)-            ]+    validate = trivialValidation +validateNotNaN :: RealFloat a => a -> Validation+validateNotNaN d = declare "The Double is not NaN." $ not (isNaN d)++validateNotInfinite :: RealFloat a => a -> Validation+validateNotInfinite d = declare "The Double is not infinite." $ not (isInfinite d)+ -- | Trivially valid -- -- Integer is not trivially valid under the hood, but instantiating@@ -547,12 +543,30 @@         Validation [] -> Right a         Validation errs -> Left errs --- | validate a given value, and return a nice error if the value is invalid.-prettyValidation :: Validity a => a -> Either String a-prettyValidation a =-    case checkValidity a of-        Right a_ -> Right a_-        Left errs -> Left $ intercalate "\n" $ map (errCascade . toStrings) errs+-- | Check if a 'Validation' concerns a valid value.+validationIsValid :: Validation -> Bool+validationIsValid v = case v of+    Validation [] -> True+    _ -> False++-- | Validate a given value+--+-- This function will return a nice error if the value is invalid.+-- It will return the original value in 'Right' if it was valid,+-- as evidence that it has been validated.+prettyValidate :: Validity a => a -> Either String a+prettyValidate a = case prettyValidation $ validate a of+    Just e -> Left e+    Nothing -> Right a++-- | Render a `Validation` in a somewhat pretty way.+--+-- This function will return 'Nothing' if the 'Validation' concerned a valid value.+prettyValidation :: Validation -> Maybe String+prettyValidation v =+    case v of+        Validation [] -> Nothing+        Validation errs -> Just $ intercalate "\n" $ map (errCascade . toStrings) errs   where     toStrings (Violated s) = ["Violated: " ++ s]     toStrings (Location s vc) = s : toStrings vc

@@ -6,10 +6,11 @@     ) where  import GHC.Generics (Generic)-#if !MIN_VERSION_base(4,11,0)+#if !MIN_VERSION_base(4,7,0) import Data.Monoid #endif import Data.Validity+import GHC.Real (Ratio(..))  import Test.Hspec @@ -25,38 +26,21 @@             Fine -> valid  data GeneratedValidity =-    G Double-      Double+    G Rational+      Rational     deriving (Show, Eq, Generic)  instance Validity GeneratedValidity --- To make sure that the <?!> operator have the right fixity-data ManuallyInstantiated =-    M Double-      Double-    deriving (Show, Eq)--instance Validity ManuallyInstantiated where-    validate (M m1 m2) = annotate m1 "m1" <> annotate m2 "m2"---- To make sure that the <?@> operator have the right fixity-data TwoEvens =-    E Int-      Int-    deriving (Show, Eq)--instance Validity TwoEvens where-    validate (E e1 e2) =-        declare "e1 is even" (even e1) <> declare "e2 is even" (even e2)- spec :: Spec spec = do     describe "Wrong" $ do         it "says Wrong is invalid" $ Wrong `shouldSatisfy` (not . isValid)         it "says Fine is valid" $ Fine `shouldSatisfy` isValid     describe "GeneratedValidity" $ do-        let nan = read "NaN"-        it "says G nan 0 is not valid" $ G nan 0 `shouldSatisfy` (not . isValid)-        it "says G 0 nan is not valid" $ G 0 nan `shouldSatisfy` (not . isValid)+        let nan = 1 :% 0+        it "says G (1:%0) 0 is not valid" $+            G nan 0 `shouldSatisfy` (not . isValid)+        it "says G 0 (1:%0) is not valid" $+            G 0 nan `shouldSatisfy` (not . isValid)         it "says G 0 0 is valid" $ G 0 0 `shouldSatisfy` isValid

@@ -2,10 +2,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 2d73ea367f1418980c464539a285c39b7ca5b03e5c820533c8f375b156eb9f27+-- hash: d7dbe113de14753bb19dacab5a6fad8e6ac1fd75f7d6157d10c29c478a6b267f  name:           validity-version:        0.8.0.0+version:        0.9.0.0 synopsis:       Validity typeclass description:    For more info, see <https://github.com/NorfairKing/validity the readme>.                 .