validity 0.11.0.0 → 0.11.0.1
raw patch · 4 files changed
+290/−227 lines, 4 files
Files
- src/Data/RelativeValidity.hs +6/−6
- src/Data/Validity.hs +262/−214
- test/Data/ValiditySpec.hs +18/−0
- validity.cabal +4/−7
src/Data/RelativeValidity.hs view
@@ -1,12 +1,12 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} -{-| Relative validity- -}+-- | Relative validity module Data.RelativeValidity- ( RelativeValidity(..)- , isInvalidFor- ) where+ ( RelativeValidity (..),+ isInvalidFor,+ )+where -- | A class of types that have additional invariants defined upon them -- that aren't enforced by the type system@@ -17,7 +17,7 @@ -- 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+ isValidFor :: a -> b -> Bool isInvalidFor :: RelativeValidity a b => a -> b -> Bool isInvalidFor a b = not $ isValidFor a b
src/Data/Validity.hs view
@@ -5,91 +5,102 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE TypeOperators #-}+ #if MIN_VERSION_base(4,9,0) {-# OPTIONS_GHC -fno-warn-redundant-constraints #-} #endif -{-|-- @Validity@ is used to specify additional invariants upon values that are not- enforced by the type system.-- Let's take an example.- Suppose we were to implement a type @Prime@ that represents prime integers.-- If you were to completely enforce the invariant that the represented number is- a prime, then we could use 'Natural' and only store the index of the- given prime in the infinite sequence of prime numbers.- This is very safe but also very expensive if we ever want to use the number,- because we would have to calculcate all the prime numbers until that index.-- Instead we choose to implement @Prime@ by a @newtype Prime = Prime Int@.- Now we have to maintain the invariant that the @Int@ that we use to represent- the prime is in fact positive and a prime.-- The @Validity@ typeclass allows us to specify this invariant (and enables- testing via the @genvalidity@ libraries:- https://hackage.haskell.org/package/genvalidity ):-- > instance Validity Prime where- > 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.- For example, 'Fixed a' is only valid if 'a' has an 'HasResolution' instance,- so the correct validity instance is @HasResolution a => Validity (Fixed a)@.- -}+-- |+--+-- @Validity@ is used to specify additional invariants upon values that are not+-- enforced by the type system.+--+-- Let's take an example.+-- Suppose we were to implement a type @Prime@ that represents prime integers.+--+-- If you were to completely enforce the invariant that the represented number is+-- a prime, then we could use 'Natural' and only store the index of the+-- given prime in the infinite sequence of prime numbers.+-- This is very safe but also very expensive if we ever want to use the number,+-- because we would have to calculcate all the prime numbers until that index.+--+-- Instead we choose to implement @Prime@ by a @newtype Prime = Prime Int@.+-- Now we have to maintain the invariant that the @Int@ that we use to represent+-- the prime is in fact positive and a prime.+--+-- The @Validity@ typeclass allows us to specify this invariant (and enables+-- testing via the @genvalidity@ libraries:+-- https://hackage.haskell.org/package/genvalidity ):+--+-- > instance Validity Prime where+-- > 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.+-- For example, 'Fixed a' is only valid if 'a' has an 'HasResolution' instance,+-- so the correct validity instance is @HasResolution a => Validity (Fixed a)@. module Data.Validity- ( Validity(..)+ ( Validity (..),+ -- * Helper functions to define 'validate'- , trivialValidation- , genericValidate- , check- , declare- , annotate- , delve- , decorate- , decorateList- , invalid- , valid+ trivialValidation,+ genericValidate,+ check,+ declare,+ annotate,+ delve,+ decorate,+ decorateList,+ invalid,+ valid,+ -- ** Helpers for specific types+ -- *** Char- , validateCharNotUtf16SurrogateCodePoint- , isUtf16SurrogateCodePoint+ validateCharNotUtf16SurrogateCodePoint,+ isUtf16SurrogateCodePoint,+ validateCharNotLineSeparator,+ isLineSeparator,+ validateStringSingleLine,+ isSingleLine,+ -- *** RealFloat (Double)- , validateNotNaN- , validateNotInfinite+ validateNotNaN,+ validateNotInfinite,+ -- *** Ratio- , validateRatioNotNaN- , validateRatioNotInfinite- , validateRatioNormalised+ validateRatioNotNaN,+ validateRatioNotInfinite,+ validateRatioNormalised,+ -- * Utilities+ -- ** Utilities for validity checking- , isValid- , isInvalid- , constructValid- , constructValidUnsafe+ isValid,+ isInvalid,+ constructValid,+ constructValidUnsafe,+ -- ** Utilities for validation- , Validation(..)- , ValidationChain(..)- , checkValidity- , validationIsValid- , prettyValidate- , prettyValidation+ Validation (..),+ ValidationChain (..),+ checkValidity,+ validationIsValid,+ prettyValidate,+ prettyValidation,+ -- * Re-exports- , Monoid(..)+ Monoid (..), #if MIN_VERSION_base(4,11,0)- , Semigroup(..)+ Semigroup(..), #endif- ) where+ )+where -import Data.Either (isRight)-import Data.Fixed (Fixed(MkFixed), HasResolution)-import Data.List (intercalate) #if MIN_VERSION_base(4,9,0) import Data.List.NonEmpty (NonEmpty((:|))) #endif-import Data.Maybe (fromMaybe)+ #if MIN_VERSION_base(4,8,0) #else import Data.Monoid@@ -97,21 +108,24 @@ #endif import Data.Bits ((.&.)) import Data.Char (ord)+import Data.Either (isRight)+import Data.Fixed (Fixed (MkFixed), HasResolution) import Data.Int (Int64)-import GHC.Int (Int8(..), Int16(..), Int32(..))-import GHC.Exts (Char(..), ord#, isTrue#, (<=#), (>=#), (<#), (>=#))+import Data.List (intercalate)+import Data.Maybe (fromMaybe) #if MIN_VERSION_base(4,8,0) import GHC.Word (Word8(..), Word16(..), Word32(..), Word64(..)) #else import Data.Word (Word) import GHC.Word (Word8(..), Word16(..), Word32(..), Word64(..)) #endif-import GHC.Exts (ltWord#)+import GHC.Exts (Char (..), isTrue#, leWord#, ord#, (<=#), (>=#)) 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.Real (Ratio (..)) -- | A class of types that have additional invariants defined upon them @@ -186,19 +200,22 @@ -- > = annotate d "myDouble" -- > <> annotate s "myString" class Validity a where- validate :: a -> Validation- default validate :: (Generic a, GValidity (Rep a)) =>- a -> Validation- validate = genericValidate+ validate :: a -> Validation+ default validate ::+ (Generic a, GValidity (Rep a)) =>+ a ->+ Validation+ validate = genericValidate genericValidate :: (Generic a, GValidity (Rep a)) => a -> Validation genericValidate = gValidate . from data ValidationChain- = Violated String- | Location String- ValidationChain- deriving (Show, Eq, Generic)+ = Violated String+ | Location+ String+ ValidationChain+ deriving (Show, Eq, Generic) instance Validity ValidationChain @@ -209,20 +226,25 @@ -- This type intentionally doesn't have a `Validity` instance to make sure -- you can never accidentally use `annotate` or `delve` twice. newtype Validation = Validation- { unValidation :: [ValidationChain]- } deriving (Show, Eq, Generic)+ { unValidation :: [ValidationChain]+ }+ deriving (Show, Eq, Generic) #if MIN_VERSION_base(4,11,0) instance Semigroup Validation where (Validation v1) <> (Validation v2) = Validation $ v1 ++ v2 #endif-instance Monoid Validation where- mempty = Validation []+ #if MIN_VERSION_base(4,11,0)- mappend = (<>)+instance Monoid Validation where+ mempty = Validation []+ mappend = (<>) #else- mappend (Validation v1) (Validation v2) = Validation $ v1 ++ v2+instance Monoid Validation where+ mempty = Validation []+ mappend (Validation v1) (Validation v2) = Validation $ v1 ++ v2 #endif+ -- | Declare any value to be valid in validation -- -- > trivialValidation a = seq a mempty@@ -242,9 +264,9 @@ -- > check (x < 5) "x is greater than 5" check :: Bool -> String -> Validation check b err =- if b- then mempty- else Validation [Violated err]+ if b+ then mempty+ else Validation [Violated err] -- | 'check', but with the arguments flipped declare :: String -> Bool -> Validation@@ -273,9 +295,9 @@ -- | Decorate a piecewise validation of a list with their location in the list decorateList :: [a] -> (a -> Validation) -> Validation decorateList as func = mconcat $- flip map (zip [0..] as) $ \(i, a) ->- decorate (unwords ["The element at index", show (i :: Integer), "in the list"]) $- func a+ flip map (zip [0 ..] as) $ \(i, a) ->+ decorate (unwords ["The element at index", show (i :: Integer), "in the list"]) $+ func a -- | Construct a trivially invalid 'Validation' --@@ -299,67 +321,73 @@ -- | Any tuple of things is valid if both of its elements are valid instance (Validity a, Validity b) => Validity (a, b) where- validate (a, b) =- mconcat- [ annotate a "The first element of the tuple"- , annotate b "The second element of the tuple"- ]+ validate (a, b) =+ mconcat+ [ annotate a "The first element of the tuple",+ annotate b "The second element of the tuple"+ ] -- | Any Either of things is valid if the contents are valid in either of the cases. instance (Validity a, Validity b) => Validity (Either a b) where- validate (Left a) = annotate a "The 'Left'"- validate (Right b) = annotate b "The 'Right'"+ validate (Left a) = annotate a "The 'Left'"+ validate (Right b) = annotate b "The 'Right'" -- | Any triple of things is valid if all three of its elements are valid instance (Validity a, Validity b, Validity c) => Validity (a, b, c) where- validate (a, b, c) =- mconcat- [ annotate a "The first element of the triple"- , annotate b "The second element of the triple"- , annotate c "The third element of the triple"- ]+ validate (a, b, c) =+ mconcat+ [ annotate a "The first element of the triple",+ annotate b "The second element of the triple",+ annotate c "The third element of the triple"+ ] -- | Any quadruple of things is valid if all four of its elements are valid-instance (Validity a, Validity b, Validity c, Validity d) =>- Validity (a, b, c, d) where- validate (a, b, c, d) =- mconcat- [ annotate a "The first element of the quadruple"- , annotate b "The second element of the quadruple"- , annotate c "The third element of the quadruple"- , annotate d "The fourth element of the quadruple"- ]+instance+ (Validity a, Validity b, Validity c, Validity d) =>+ Validity (a, b, c, d)+ where+ validate (a, b, c, d) =+ mconcat+ [ annotate a "The first element of the quadruple",+ annotate b "The second element of the quadruple",+ annotate c "The third element of the quadruple",+ annotate d "The fourth element of the quadruple"+ ] -- | Any quintuple of things is valid if all five of its elements are valid-instance (Validity a, Validity b, Validity c, Validity d, Validity e) =>- Validity (a, b, c, d, e) where- validate (a, b, c, d, e) =- mconcat- [ annotate a "The first element of the quintuple"- , annotate b "The second element of the quintuple"- , annotate c "The third element of the quintuple"- , annotate d "The fourth element of the quintuple"- , annotate e "The fifth element of the quintuple"- ]+instance+ (Validity a, Validity b, Validity c, Validity d, Validity e) =>+ Validity (a, b, c, d, e)+ where+ validate (a, b, c, d, e) =+ mconcat+ [ annotate a "The first element of the quintuple",+ annotate b "The second element of the quintuple",+ annotate c "The third element of the quintuple",+ annotate d "The fourth element of the quintuple",+ annotate e "The fifth element of the quintuple"+ ] -- | Any sextuple of things is valid if all six of its elements are valid-instance ( Validity a- , Validity b- , Validity c- , Validity d- , Validity e- , Validity f- ) =>- Validity (a, b, c, d, e, f) where- validate (a, b, c, d, e, f) =- mconcat- [ annotate a "The first element of the sextuple"- , annotate b "The second element of the sextuple"- , annotate c "The third element of the sextuple"- , annotate d "The fourth element of the sextuple"- , annotate e "The fifth element of the sextuple"- , annotate f "The sixth element of the sextuple"- ]+instance+ ( Validity a,+ Validity b,+ Validity c,+ Validity d,+ Validity e,+ Validity f+ ) =>+ Validity (a, b, c, d, e, f)+ where+ validate (a, b, c, d, e, f) =+ mconcat+ [ annotate a "The first element of the sextuple",+ annotate b "The second element of the sextuple",+ annotate c "The third element of the sextuple",+ annotate d "The fourth element of the sextuple",+ annotate e "The fifth element of the sextuple",+ annotate f "The sixth element of the sextuple"+ ] -- | A list of things is valid if all of the things are valid. --@@ -367,7 +395,7 @@ -- 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- validate = flip decorateList validate+ validate = flip decorateList validate #if MIN_VERSION_base(4,9,0) -- | A nonempty list is valid if all the elements are valid.@@ -380,31 +408,33 @@ , annotate es "The rest of the elements of the nonempty list" ] #endif+ -- | 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- validate Nothing = mempty- validate (Just a) = annotate a "The 'Just'"+ validate Nothing = mempty+ validate (Just a) = annotate a "The 'Just'" -- | Trivially valid instance Validity () where- validate = trivialValidation+ validate = trivialValidation -- | Trivially valid instance Validity Bool where- validate = trivialValidation+ validate = trivialValidation -- | Trivially valid instance Validity Ordering where- validate = trivialValidation+ validate = trivialValidation -- | Trivially valid instance Validity Char where- validate (C# c#) = mconcat- [ declare "The contained value is positive" $ isTrue# (ord# c# >=# 0#)- , declare "The contained value is smaller than 0x10FFFF = 1114111" $ isTrue# (ord# c# <=# 1114111#)+ validate (C# c#) =+ mconcat+ [ declare "The contained value is positive" $ isTrue# (ord# c# >=# 0#),+ declare "The contained value is smaller than 0x10FFFF = 1114111" $ isTrue# (ord# c# <=# 1114111#) ] validateCharNotUtf16SurrogateCodePoint :: Char -> Validation@@ -414,68 +444,84 @@ isUtf16SurrogateCodePoint :: Char -> Bool isUtf16SurrogateCodePoint c = ord c .&. 0x1ff800 == 0xd800 +validateCharNotLineSeparator :: Char -> Validation+validateCharNotLineSeparator c =+ declare "The character is not a line separator" $ not $ isLineSeparator c++isLineSeparator :: Char -> Bool+isLineSeparator c = case c of+ '\n' -> True+ '\r' -> True+ _ -> False++validateStringSingleLine :: String -> Validation+validateStringSingleLine s = decorateList s validateCharNotLineSeparator++isSingleLine :: String -> Bool+isSingleLine = not . any isLineSeparator+ -- | Trivially valid instance Validity Int where- validate = trivialValidation+ validate = trivialValidation -- | NOT trivially valid on GHC because small number types are represented using a 64bit structure underneath. instance Validity Int8 where- validate (I8# i#) =- mconcat- [ declare "The contained integer is smaller than 2^7 = 128" $ isTrue# (i# <# 128#)- , declare "The contained integer is greater than or equal to -2^7 = -128" $ isTrue# (i# >=# -128#)- ]+ validate (I8# i#) =+ mconcat+ [ declare "The contained integer is smaller than 2^7 = 128" $ isTrue# (i# <=# 127#),+ declare "The contained integer is greater than or equal to -2^7 = -128" $ isTrue# (i# >=# -128#)+ ] -- | NOT trivially valid on GHC because small number types are represented using a 64bit structure underneath. instance Validity Int16 where- validate (I16# i#) =- mconcat- [ declare "The contained integer is smaller than 2^15 = 32768" $ isTrue# (i# <# 32768#)- , declare "The contained integer is greater than or equal to -2^15 = -32768" $ isTrue# (i# >=# -32768#)- ]+ validate (I16# i#) =+ mconcat+ [ declare "The contained integer is smaller than 2^15 = 32768" $ isTrue# (i# <=# 32767#),+ declare "The contained integer is greater than or equal to -2^15 = -32768" $ isTrue# (i# >=# -32768#)+ ] -- | NOT trivially valid on GHC because small number types are represented using a 64bit structure underneath. instance Validity Int32 where- validate (I32# i#) =- mconcat- [ declare "The contained integer is smaller than 2^31 = 2147483648" $ isTrue# (i# <# 2147483648#)- , declare "The contained integer is greater than or equal to -2^31 = -2147483648" $ isTrue# (i# >=# -2147483648#)- ]+ validate (I32# i#) =+ mconcat+ [ 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#)+ ] -- | Trivially valid instance Validity Int64 where- validate = trivialValidation+ validate = trivialValidation -- | Trivially valid instance Validity Word where- validate = trivialValidation+ validate = trivialValidation -- | NOT trivially valid on GHC because small number types are represented using a 64bit structure underneath. instance Validity Word8 where- validate (W8# w#) =- declare "The contained integer is smaller than 2^8 = 256" $ isTrue# (w# `ltWord#` 256##)+ validate (W8# w#) =+ declare "The contained integer is smaller than 2^8 = 256" $ isTrue# (w# `leWord#` 255##) -- | NOT trivially valid on GHC because small number types are represented using a 64bit structure underneath. instance Validity Word16 where- validate (W16# w#) =- declare "The contained integer is smaller than 2^16 = 65536" $ isTrue# (w# `ltWord#` 65536##)+ validate (W16# w#) =+ declare "The contained integer is smaller than 2^16 = 65536" $ isTrue# (w# `leWord#` 65535##) -- | NOT trivially valid on GHC because small number types are represented using a 64bit structure underneath. instance Validity Word32 where- validate (W32# w#) =- declare "The contained integer is smaller than 2^32 = 4294967296" $ isTrue# (w# `ltWord#` 4294967296##)+ validate (W32# w#) =+ declare "The contained integer is smaller than 2^32 = 4294967296" $ isTrue# (w# `leWord#` 4294967295##) -- | Trivially valid instance Validity Word64 where- validate = trivialValidation+ validate = trivialValidation -- | Trivially valid: instance Validity Float where- validate = trivialValidation+ validate = trivialValidation -- | Trivially valid: instance Validity Double where- validate = trivialValidation+ validate = trivialValidation validateNotNaN :: RealFloat a => a -> Validation validateNotNaN d = declare "The RealFloat is not NaN." $ not (isNaN d)@@ -505,7 +551,7 @@ gcdOverflows = g < 0 n' :% d' = (n `quot` g) :% (d `quot` g) valueIsNormalised = n' :% d' == n :% d- in not gcdOverflows && valueIsNormalised+ in not gcdOverflows && valueIsNormalised -- | Trivially valid --@@ -516,7 +562,8 @@ -- assuming that an 'Integer' is always valid. -- Even though this is not technically sound, it is good enough for now. instance Validity Integer where- validate = trivialValidation+ validate = trivialValidation+ #if MIN_VERSION_base(4,8,0) -- | Valid according to 'isValidNatural' --@@ -524,53 +571,54 @@ instance Validity Natural where validate = declare "The Natural is valid." . isValidNatural #endif+ -- | Valid if the contained numbers are valid and the denominator is -- strictly positive. instance (Validity a, Ord a, Num a, Integral a) => Validity (Ratio a) where- validate r@(n :% d) =- mconcat- [ annotate n "The numerator"- , annotate d "The denominator"- , declare "The denominator is strictly positive." $ d > 0- , validateRatioNormalised r- ]+ validate r@(n :% d) =+ mconcat+ [ annotate n "The numerator",+ annotate d "The denominator",+ declare "The denominator is strictly positive." $ d > 0,+ validateRatioNormalised r+ ] -- | Valid according to the contained 'Integer'. instance HasResolution a => Validity (Fixed a) where- validate (MkFixed i) = validate i+ validate (MkFixed i) = validate i annotateValidation :: Validation -> String -> Validation annotateValidation val s =- case val of- Validation errs -> Validation $ map (Location s) errs+ case val of+ Validation errs -> Validation $ map (Location s) errs class GValidity f where- gValidate :: f a -> Validation+ gValidate :: f a -> Validation instance GValidity U1 where- gValidate = trivialValidation+ gValidate = trivialValidation instance GValidity V1 where- gValidate = trivialValidation+ gValidate = trivialValidation instance (GValidity a, GValidity b) => GValidity (a :*: b) where- gValidate (a :*: b) = gValidate a `mappend` gValidate b+ gValidate (a :*: b) = gValidate a `mappend` gValidate b instance (GValidity a, GValidity b) => GValidity (a :+: b) where- gValidate (L1 x) = gValidate x- gValidate (R1 x) = gValidate x+ gValidate (L1 x) = gValidate x+ gValidate (R1 x) = gValidate x instance (GValidity a, Datatype c) => GValidity (M1 D c a) where- gValidate m1 = gValidate (unM1 m1)+ gValidate m1 = gValidate (unM1 m1) instance (GValidity a, Constructor c) => GValidity (M1 C c a) where- gValidate m1 = gValidate (unM1 m1) `annotateValidation` conName m1+ gValidate m1 = gValidate (unM1 m1) `annotateValidation` conName m1 instance (GValidity a, Selector c) => GValidity (M1 S c a) where- gValidate m1 = gValidate (unM1 m1) `annotateValidation` selName m1+ gValidate m1 = gValidate (unM1 m1) `annotateValidation` selName m1 instance (Validity a) => GValidity (K1 R a) where- gValidate (K1 x) = validate x+ gValidate (K1 x) = validate x -- | Check whether a value is valid. isValid :: Validity a => a -> Bool@@ -585,15 +633,15 @@ -- | Construct a valid element from an unchecked element constructValid :: Validity a => a -> Maybe a constructValid p =- if isValid p- then Just p- else Nothing+ if isValid p+ then Just p+ else Nothing -- | Construct a valid element from an unchecked element, throwing 'error' -- on invalid elements. constructValidUnsafe :: (Show a, Validity a) => a -> a constructValidUnsafe p =- fromMaybe (error $ show p ++ " is not valid") $ constructValid p+ fromMaybe (error $ show p ++ " is not valid") $ constructValid p -- | validate a given value. --@@ -605,15 +653,15 @@ -- display these 'ValidationChain's to a user. checkValidity :: Validity a => a -> Either [ValidationChain] a checkValidity a =- case validate a of- Validation [] -> Right a- Validation errs -> Left errs+ case validate a of+ Validation [] -> Right a+ Validation errs -> Left errs -- | Check if a 'Validation' concerns a valid value. validationIsValid :: Validation -> Bool validationIsValid v = case v of- Validation [] -> True- _ -> False+ Validation [] -> True+ _ -> False -- | Validate a given value --@@ -622,23 +670,23 @@ -- 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+ 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+ 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 errCascade errList =- intercalate "\n" $+ intercalate "\n" $ flip map (zip [0 ..] errList) $ \(i, segment) ->- case i of- 0 -> segment- _ -> replicate i ' ' ++ "\\ " ++ segment+ case i of+ 0 -> segment+ _ -> replicate i ' ' ++ "\\ " ++ segment
test/Data/ValiditySpec.hs view
@@ -98,6 +98,24 @@ prettyValidation (validateCharNotUtf16SurrogateCodePoint 'a') `shouldSatisfy` isNothing it "Says that \\55810 is an invalid char" $ prettyValidation (validateCharNotUtf16SurrogateCodePoint '\55810') `shouldSatisfy` isJust+ describe "Lines" $ do+ describe "isLineSeparator" $ do+ it "Says that a is not a line separator" $ isLineSeparator 'a' `shouldBe` False+ it "Says that '\\n' is a line separator " $ isLineSeparator '\n' `shouldBe` True+ it "Says that '\\r' is a line separator " $ isLineSeparator '\r' `shouldBe` True+ describe "validateCharNotLineSeparator" $ do+ it "Says that a is not a line separator" $+ prettyValidation (validateCharNotLineSeparator 'a') `shouldSatisfy` isNothing+ it "Says that '\\n' is a line separator" $+ prettyValidation (validateCharNotLineSeparator '\n') `shouldSatisfy` isJust+ it "Says that '\\r' is a line separator" $+ prettyValidation (validateCharNotLineSeparator '\r') `shouldSatisfy` isJust+ describe "isSingleLine" $ do+ it "says that \"abc\" is a single line" $ isSingleLine "abc" `shouldBe` True+ it "says that \"d\ne\" is a single line" $ isSingleLine "d\ne" `shouldBe` False+ describe "validateStringSingleLine" $ do+ it "says that \"abc\" is a single line" $ prettyValidation (validateStringSingleLine "abc") `shouldSatisfy` isNothing+ it "says that \"d\ne\" is a single line" $ prettyValidation (validateStringSingleLine "d\ne") `shouldSatisfy` isJust describe "Ratio" $ do it "says that 0 is valid" $ NormalisedRatio (0 :% 1 :: Ratio Int) `shouldSatisfy` isValid it "says that 1 is valid" $ NormalisedRatio (1 :% 1 :: Ratio Int) `shouldSatisfy` isValid
validity.cabal view
@@ -1,13 +1,11 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.33.0.+-- This file has been generated from package.yaml by hpack version 0.34.4. -- -- see: https://github.com/sol/hpack------ hash: 6e3da519f8ddc7a538070f618f28ca85aa221ce124f13eae8d806fe81e827a0e name: validity-version: 0.11.0.0+version: 0.11.0.1 synopsis: Validity typeclass description: For more info, see <https://github.com/NorfairKing/validity the readme>. .@@ -37,7 +35,7 @@ bug-reports: https://github.com/NorfairKing/validity/issues author: Tom Sydney Kerckhove maintainer: syd@cs-syd.eu-copyright: Copyright: (c) 2016-2020 Tom Sydney Kerckhove+copyright: Copyright: (c) 2016-2021 Tom Sydney Kerckhove license: MIT license-file: LICENSE build-type: Simple@@ -54,10 +52,9 @@ Paths_validity hs-source-dirs: src+ ghc-options: -Wno-redundant-constraints build-depends: base >=4.7 && <5- if impl(ghc >=8.0.0)- ghc-options: -Wno-redundant-constraints default-language: Haskell2010 test-suite validity-test