contracheck-applicative (empty) → 0.1.0.0

raw patch · 7 files changed

+780/−0 lines, 7 filesdep +basedep +bytestringdep +containerssetup-changed

Dependencies added: base, bytestring, containers, contravariant, mmorph, text

Files

• ChangeLog.md +3/−0
• LICENSE +30/−0
• README.md +202/−0
• Setup.hs +2/−0
• contracheck-applicative.cabal +40/−0
• src/Control/Validation/Check.hs +298/−0
• src/Control/Validation/Class.hs +205/−0

@@ -0,0 +1,3 @@+# Changelog for contracheck-applicative++## Unreleased changes

@@ -0,0 +1,30 @@+Copyright Fabian Birkmann (c) 2020++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Fabian Birkmann nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,202 @@+contracheck-applicative+=======================++This package provides some simple yet useful types and functions to dynamically check properties of your data.++Why use this library?+---------------------++Runtime-checking for properties of data is the poor mans parsing. Nonetheless, sometimes it has do be done, and most of the time is not really pretty.++Most validation libraries define validations to be a type like `a -> Either Text a`, which makes sense as it captures the essence of validations: Put something in, and you either get it back and know your data is alright, or you have an error to work with. But the type `a -> Either Text a` does not behave nicely:+* On the type level it does not distinguish between unvalidated and validated values.+* Validations are not combinable: There is not canonical monoid instance+* Validations are not reusable:   It is invariant in that is neither co- nor contravarian.+* Validations are not composable: There is no canonical way to combine a pair of validations `(a -> Either Text a, b -> Either Text b)` to a validation `(a, b) -> Either Text (a, b)`++This library attempts to fix these issues.++Quickstart+----------++++A `Check` is a function that takes an `Unvalidated` value and returns the result, possibly with a context: If the inpu has `Passed` the check or `Failed` it with a number of possible errors.+```haskell+newtype Unvalidated a = Unvalidated { unsafeValidate :: a } ++data CheckResult +	= Passed+	| Failed (Seq a)+	+newtype Check  e m a = Check { runCheck :: Unvalidated a -> m (CheckResult e) }+type    Check' e = Check e Identity+```+++Unvalidated+-----------+The `Unvalidated` newtype is to make a distinction between validated and unvalidated values on the type level. It is often convient to give an orphan instance for the typeclass of your choice via `-XStandaloneDeriving` so unvalidated data cannot get into your system, e.g.+```haskell+{-# language StandaloneDeriving, GeneralizedNewtypeDeriving, DerivingStrategies #-}+import Data.Aeson(FromJSON)+deriving newtype instance (FromJSON a) => FromJSON (Unvalidated a)+```++CheckResult+-----------+It has a monoid instance so it collects all possible errors, that is, it is not lazy in its failure component.+++Basically all this library does is provide convenient instances for these types.+++Check+-----++To start off lets give some simple examples. We construct `Check`s using the auxiliary combinators+* `failsWith :: e -> CheckResult e`+* `failsNoMsg :: CheckResult e`+* `checking' :: (a -> CheckResult e) -> Check' e a`+* `test' :: Applicative m => (a -> Bool) -> (a -> e) -> Check e m a`++```haskell+import Data.Char(isAlpha)++checkEven :: Check' String Int+checkEven = test +	          ((== 0) . (`mod` 2)) +			  (mappend "Number not even: " . show)+			  +type Age = Int+checkAge = test' (< 18) failsNoMsg++type Name = String+checkName = test $ \name -> +	let invalidChars = filter (not . isAlpha) name+	in if null invalidChars+		 then Passed+		 else failsWith invalidChars+```+There are some other combinators to construct checks in various flavours.+You can run the checks using `validateBy'` if you want to use the validated result or just by `runCheck` if you just want to know if your input passed the check (or which errors occured).++Composition+-----------++The `Check` type is contravariant in the parameter to be checked (in fact, the whole library is merely a big wrapper around the instancess for the type classes from the package [contravariant](https://www.stackage.org/package/contravariant)). This tells us that we can "pull back" checks to other types:++```haskell+checkOdd = contramap (+1) checkEven+```++So if we have a `Check` for an `a` and know how to convert a `b` into an `a` that preserves the property to be checked, we get a `Check` for our `b` for free. You can also pull back a pair of checks to a product/sum of types (`(,)/Either`) using `divide/choose` from the type classes `Divisible/Decidable` (also defined in the package [contravariant](https://www.stackage.org/package/contravariant)). We show how to use them by lifting a `Check` for an `a` to a `Check` for a list of `a`s:++```haskell+checkListBy :: Check' e a -> Check' e [a]+checkListBy checkA =+  choose split checkNil checkCons+  where+    splitSum [] = Left ()+    splitSum (x:xs) = Right (x, xs)+	checkNil = mempty+	checkCons = divide id checkA (checkListBy checkA)+```	+To check a `[a]` we have to distinguish two cases (`split`); either it is empty (`Left ()`), then we apply the trivial check `checkNil` or it is a cons, then we apply the check to the head and check the rest of the list.++To summarize, from _contravariant_ we use (with Types specialized to `Check`):+* `contramap` (≡ `>$<`): `(b -> a) -> Check e m a -> Check e m b`+* `divide :: (a -> (b, c)) -> Check e m b -> Check e m c -> Check e m a`+* `choose :: (a -> Either b c) -> Check e m b -> Check e m c -> Check e m a`++Combination+-----------++But now you want to combine your checks, e.g. to check a registration form. A first attempt might be to use the monoid instance of `CheckResult`. Note that it collects all errors and does not short-circuit if a `Check` fails (as you do not want to be that guy that sends the registration form back twenty times with different errors). But fortunately the `Monoid`-instance of `CheckResult` lifts to `Checks`! That means we can use the `Semigroup/Monoid` operations on `Checks`, (`mempty` being the trivial `Check` that always succeeds).+```haskell+data Registration = Registration +	{ registrationAge :: Age+	, registrationName :: Name+	, registrationEmail :: String +	} +checkRegistration +	=  contramap registrationAge   checkAge +	<> contramap registrationName  checkName+	<> contramap registrationEmail mempty -- of course unneccessary as it does nothing, but here for completeness+```++Additional Context+------------------++Sometimes you need to check properties, but the check itself has a sideeffict e.g. making a HTTP request or reading from a database. This is no problem, as +1. `Check`s may have a context (remember that `Check' e a ≡ Check e Identity a`, a `Check` with a trivial context).+2. We can easily convert our checks between context as `Check`s are an instance of `MFunctor` from the package [mmorph](https://www.stackage.org/package/mmorph).+3. We are all good as long as the context is an `Applicative` as then the monoid instance of `CheckResult e` lifts to `m CheckResult e`.++Let's give an example. Say you let users store URLs in a database, but for their convience you do not accept broken links.++```haskell+import Network.HTTP.Client+import Network.HTTP.Types.Status(Status, statusCode)+import Network.HTTP.Client.TLS(newTlsManager)+import Control.Concurrent.Async(concurrently)+import Control.Validation.Check+import Control.Monad.Morph(MFunctor(..), generalize)++newtype Url = Url { getUrl ∷  String  }+        deriving (Show, Eq, IsString)++checkUrlNo4xx ∷ Check Status IO Url                 +checkUrlNo4xx = checking $ \url →  do+  m ← newTlsManager+  req ← parseRequest . getUrl $ url+  res ← httpLbs req m+  let stat =  (responseStatus res) ∷Status+	  code = statusCode stat+  pure $ if code < 400 || code >= 500+     then  Passed+     else  failsWith stat+```++But now you allow your users to store several links, Facbook LinkedIn, Twitter and whatnot. With `foldWithCheck`/`traverseWithCheck` you can lift checks to arbitary instances of `Foldable` or `Traversable`:+foldWithCheck :: (Foldable f, Applicative m) => Check e m a -> Check e m (f a)+traverseWithCheck :: (Traversable t, Applicative m) => Check e m a -> Check e m (t a)++```haskell+type UrlList =  [ Url ] +checkUrlList :: Check Status IO [Url]+checkUrlList = traverseWithCheck checkUrlNo4xx +```+Thats all there is. Since it is that easy to generalize, `Check`s for foldables/traversable are ommited.++Well, its not really performant, as the `Url`s are checked in sequence; so to check 10 `Url`s you need about 10 seconds. We can fix that by giving `IO` a "parallel" `Applicative` instance that performs all chained `(<*>)` in parallel:+```haskell+newtype ParIO a = ParIO { runParIO :: IO a } deriving Functor++instance Applicative ParIO where+    pure = ParIO . pure+    ParIO iof <*> ParIO iox = ParIO $ (\(f, x) -> f x) <$> concurrently iof iox+```+As we do not want to change the implementation of `checkUrlNo4xx` since it is fine, we can use `hoist`  to lift the check to a context that is executed in parallel:+```haskell +-- hoist :: Monad m => (forall a. m a -> n a) -> Check e m a -> Check e n a+-- ParIO :: forall a. IO a -> ParIO a+checkUrlListPar :: Check Status ParIO [Url]+checkUrlListPar = traverseWithCheck (hoist ParIO checkUrlNo4xx)+```+_Warning_: +```haskell+checkUrlListParWrong = hoist ParIO checkUrlList+```+does *NOT* work as here you lift into the parallel context after all the checks have been performed.++Thats about it. ++Checkable typeclass+------------------+There is also a typeclass in Control.Validation.Class, but it has to be used with care as it does not perform any Checks on primitive types and this is often not what you want. You should probably use it only on nested structures made up solely from custom data types.+++++

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,40 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.31.2.+--+-- see: https://github.com/sol/hpack+--+-- hash: 40a504900d2d86420b905563905e389930e4d321161a55c7ebb2d9c0d6d1c933++name:           contracheck-applicative+version:        0.1.0.0+synopsis:       Validation types/typeclass based on the contravariance.+description:    This package provides types and a typeclass that allow for effectful validation and easy composition. For documentation see the (README)[https://gitlab.com/Birkmann/validation-check/-/blob/master/README.md]. If there are any issues, contact me at 99fabianb@sis.gl.+category:       Validation+author:         Fabian Birkmann+maintainer:     99fabianb@sis.gl+copyright:      2020 Fabian Birkmann+license:        BSD3+license-file:   LICENSE+build-type:     Simple+extra-source-files:+    README.md+    ChangeLog.md++library+  exposed-modules:+      Control.Validation.Check+      Control.Validation.Class+  other-modules:+      Paths_contracheck_applicative+  hs-source-dirs:+      src+  ghc-options: -Wall -Wcompat -Wincomplete-patterns -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints -Wpartial-fields+  build-depends:+      base >=4.7 && <5+    , bytestring >=0.10.10 && <0.11+    , containers >=0.6.2 && <0.7+    , contravariant >=1.5.2 && <1.6+    , mmorph >=1.1.3 && <1.2+    , text >=1.2.4 && <1.3+  default-language: Haskell2010

@@ -0,0 +1,298 @@+{-|+Module      : Validation+Description : Validation types/typeclass that allow for effectful validation and easy composition.+Copyright   : (c) Fabian Birkmann 2020+License     : GPL-3+Maintainer  : 99fabianb@sis.gl+Stability   : experimental+Portability : POSIX++Types and functions to check properties of your data. To make best use of these functions you should check out "Data.Functor.Contravariant". For documentation see the (README)[https://gitlab.com/Birkmann/validation-check/-/blob/master/README.md].+-}+{-# LANGUAGE + PolyKinds, TypeOperators, LambdaCase, + DerivingStrategies, DerivingVia, StandaloneDeriving, GeneralizedNewtypeDeriving, DeriveFunctor, DeriveGeneric+ #-}+module Control.Validation.Check(+    -- * Unvalidated values+    -- $unvalidated+    --+    Unvalidated(..), unvalidated,++    -- * Types for checks+    --++    -- ** Check results+    -- $checkResults+    -- +    CheckResult(..),+    checkResult, failsWith, failsNoMsg,  passed, failed, checkResultToEither,++    -- ** The Check type+    -- $check+    --+    Check(..), Check', +    passOnRight, mapError, generalizeCheck,+    validateBy, validateBy',++    -- *** Constructing checks+    -- $constructingChecks+    --+    checking, checking',+    test,  (?~>),+    test', (?>),  +    test_, (?~>>), +    test'_,(?>>),+    -- ** Helper for deriving Checkable+    -- $derivHelper+    foldWithCheck, traverseWithCheck, ++    -- * Reexports+    hoist, contramap++) where++import           Data.Kind (Type)+import           GHC.Generics (Generic)++import           Control.Monad.Morph (MFunctor(..))+import           Data.Functor ((<&>))+import           Data.Functor.Contravariant (Contravariant(..), Op(..))+import           Data.Functor.Contravariant.Divisible (Divisible(..), Decidable(..))+import           Data.Functor.Identity (Identity(..))++import           Data.Foldable (fold)+import           Data.Monoid (Ap(..))+++import           Data.Sequence (Seq)+import qualified Data.Sequence as Seq(singleton)++----------------------------------------------------------------------------------+-- = 'Unvalidated'+-- $unvalidated+-- A newtype around unvalidated values so one cannot use the value until it is validated. +-- You can create an 'Unvalidated' via 'unvalidated', but it is often more convient +-- If for example you have a JSON api and want to validate incoming data, you can +-- write (using `-XStandaloneDeriving, -XDerivingStrategies, -XDerivingVia`):+--+-- > import Data.Aeson(FromJSON)+-- > deriving via (a :: Type) instance (FromJSON a) => FromJSON (Unvalidated a)+newtype Unvalidated (a :: Type) = +    Unvalidated { unsafeValidate :: a } +    deriving (Eq, Ord, Show, Functor, Generic)++{-# INLINE unvalidated #-}+unvalidated :: a -> Unvalidated a+unvalidated = Unvalidated++++++----------------------------------------------------------------------------------+-- = Types for checks++-- == Check results+-- $checkResults+-- The result of (possibly many) checks. It is either valid or a sequence of +-- all the errors that occurred during the check.+-- The semigroup operation is eager to collect all possible erros.++data CheckResult (e :: Type)+    = Passed+    | Failed (Seq e)+    deriving (Show, Eq, Generic, Functor)++instance Semigroup (CheckResult e) where+    Passed <> x = x+    Failed s1 <> Passed = Failed s1+    Failed s1 <> Failed s2 = Failed (s1 <> s2)++instance Monoid (CheckResult e) where+    mempty = Passed++failsWith :: e -> CheckResult e+failsWith = Failed . Seq.singleton++-- | Throwing an error without a message.+failsNoMsg :: CheckResult e+failsNoMsg = Failed mempty++-- | A fold for 'CheckResult'+checkResult :: a -> (Seq e -> a) -> CheckResult e -> a+checkResult x _ Passed = x+checkResult _ f (Failed e) = f e++passed, failed :: CheckResult e -> Bool+passed = checkResult True (const False)+failed = checkResult False (const True)+++checkResultToEither :: a -- ^ default value+                    -> CheckResult e+                    -> Either (Seq e) a+checkResultToEither x = checkResult (Right x) Left+++++----------------------------------------------------------------------------------+-- ** The Check type+-- $check+-- The type of a (lifted) check. A 'Check' takes an unvalidated data and produces +-- a 'CheckResult'. It may need an additional context `m`. If the context is trivial+-- (`m ≡ Identity`) helper types/functions are prefixed by a `'`.+-- A 'Check' is not a validation function, as it does not produce any values +-- (to validated data using a 'Check' use 'validateBy'). The reason for this is that +-- it gives 'Check' some useful instances, as it now is contravariant in `a` +-- and not invariant in `a` like e.g. `a -> Either b a`+--+-- * Contravariant+-- +-- > newtype Even = Even { getEven :: Int }+-- > checkEven :: Check' Text Even+-- > checkEven = (== 0) . (`mod` 2) . getEven ?> mappend "Number is not even: " . show+-- >+-- > newtype Odd = Odd { getOdd :: Int }+-- > checkOdd :: Check' Text Odd+-- > checkOdd = Even . (+1) . getOdd >$< checkEven+-- +-- * Semigroup/Monoid: Allows for easy composition of checks+-- +-- > newtype EvenAndOdd = EvenAndOdd { getEvenAndOdd :: Int }+-- > checkevenAndOdd :: Check' Text EvenAndOdd+-- > checkEvenAndOdd = contramap (Even . getEvenAndOdd) checkEven+-- >                   <> contramap (Odd . getEvenAndOdd) checkOdd+-- +-- * MFunctor: Changing the effect+-- +-- > import Data.List(isPrefixOf)+-- > newtype Url = Url { getUrl :: String }+-- >+-- > check404 :: Check () IO Url -- checks if the url returns 404+-- >+-- > checkHttps :: Check' () Identity Url+-- > checkHttps = ("https" `isPrefixOf`) ?>> ()+-- >+-- > checkUrl :: Check () IO Url+-- > checkUrl = check404 <> hoist generalize checkHttps+--+-- For more information see the README.++newtype Check (e :: Type) (m :: Type -> Type) (a :: Type) +    = Check { runCheck :: Unvalidated a -> m (CheckResult e) }+        deriving ( Monoid, Semigroup ) via (a -> Ap m (CheckResult e))+        deriving ( Contravariant, Divisible, Decidable) via (Op (Ap m (CheckResult e)))+withCheck :: ( (Unvalidated a -> m (CheckResult d))     +             -> Unvalidated b -> n (CheckResult e))+             -> Check d m a -> Check e n b+withCheck f = Check . f . runCheck+++-- | Validate 'Unvalidated' data using a check.+validateBy :: Functor m => Check e m a -> Unvalidated a -> m (Either (Seq e) a)+validateBy c u@(Unvalidated x) = fmap (checkResultToEither x) . runCheck c $ u++validateBy' :: Check' e a -> Unvalidated a -> Either (Seq e) a+validateBy' c = runIdentity . validateBy c++type Check' e = Check e Identity++instance MFunctor (Check e) where+    hoist f = withCheck (f .)+++generalizeCheck :: Applicative m => Check' e a -> Check e m a+generalizeCheck = hoist (pure . runIdentity)++-- | 'passOnRight `ignoreWhen` `check` lets the argument pass when +-- `ignoreWhen` returns `Nothing` and otherwise checks +-- with `check`. It is a special case of 'choose' from 'Decidable'.+-- It gives an example for how 'Check's expand to other datatypes since they are+-- 'Divisible' and 'Decidable', see generalizing a check to lists:+-- >+-- > checkList :: Applicative m => Check e m a -> Check e m [a]+-- > checkList c = passOnRight (\case+-- >                             [] -> Right ()+-- >                             x:xs -> Left (x, xs))+-- >                           ( divide id c (checkList c))+passOnRight :: Applicative m => (a -> Either b ()) -> Check e m b -> Check e m a+passOnRight f c = choose f c mempty++-- | Mapping over the error type.+mapError :: Functor m => (e -> e') -> Check e m a -> Check e' m a+mapError f = withCheck (fmap (fmap f) .)+++++------------------------------------------------------------------------------------------------------+-- === Construction of 'Check's+-- $constructingChecks+-- Constructing a check from a predicate. Naming conventions: +--+-- * Functions that work on trivial contexts are prefixed by an apostrophe `'`.+-- * Check constructors that discard the argument on error end with `_`.+-- * All infix operators start with `?` and end with `>` (So `?>` is the "normal" version).+-- * Additional >: discards its argument: `?>>`, `?~>>`.+-- * Tilde works with non-trivial contexts: `?~>`, `?~>>`.++checking :: (a -> m (CheckResult e)) -> Check e m a+checking = Check . (. unsafeValidate)++checking' :: (a -> CheckResult e) -> Check' e a+checking' = checking . (Identity .)+++test', (?>) :: Applicative m => (a -> Bool) -> (a -> e) -> Check e m a +test' p onErr = Check $ \(Unvalidated x) -> pure $ if p x +    then Passed+    else failsWith (onErr x)+infix 7 `test'`+{-# INLINE (?>) #-}+(?>) = test'+infix 7 ?>+++-- +-- > test'_ p e = test' p onErr+-- >   where onErr = const e+{-# INLINE test'_ #-}+test'_,(?>>) :: Applicative m => (a -> Bool) -> e -> Check e m a +test'_ p = test' p . const +infix 7 `test'_`+{-# INLINE (?>>) #-}+(?>>) = test'_+infix 7 ?>>++test, (?~>) :: Functor m => (a -> m Bool) -> (a -> e) -> Check e m a +test p onErr = Check $ \(Unvalidated x) -> p x <&> \case+    True  -> Passed+    False -> failsWith . onErr $ x+infix 7 `test`+{-# INLINE (?~>) #-}+(?~>) = test+infix 7 ?~>++-- > test_ p e = test p onErr+-- >   where onErr = const e+{-# INLINE test_ #-}+test_, (?~>>) :: Monad m => (a -> m Bool) -> e -> Check e m a +test_ p = test p . const +infix 7 `test_`+{-# INLINE (?~>>) #-}+(?~>>) = test_+infix 7 ?~>>+ ++-- | Lifting checks+foldWithCheck :: (Foldable f, Applicative m) => Check e m a -> Check e m (f a)+foldWithCheck c = checking $ getAp . foldMap (Ap . runCheck c . unvalidated)++traverseWithCheck :: (Traversable t, Applicative m) => Check e m a -> Check e m (t a)+traverseWithCheck c = checking $ fmap fold . traverse (runCheck c . unvalidated)++++

@@ -0,0 +1,205 @@+{-# LANGUAGE + LambdaCase, DerivingStrategies, DerivingVia, StandaloneDeriving, KindSignatures, GeneralizedNewtypeDeriving,+ PolyKinds, TypeOperators,+ DefaultSignatures, InstanceSigs, MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances, FlexibleContexts, UndecidableInstances+ #-}+module Control.Validation.Class(+    -- * Checkable+    -- $checkable+    validate, validate',+    CheckChain(..), overChain, (+?+), singleChain,+    Validatable(..), +    TrivialCheck(..),++    -- ** Helper for deriving Validatable+    -- $derivHelper++    -- * Reexports+                         +) where++import Data.Foldable(fold)+import Data.Kind(Type)+import Data.Void(Void)+import Data.Int(Int8, Int16, Int32, Int64)+import Data.ByteString(ByteString)+import Data.Text(Text)    +import Control.Validation.Check+import Data.Functor.Identity(Identity(..))+import Data.Sequence(Seq)+import GHC.Generics    +import Data.Functor.Contravariant.Compose(ComposeFC(..)) +import Data.Functor.Contravariant(Contravariant(..))+import Data.Functor.Contravariant.Divisible(Divisible(..), Decidable(..))+import Control.Monad.Morph(MFunctor(..))    +------------------------------------------------------------------------------------------------------+-- $checkable+-- = The 'Validatable' typeclass. +-- /Note/: It is not inteded to be used for testing of+-- internal integrity of types, i.e. it does not check if a 'Text' has a valid internal +-- representation. For testing internal integrity please use the package+--  (validity)[https://stackage.org/package/validity].+-- The typeclass is split up into three parts: +-- +-- * 'checkChain':  A list of checks that will be performed in +-- that order. This has to be provided to give an instance.+-- For the reason why it is given as a list and the checks are +-- not combined via '(<>)', see the point for `isValid`.+--+-- * 'defaulCheck': A check performing all checks of 'checkChain'+--+-- > defaultCheck = fold checkChain+--+-- * 'isValid':     A function determining whether a value is valid.+-- This functions stops checking after the first of the checks+-- from 'checkChain' fails .This function is the reason why we+-- need the 'checkChain', as a 'Check' constructed by '(<>)'+-- goes through all operands, so `passed $ runCheck (shortCheck <> longCheck) unvalidatedInput`+-- evalutes the argument with `longCheck` even if `shortCheck` failed.+-- But if we define+-- +-- > instance Validatable e m T where+-- >   checkChain = CheckChain [ shortCheck, longCheck ]+-- +-- then `isValid unvalidatedInput` stops after `shortCheck` failed.+++newtype CheckChain (e :: Type) (m :: Type -> Type) (a :: Type) = +    CheckChain { runCheckChain :: [ Check e m a ] }+        deriving newtype ( Monoid, Semigroup ) +        deriving (Contravariant, Divisible, Decidable) via (ComposeFC [] (Check e m))++instance MFunctor (CheckChain e) where+  hoist f = overChain (hoist f)++overChain :: (Check e m a -> Check e' n b) -> CheckChain e m a -> CheckChain e' n b+overChain f = CheckChain . fmap f . runCheckChain             ++-- | Convenience synonym.+{-# INLINE (+?+) #-}+(+?+) :: CheckChain e m a -> CheckChain e m a -> CheckChain e m a +(+?+) = (<>)+infixr 5 +?+ -- so it behaves like list concatenation++{-# INLINE emptyChain #-}+emptyChain :: CheckChain e m a+emptyChain = mempty++{-# INLINE singleChain #-}             +singleChain :: Check e m a -> CheckChain e m a+singleChain x = CheckChain [ x ]+    ++-- These are the functions that make use of the typeclass:+{-# INLINABLE validate' #-}+validate' :: Validatable e Identity a => Unvalidated a -> Either (Seq e) a+validate' u@(Unvalidated x) = +    checkResultToEither x +    . runIdentity +    . runCheck defaultCheck +    $ u++{-# INLINABLE validate #-}+validate :: (Validatable e m a, Functor m) => Unvalidated a -> m (Either (Seq e) a)+validate u@(Unvalidated x) = +    fmap (checkResultToEither x)+    . runCheck defaultCheck +    $ u++++class Validatable (e :: Type) (m :: Type -> Type) (a :: Type) | a -> m, a -> e where++    checkChain :: CheckChain e m a+    default checkChain :: (Generic a, GValidatable e m (Rep a)) => CheckChain e m a+    checkChain = contramap from gCheckChain++    defaultCheck :: Check e m a+    default defaultCheck :: Applicative m => Check e m a+    defaultCheck = fold . runCheckChain $ checkChain++    isValid ::  Unvalidated a -> m Bool+    default isValid :: Applicative m => Unvalidated a -> m Bool+    isValid u = fmap (all passed) $ traverse (($ u) . runCheck) $ runCheckChain checkChain+    ++++deriving via TrivialCheck ()         instance Validatable Void Identity ()+deriving via TrivialCheck Bool       instance Validatable Void Identity Bool +deriving via TrivialCheck Char       instance Validatable Void Identity Char +deriving via TrivialCheck Double     instance Validatable Void Identity Double +deriving via TrivialCheck Float      instance Validatable Void Identity Float +deriving via TrivialCheck Int        instance Validatable Void Identity Int +deriving via TrivialCheck Int8       instance Validatable Void Identity Int8 +deriving via TrivialCheck Int16      instance Validatable Void Identity Int16 +deriving via TrivialCheck Int32      instance Validatable Void Identity Int32+deriving via TrivialCheck Int64      instance Validatable Void Identity Int64+deriving via TrivialCheck Integer    instance Validatable Void Identity Integer+deriving via TrivialCheck ByteString instance Validatable Void Identity ByteString+deriving via TrivialCheck Text       instance Validatable Void Identity Text+ +instance (Validatable e m a, Applicative m) => (Validatable e m (Maybe a)) where+    checkChain = traverseWithCheck `overChain` checkChain++instance (Validatable e m b, Validatable e m a, Applicative m) => Validatable e m (Either a b) where+    checkChain = traverseWithCheck `overChain` checkChain++instance (Validatable e m a, Applicative m) => (Validatable e m [a]) where+    checkChain = traverseWithCheck `overChain` checkChain+++------------------------------------------------------------------------------------------------------+-- $derivHelper+-- == Helper for deriving Validatable+-- Intended for use with `-XDerivingVia` like+-- +-- > data X = X Int+-- >     deriving (Validatable Void Identity) via (TrivialCheck X)+-- > -- or with `-XStandaloneDeriving`+-- > data Y = Y String+-- > deriving via (TrivialCheck Y) instance (Validatable Void Identity Y) +++newtype TrivialCheck a = TrivialCheck { unTrivialCheck :: a }++instance Validatable Void Identity (TrivialCheck a) where+    {-# INLINE checkChain #-}+    checkChain = emptyChain+    {-# INLINE defaultCheck #-}+    defaultCheck = mempty+    {-# INLINE isValid #-}+    isValid = const (Identity True)++++++------------------------------------------------------------------------------------------------------+-- The generic instance++class GValidatable (e :: Type) (m :: Type -> Type) (rep :: k -> Type) | rep -> m, rep -> e where+    gCheckChain :: CheckChain e m (rep x)++instance GValidatable Void Identity V1 where+    gCheckChain = mempty++instance GValidatable Void Identity U1 where+    gCheckChain = mempty++instance Validatable e m a => GValidatable e m  (K1 i a) where+    gCheckChain :: CheckChain e m (K1 i a x)+    gCheckChain = contramap unK1 checkChain++instance (Applicative m, GValidatable e m f, GValidatable e m g) => GValidatable e m (f :*: g) where+    gCheckChain = divide id_tup gCheckChain gCheckChain+        where id_tup (x :*: y) = (x, y)++instance (GValidatable e m f, GValidatable e m g, Applicative m) => GValidatable e m (f :+: g) where+    gCheckChain = choose id_sum gCheckChain gCheckChain+        where id_sum = \case+                L1 l -> Left l+                R1 r -> Right r++instance (GValidatable e m rep) => GValidatable e m (M1 i c rep) where+    gCheckChain = contramap unM1 gCheckChain