validity 0.11.0.1 → 0.12.1.0
raw patch · 7 files changed
Files
- CHANGELOG.md +90/−0
- LICENSE +1/−1
- Setup.hs +0/−3
- src/Data/RelativeValidity.hs +0/−23
- src/Data/Validity.hs +80/−59
- test/Data/ValiditySpec.hs +20/−6
- validity.cabal +7/−5
+ CHANGELOG.md view
@@ -0,0 +1,90 @@+# Changelog++## [0.12.1.0 - 2024-07-18]++### Added++* `Validity` instances for various newtypes in base++## [0.12.0.2] - 2023-10-09++### Added++* `decorateString`++## [0.12.0.1] - 2022-04-26++### Added++* Compatibility with `GHC >= 9.0.0`++## [0.12.0.0] - 2021-11-20++### Removed++* `RelativeValidity`, it was a misfeature.++## [0.11.0.0] - 2020-04-17++### Changed++* Made it so that Char is no longer trivially valid.++## [0.10.0.0] - 2020-04-12++### Changed++* Made it so that Word8, Word16, Word32 and Int8, Int16, Int32 are no longer trivially valid.++## [0.9.0.3] - 2020-02-10++### Changed++* Improved the 'validateRatioNormalised' to not crash on certain extreme values.++## [0.9.0.2] - 2019-09-27++### Added++* `isUtf16SurrogateCodePoint` and `validateCharNotUtf16SurrogateCodePoint`++### Changed++* The contents of the error message when using `validateNotNan` or `validateNotInfinite` is now more accurate.++### Added++* `validateRatioNotNan`+* `validateRatioNotInfinite`+* `validateRatioNormalised`++## [0.9.0.1] - 2018-12-05++### Changed++* The validity instance of `Ratio a` now disallows unnormalised values.+ So `0 %: 1` is valid, but `0 %: 2` is not.++## [0.9.0.0] - 2018-10-07++### Added++* `prettyValidate`, `validationIsValid`, `prettyValidation`+* `validateNotNaN`, `validateNotInfinite`++### Changed++* Renamed `prettyValidation` to `prettyValidate` before adding the new `prettyValidation`.+* `NaN`, `+Infinity` and `-Infinity` are now considered valid for both `Double` and `Float`.++## [0.8.0.0] - 2018-08-25++### Added+* `decorateList` in `Data.Validity`++### Changed+* `-0` is now a valid value for `Double` and `Float`.++## Older versions++No history before version 0.8.0.0
LICENSE view
@@ -1,6 +1,6 @@ The MIT License (MIT) -Copyright (c) 2016-2020 Tom Sydney Kerckhove+Copyright (c) 2016-2021 Tom Sydney Kerckhove Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal
− Setup.hs
@@ -1,3 +0,0 @@-import Distribution.Simple--main = defaultMain
− src/Data/RelativeValidity.hs
@@ -1,23 +0,0 @@-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE MultiParamTypeClasses #-}---- | Relative validity-module Data.RelativeValidity- ( RelativeValidity (..),- isInvalidFor,- )-where---- | A class of types that have additional invariants defined upon them--- that aren't enforced by the type system------ If there is a @Validity a@ instance as well, then @a `isValidFor` b@--- should imply @isValid a@ for any @b@.------ If there is a @Validity b@ instance as well, then @a `isValidFor` b@--- should imply @isValid b@ for any @a@.-class RelativeValidity a b where- isValidFor :: a -> b -> Bool--isInvalidFor :: RelativeValidity a b => a -> b -> Bool-isInvalidFor a b = not $ isValidFor a b
src/Data/Validity.hs view
@@ -1,14 +1,14 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MagicHash #-}+{-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeOperators #-}--#if MIN_VERSION_base(4,9,0) {-# OPTIONS_GHC -fno-warn-redundant-constraints #-}-#endif -- | --@@ -51,6 +51,7 @@ delve, decorate, decorateList,+ decorateString, invalid, valid, @@ -91,41 +92,33 @@ -- * Re-exports Monoid (..),-#if MIN_VERSION_base(4,11,0)- Semigroup(..),-#endif+ Semigroup (..), ) where -#if MIN_VERSION_base(4,9,0)-import Data.List.NonEmpty (NonEmpty((:|)))-#endif--#if MIN_VERSION_base(4,8,0)-#else-import Data.Monoid-import Data.Ratio-#endif import Data.Bits ((.&.)) import Data.Char (ord) import Data.Either (isRight) import Data.Fixed (Fixed (MkFixed), HasResolution) import Data.Int (Int64) import Data.List (intercalate)+import Data.List.NonEmpty (NonEmpty ((:|))) import Data.Maybe (fromMaybe)-#if MIN_VERSION_base(4,8,0)-import GHC.Word (Word8(..), Word16(..), Word32(..), Word64(..))+#if MIN_VERSION_base(4,16,0)+import GHC.Exts (Char (..), isTrue#, ord#, (<=#), (>=#)) #else-import Data.Word (Word)-import GHC.Word (Word8(..), Word16(..), Word32(..), Word64(..))-#endif import GHC.Exts (Char (..), isTrue#, leWord#, ord#, (<=#), (>=#))+#endif+import Data.Functor.Const (Const (Const))+import Data.Functor.Identity (Identity (Identity))+import Data.Monoid (Alt, Dual)+import qualified Data.Monoid as Monoid+import qualified Data.Semigroup as Semigroup import GHC.Generics import GHC.Int (Int16 (..), Int32 (..), Int8 (..))-#if MIN_VERSION_base(4,8,0) import GHC.Natural-#endif import GHC.Real (Ratio (..))+import GHC.Word (Word16 (..), Word32 (..), Word64 (..), Word8 (..)) -- | A class of types that have additional invariants defined upon them @@ -230,20 +223,12 @@ } deriving (Show, Eq, Generic) -#if MIN_VERSION_base(4,11,0) instance Semigroup Validation where- (Validation v1) <> (Validation v2) = Validation $ v1 ++ v2-#endif+ (Validation v1) <> (Validation v2) = Validation $ v1 ++ v2 -#if MIN_VERSION_base(4,11,0) instance Monoid Validation where mempty = Validation [] mappend = (<>)-#else-instance Monoid Validation where- mempty = Validation []- mappend (Validation v1) (Validation v2) = Validation $ v1 ++ v2-#endif -- | Declare any value to be valid in validation --@@ -281,11 +266,11 @@ -- > [ annotate a "The first element of the tuple" -- > , annotate b "The second element of the tuple" -- > ]-annotate :: Validity a => a -> String -> Validation+annotate :: (Validity a) => a -> String -> Validation annotate = annotateValidation . validate -- | 'annotate', but with the arguments flipped.-delve :: Validity a => String -> a -> Validation+delve :: (Validity a) => String -> a -> Validation delve = flip annotate -- | Decorate a validation with a location@@ -299,6 +284,12 @@ decorate (unwords ["The element at index", show (i :: Integer), "in the list"]) $ func a +-- | 'decorateList', but specifically for 'String's+--+-- > decorateString = decorateList+decorateString :: String -> (Char -> Validation) -> Validation+decorateString = decorateList+ -- | Construct a trivially invalid 'Validation' -- -- Example:@@ -394,26 +385,24 @@ -- This means that the empty list is considered valid. -- If the empty list should not be considered valid as part of your custom data -- type, make sure to write a custom @Validity instance@-instance Validity a => Validity [a] where+instance (Validity a) => Validity [a] where validate = flip decorateList validate -#if MIN_VERSION_base(4,9,0) -- | A nonempty list is valid if all the elements are valid. -- -- See the instance for 'Validity [a]' for more information.-instance Validity a => Validity (NonEmpty a) where- validate (e :| es) =- mconcat- [ annotate e "The first element of the nonempty list"- , annotate es "The rest of the elements of the nonempty list"- ]-#endif+instance (Validity a) => Validity (NonEmpty a) where+ validate (e :| es) =+ mconcat+ [ annotate e "The first element of the nonempty list",+ annotate es "The rest of the elements of the nonempty list"+ ] -- | A Maybe thing is valid if the thing inside is valid or it's nothing -- It makes sense to assume that 'Nothing' is valid. -- If Nothing wasn't valid, you wouldn't have used a Maybe -- in the datastructure.-instance Validity a => Validity (Maybe a) where+instance (Validity a) => Validity (Maybe a) where validate Nothing = mempty validate (Just a) = annotate a "The 'Just'" @@ -464,6 +453,11 @@ instance Validity Int where validate = trivialValidation +#if MIN_VERSION_base(4,16,0)+instance Validity Int8 where validate = trivialValidation+instance Validity Int16 where validate = trivialValidation+instance Validity Int32 where validate = trivialValidation+#else -- | NOT trivially valid on GHC because small number types are represented using a 64bit structure underneath. instance Validity Int8 where validate (I8# i#) =@@ -487,6 +481,7 @@ [ declare "The contained integer is smaller than 2^31 = 2147483648" $ isTrue# (i# <=# 2147483647#), declare "The contained integer is greater than or equal to -2^31 = -2147483648" $ isTrue# (i# >=# -2147483648#) ]+#endif -- | Trivially valid instance Validity Int64 where@@ -496,6 +491,11 @@ instance Validity Word where validate = trivialValidation +#if MIN_VERSION_base(4,16,0)+instance Validity Word8 where validate = trivialValidation+instance Validity Word16 where validate = trivialValidation+instance Validity Word32 where validate = trivialValidation+#else -- | NOT trivially valid on GHC because small number types are represented using a 64bit structure underneath. instance Validity Word8 where validate (W8# w#) =@@ -510,6 +510,7 @@ instance Validity Word32 where validate (W32# w#) = declare "The contained integer is smaller than 2^32 = 4294967296" $ isTrue# (w# `leWord#` 4294967295##)+#endif -- | Trivially valid instance Validity Word64 where@@ -523,26 +524,50 @@ instance Validity Double where validate = trivialValidation -validateNotNaN :: RealFloat a => a -> Validation+-- | Valid values the same as it's base type:+deriving newtype instance (Validity a) => Validity (Identity a)++-- | Valid values the same as it's base type:+deriving newtype instance (Validity (f a)) => Validity (Alt f a)++-- | Valid values the same as it's base type:+deriving newtype instance (Validity a) => Validity (Dual a)++-- | Valid values the same as it's base type:+deriving newtype instance (Validity a) => Validity (Semigroup.First a)++-- | Valid values the same as it's base type:+deriving newtype instance (Validity a) => Validity (Semigroup.Last a)++-- | Valid values the same as it's base type:+deriving newtype instance (Validity a) => Validity (Monoid.First a)++-- | Valid values the same as it's base type:+deriving newtype instance (Validity a) => Validity (Monoid.Last a)++-- | Valid values the same as it's base type:+deriving newtype instance (Validity a) => Validity (Const a b)++validateNotNaN :: (RealFloat a) => a -> Validation validateNotNaN d = declare "The RealFloat is not NaN." $ not (isNaN d) -validateNotInfinite :: RealFloat a => a -> Validation+validateNotInfinite :: (RealFloat a) => a -> Validation validateNotInfinite d = declare "The RealFloat is not infinite." $ not (isInfinite d) -validateRatioNotNaN :: Integral a => Ratio a -> Validation+validateRatioNotNaN :: (Integral a) => Ratio a -> Validation validateRatioNotNaN r = declare "The Ratio is not NaN." $ case r of (0 :% 0) -> False _ -> True -validateRatioNotInfinite :: Integral a => Ratio a -> Validation+validateRatioNotInfinite :: (Integral a) => Ratio a -> Validation validateRatioNotInfinite r = declare "The Ratio is not infinite." $ case r of (1 :% 0) -> False ((-1) :% 0) -> False _ -> True -validateRatioNormalised :: Integral a => Ratio a -> Validation+validateRatioNormalised :: (Integral a) => Ratio a -> Validation validateRatioNormalised (n :% d) = declare "The Ratio is normalised." $ case d of 0 -> False@@ -564,13 +589,9 @@ instance Validity Integer where validate = trivialValidation -#if MIN_VERSION_base(4,8,0) -- | Valid according to 'isValidNatural'------ Only available with @base >= 4.8@. instance Validity Natural where- validate = declare "The Natural is valid." . isValidNatural-#endif+ validate = declare "The Natural is valid." . isValidNatural -- | Valid if the contained numbers are valid and the denominator is -- strictly positive.@@ -584,7 +605,7 @@ ] -- | Valid according to the contained 'Integer'.-instance HasResolution a => Validity (Fixed a) where+instance (HasResolution a) => Validity (Fixed a) where validate (MkFixed i) = validate i annotateValidation :: Validation -> String -> Validation@@ -621,17 +642,17 @@ gValidate (K1 x) = validate x -- | Check whether a value is valid.-isValid :: Validity a => a -> Bool+isValid :: (Validity a) => a -> Bool isValid = isRight . checkValidity -- | Check whether a value is not valid. -- -- > isInvalid = not . isValid-isInvalid :: Validity a => a -> Bool+isInvalid :: (Validity a) => a -> Bool isInvalid = not . isValid -- | Construct a valid element from an unchecked element-constructValid :: Validity a => a -> Maybe a+constructValid :: (Validity a) => a -> Maybe a constructValid p = if isValid p then Just p@@ -651,7 +672,7 @@ -- -- Note: You may want to use 'prettyValidation' instead, if you want to -- display these 'ValidationChain's to a user.-checkValidity :: Validity a => a -> Either [ValidationChain] a+checkValidity :: (Validity a) => a -> Either [ValidationChain] a checkValidity a = case validate a of Validation [] -> Right a@@ -668,7 +689,7 @@ -- 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 :: (Validity a) => a -> Either String a prettyValidate a = case prettyValidation $ validate a of Just e -> Left e Nothing -> Right a
test/Data/ValiditySpec.hs view
@@ -1,16 +1,12 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE MagicHash #-} --- {-# LANGUAGE CPP #-}- module Data.ValiditySpec ( spec, ) where --- #if !MIN_VERSION_base(4,7,0)--- import Data.Monoid--- #endif import Data.Maybe import Data.Validity import GHC.Exts (Char (..), chr#)@@ -56,30 +52,48 @@ describe "Validity Int8" $ do it "Says that minBound is valid" $ isValid (minBound :: Int8) `shouldBe` True it "Says that maxBound is valid" $ isValid (maxBound :: Int8) `shouldBe` True+#if MIN_VERSION_base(4,16,0)+#else it "Says that Int# 200 is invalid" $ isValid (I8# 200#) `shouldBe` False it "Says that Int# -200 is invalid" $ isValid (I8# (-200#)) `shouldBe` False+#endif describe "Validity Int16" $ do it "Says that minBound is valid" $ isValid (minBound :: Int16) `shouldBe` True it "Says that maxBound is valid" $ isValid (maxBound :: Int16) `shouldBe` True+#if MIN_VERSION_base(4,16,0)+#else it "Says that Int# 4000 is invalid" $ isValid (I16# 40000#) `shouldBe` False it "Says that Int# -4000 is invalid" $ isValid (I16# (-40000#)) `shouldBe` False+#endif describe "Validity Int32" $ do it "Says that minBound is valid" $ isValid (minBound :: Int32) `shouldBe` True it "Says that maxBound is valid" $ isValid (maxBound :: Int32) `shouldBe` True+#if MIN_VERSION_base(4,16,0)+#else it "Says that Int# 2200000000 is invalid" $ isValid (I32# 2200000000#) `shouldBe` False it "Says that Int# -2200000000 is invalid" $ isValid (I32# (-2200000000#)) `shouldBe` False+#endif describe "Validity Word8" $ do it "Says that minBound is valid" $ isValid (minBound :: Word8) `shouldBe` True it "Says that maxBound is valid" $ isValid (maxBound :: Word8) `shouldBe` True+#if MIN_VERSION_base(4,16,0)+#else it "Says that Word# 300 is invalid" $ isValid (W8# 300##) `shouldBe` False+#endif describe "Validity Word16" $ do it "Says that minBound is valid" $ isValid (minBound :: Word16) `shouldBe` True it "Says that maxBound is valid" $ isValid (maxBound :: Word16) `shouldBe` True+#if MIN_VERSION_base(4,16,0)+#else it "Says that Word# 80000 is invalid" $ isValid (W16# 80000##) `shouldBe` False+#endif describe "Validity Word32" $ do it "Says that minBound is valid" $ isValid (minBound :: Word32) `shouldBe` True it "Says that maxBound is valid" $ isValid (maxBound :: Word32) `shouldBe` True+#if MIN_VERSION_base(4,16,0)+#else it "Says that Word# 4800000000 is invalid" $ isValid (W32# 4800000000##) `shouldBe` False+#endif describe "Chars" $ do describe "Small" $ do describe "Validity Char" $ do@@ -132,7 +146,7 @@ describe "NormalisedRatio" $ do it "says that NaN is invalid" $ NormalisedRatio notANumber `shouldSatisfy` (not . isValid) it "says that +Inf is invalid" $ NormalisedRatio infinity `shouldSatisfy` (not . isValid)- it "says that -Inf is invalid" $ NormalisedRatio (- infinity) `shouldSatisfy` (not . isValid)+ it "says that -Inf is invalid" $ NormalisedRatio (-infinity) `shouldSatisfy` (not . isValid) it "says that these non-normalised numbers are invalid" $ do NormalisedRatio ((5 :: Integer) :% 5) `shouldSatisfy` (not . isValid) NormalisedRatio ((1 :: Integer) :% (-5)) `shouldSatisfy` (not . isValid)
validity.cabal view
@@ -1,11 +1,11 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.34.4.+-- This file has been generated from package.yaml by hpack version 0.36.0. -- -- see: https://github.com/sol/hpack name: validity-version: 0.11.0.1+version: 0.12.1.0 synopsis: Validity typeclass description: For more info, see <https://github.com/NorfairKing/validity the readme>. .@@ -39,6 +39,9 @@ license: MIT license-file: LICENSE build-type: Simple+extra-source-files:+ LICENSE+ CHANGELOG.md source-repository head type: git@@ -46,7 +49,6 @@ library exposed-modules:- Data.RelativeValidity Data.Validity other-modules: Paths_validity@@ -54,7 +56,7 @@ src ghc-options: -Wno-redundant-constraints build-depends:- base >=4.7 && <5+ base >=4.13 && <5 default-language: Haskell2010 test-suite validity-test@@ -67,7 +69,7 @@ test ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall build-depends:- base >=4.7 && <5+ base >=4.13 && <5 , hspec , validity default-language: Haskell2010