Validation types/typeclass based on the contravariance.

This package provides types and a typeclass that allow for effectful validation and easy composition. For documentation see the README. If there are any issues, contact me at [email protected] or add an issue on gitlab.

contracheck-applicative

This package provides some simple yet useful types and functions to dynamically check properties of your data.

Table of contents

1. Why use this library
2. Quickstart
3. Documentation
   1. Types
      • Unvalidated
      • CheckResult
      • Check
   2. Composition of Check's
      1. Pulling back Checks
      2. Checking ADTs
      3. Combination of Check's: Checking multiple things
   3. Dealing with additional context
   4. CheckPatch: Fix your errors
   5. Checkable Typeclass

Why use this library?

Runtime-checking for properties of data is the poor man's 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 what you do when you validate input: Put something in, and you either get it back and know your data is alright, or if it is not then you have an error to return. 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 no canonical monoid instance
• Validations are not reusable: It is invariant; so it is neither co- nor contravariant.
• Validations are not composable: There is no canonical way to e.g. 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 make it pleasant to validate and more.

Quickstart

You validate your Unvalidated data by a (possibly very large Check); Either your data passed all the checks or you get a Data.Sequence.Seq of errors of type e:

validateBy' :: Check' e a -> Unvalidated a -> Either (Seq e) a
validateBy :: Functor f => Check e f a -> Unvalidated a -> f (Either (Seq e) a)

Depending on whether you need additional context f (such as IO) you should use the types functions postfixed by an apostrophe ' (otherwise the context is Identity).

To use this library you want to

1. Wrap your unvalidated data in Unvalidated by either using unvalidated :: a -> Unvalidated a or via an orphan instance if you are brave enough (see below).
2. Write your basic Checks by
   • checking' :: (a -> CheckResult e) -> Check' e a
   • or based on a predicate using the functions from the family test/?>
3. Combine them using
   • (<>) :: Check' e a -> Check' e a -> Check' e a (Check both)
   • contramap :: (b -> a) -> Check' e a -> Check' e b ("Pull back" a Check on an a to a Check on a b via a function b -> a)
   • joinMultiCheck to easily compose a check for an ADT from checks for the single fields
   • choose / divide to multiple single Checks to a Check on a sum / product if you need more flexibility
4. Run the checks via validateBy' :: Check' e a -> Unvalidated a -> Either (Seq e) a.
5. Check out CheckPatches to maybe even preprocess your data before your business logic!

type Name = String
type Age = Int

data Pet = Dog Name Age | Cat Name
  deriving (Show)

data Profile = Profile
  { _name :: Name
  , _age  :: Int
  , _pet  :: Pet
  , _otherWebsites :: [String]
  } deriving (Show)


checkNotEmpty = not . null ?>> "No name given"

checkAdult  = (>= 18) ?> printf "%s is too young; must be at least 18 years old" . show

checkHttps = ("https://" `isPrefixOf`) ?> printf "Website '%s' is not secure: Missing 'https'"

-- to do this we need
deriveGeneric ''Pet
checkPet = joinMultiCheck
  (  (checkNotEmpty :* mempty :* Nil)
  :* (checkNotEmpty :* Nil)
  :* Nil )

checkProfile :: Check' Err Profile
checkProfile 
  =  contramap _name          checkNotEmpty
  <> contramap _age           checkAdult
  <> contramap _pet           checkPet
  <> contramap _otherWebsites (foldWithCheck checkHttps) -- `foldWithCheck lifts a Check to a foldable, in this case a list`
 
-- or again using generics:
deriveGeneric ''Profile
checkProfile2 :: Check' Err Profile
checkProfile2 = joinMultiCheck $ 
  (  checkNotEmpty
  :* checkAdult
  :* checkPet
  :* foldWithCheck checkHttps
  :* Nil ) :* Nil
 
unvalidatedProfile1 = unvalidated $ 
  Profile "Fabian" 23 ["https://facebook.com/fabian"]

unvalidatedProfile2 = unvalidated $ 
  Profile "" 23 ["http://fakebok.com/eviluser"]

validateBy' checkProfile unvalidatedProfile1
-- ~> Right (Profile "Fabian" ...)

validateBy' checkProfile unvalidatedProfile2
-- -> Left (fromList ["No name given", "Website 'https://...' is not secure"])

Documentation

Let's introduce these types to work with; the deriveGeneric is only used for CheckPatches, so you can safely ignore it until you use that

type Name = String
type Age = Int
type Err = String

data Pet = Dog Name Age | Cat Name
  deriving (Show)
deriveGeneric ''Pet

data Profile = Profile
  { _name :: Name
  , _age  :: Int
  , _pet  :: Pet
  , _otherWebsites :: [String]
  } deriving (Show)
deriveGeneric ''Profile

Types

Unvalidated

newtype Unvalidated a = Unvalidated { unsafeValidate :: a } 

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 sneak into your system, so in YOUR code you could for example declare (if your api has to deal with data incoming as JSON):

{-# language StandaloneDeriving, GeneralizedNewtypeDeriving, DerivingStrategies #-}
import Data.Aeson(FromJSON)
deriving newtype instance (FromJSON a) => FromJSON (Unvalidated a)

CheckResult

data CheckResult e
	= Passed
	| Failed (Seq e)
		
	
instance Monoid CheckResult
instance Functor CheckResult

The type CheckResult a is basically Either e () with a monoid instance that collects all possible errors.

Check

newtype Check  e m a = Check { runCheck :: Unvalidated a -> m (CheckResult e) }
type    Check' e = Check e Identity

A Check is a function that takes some Unvalidated data and produces a CheckResult. Let's give some simple examples. We construct Checks using the auxiliary combinators

• For CheckResults:

• failsWith :: e -> CheckResult e (failsWith is simply the constructor Failed precomposed with Data.Sequence.Singleton)
• failsNoMsg :: CheckResult e (failsNoMsg = Failed mempty)

• For Checks (note the apostrophe at the end to indicate a "pure" Check, if you need monadic context such as IO use checking and test)

• checking' :: (a -> CheckResult e) -> Check' e a
• test' :: Applicative m => (a -> Bool) -> (a -> e) -> Check e m a

Usage (academic examples):

import Data.Char(isAlpha)

checkEven :: Check' Err Int
checkEven = test 
	          ((== 0) . (`mod` 2)) 
			  (mappend "Number not even: " . show)
			  
checkAge = test' (< 18) failsNoMsg

checkName = checking' $ \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, notably the test/(?>) family. 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 (though this is slower than it needs to be as the check collects all possible errors).

Composition of Checks

Pulling back Checks

The Check type is contravariant in the parameter to be checked (in fact, the whole library is (edit: was, until the CheckPatch functionality was added) merely a big wrapper around the instances for the type classes from the package contravariant). The Contravariant-instace allows us to "pull back" checks to other values:

-- Given a Check for an Int we can pull it back to a Check for a String
-- by suppling a function `String -> Int` (`length` in this case):
checkEvenLength :: Check' Err String
checkEvenLength = contramap length 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.

Checking ADTs

For ADTs the case is even simpler: For each constructor you give a list of Checks ─ one for each field ─ concatenated by (:*) and ended by Nil; so in total you have a nested list: A list of lists, one for each constructor, each containing the checks for the fields of that constructor, and then collapse it to a single 'Check' using 'joinMultiCheck':

checkNotEmpty = not . null ?>> "No name given"

checkAdult  = (>= 18) ?> printf "%s is too young; must be at least 18 years old" . show

checkHttps = ("https://" `isPrefixOf`) ?> printf "Website '%s' is not secure: Missing 'https'"

checkPet :: Check' Err Pet
checkPet = joinMultiCheck
  (  (checkNotEmpty :* mempty :* Nil) -- checks for the fields of the first constructor
  :* (checkNotEmpty :* Nil) -- checks for the fields of the second constructor
  :* Nil ) -- outer list is also terminated by `Nil`

checkProfile :: Check' Err Profile
checkProfile = joinMultiCheck
  (  checkNotEmpty
  :* checkAdult
  :* checkPet
  :* foldWithCheck checkHttps -- `foldWithCheck` lifts a `Check` to a `Foldable`, in this case a list 
  :* Nil ) -- only one constructor, so the outer list is a singleton list
  :* Nil

Unfortunately this way the information about which field of which constructor threw what error gets lost; the solution is mapErrorsWithInfo: It takes a function changing the error based on the datatype name, constructor name and field name. Make sure to apply it to the MultiCheck-list BEFORE applying joinMultiCheck!

addInfo :: DatatypeName -> ConstructorName -> FieldName -> (Err -> Err)
-- we are ignoring the constructorname as it is only one constructor anyway
addInfo d _ f err = printf "%s [Field %s]: %s" d f err

checkProfile :: Check' Err Profile
checkProfile = joinMultiCheck . mapErrorsWithInfo addInfo $  
  (  checkNotEmpty
  :* checkAdult
  :* checkPet
  :* foldWithCheck checkHttps
  :* Nil ) -- only one constructor, so the outer list is a singleton list
  :* Nil
  
-- $ validateBy' checkProfile (unvalidated $ Profile "" 23 (Cat "haskell") ["http://badsite.com"])
-- >>> Left (fromList ["Profile: [Field _name]: No name given", "Profile: [Field _websites]: Website ... not secure ..."])
  

Another thing that is not optimal is if you have a lot of constructors but only want to check one, e.g. for data X = A | B | C | D | E | F | Other String, the "MultiCheck"-list just gets very ugly. Fortunatley, theres a way around: constructorCheck takes the "index" of the constructor you want to check and just the list of 'Check's for this constructor; but careful, the index is counted in "unary" and is zero based:

• First constructor ~ Z
• Second constructor ~ (S . Z)
• Third constructor ~ (S . S . Z) and so on. A 'Check' for X above that only checks the Other-case for being not empty thus looks like

checkOtherField = constructorCheck (S.S.S.S.S.S.Z) (checkNotEmpty :* Nil)

If you need more granularity, you more generally can also pull back a pair of checks to an arbitrary (binary) product/sum of types ((,)/Either) using divide/choose from the type classes Divisible/Decidable (also defined in the package contravariant). We show how to use them by lifting a Check for an a to a Check for a list of as:

checkListBy :: Check' e a -> Check' e [a]
checkListBy checkA =
  choose split checkNil checkCons
  where
    split [] = Left ()
    split (x:xs) = Right (x, xs)
	checkNil = mempty -- mempty being the trivial check
	checkCons = divide id checkA (checkListBy checkA)

To check a list [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 then check the rest of the list.

Combination of Check's: Checking multiple things

If you want to combine multiple 'Check's of the same type to a larger 'Check', just use the Semigroup / Monoid instance for 'Check'. 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). The neutral element mempty is the trivial Check that always succeeds.

import Text.Printf(printf)
-- Here we use the combinaters to construct checks, if thats not your style use the 'test*' family. The precedence is so that it "just works"
checkNameInput :: Check' Err String
checkNameInput 
  =  checkNotEmpty
  <> (< 100) . length    ?>   printf "Input exeeds limit 100: %d" . length
  <> not . (';' `elem`)  ?>>  "Bad input char: ';'" 

Dealing with additional Context

Sometimes you need to check properties, but the check itself has a sideeffect e.g. making a HTTP request or reading from a database. This is no problem, as

1. Checks 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 Checks are an instance of MFunctor from the 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.

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)

type UrlList =  [Url] 
checkUrlList :: Check Status IO [Url]
checkUrlList = traverseWithCheck checkUrlNo4xx 

Thats all there is. Since it is that easy to generalize, Checks for foldables/traversable are ommited.

Well, its not really performant, as the Urls are checked in sequence. We can fix that by giving IO a "parallel" Applicative instance that performs all chained (<*>) in concurrently:

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 as it is fine on its own, but we can use hoist to lift the check to a context that is executed concurrently:

-- 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:

checkUrlListParWrong = hoist ParIO checkUrlList

does NOT work as here you lift into the parallel context after all the checks have been performed.

CheckPatch: Fix the problems that occured while checking the data

A CheckPatch e m a is like a Check e m a but for each error that happens it may contain a "patch" to fix it. Patch tries to fix its input if it can or else aborts, so it is defined simply as

newtype Patch a = Patch { runPatch :: a -> Maybe a }

Note that when you combine CheckPatches and one CheckPatch cannot patch its input (returns Nothing) then the whole CheckPatch returns Nothing. CheckPatches work mostly like Checks, the corresponding functions have a -Patch suffix (so test becomes testPatch etc.). To construct a CheckPatch you either lift an existing Check ─ with (liftPatch) or without (liftNoPatch) supplying a Patch ─ or by constructing them the same way as Checks: Via checkingPatch, testPatch etc., the only difference is that you know need to say how you want to fix your data (or if it is "unfixable"). Unfortunately, contramap, divide and choose are a little bit more complicated now: Instead of normal functions they take Lenses to split up or view inside the data. BUT the MultiCheckPatch works the same way as the normal MultiCheck.

The previous examples, but this time with CheckPatch.

-- Checks whether the string is empty (then it has NO patch, so it aborts)
-- Or if it contains semicolons, then it filters them out.
checkNotEmptyAndNoSemicolonP :: Applicative m => CheckPatch [Char] m String
checkNotEmptyAndNoSemicolonP = liftNoPatch checkNotEmpty <> checkNoSemicolonP
  where
    checkNoSemicolonP = testPatch'_
                          (not . elem ';')
                          "Input contains semicolon"
                          (patch $ filter (/= ';'))

-- Being to young cannot be patched
checkAdultP :: Applicative m => CheckPatch [Char] m Int
checkAdultP  = liftNoPatch $ checkAdult


checkPetP2 :: Applicative m => CheckPatch String m Pet
checkPetP2 = joinMultiCheckPatch
  (  (checkNotEmptyAndNoSemicolonP :* mempty :* Nil)
  :* (checkNotEmptyAndNoSemicolonP :* Nil)
  :* Nil )


checkProfileP2 :: CheckPatch String IO Profile
checkProfileP2 = constructorCheckPatch Z
  (  checkNotEmptyAndNoSemicolonP
  :* checkAdultP
  :* checkPetP2
  :* liftNoPatch checkWebsites
  :* Nil )





-- This is just to show how you would use `chooseL`; here you probably would use `joinMultiCheckPatch`, see above
--
-- To check the 'Pet', we now need "splitting" 'Lens'es instead of simple functions. A 'Lens Pet (Either (Name, Age) Age)' unfortunately is not auto-derivable,
-- but we almost always can use the fact that this lens can (and mostly _should_ be) an isomorphism.
checkPetP :: Applicative m => CheckPatch [Char] m Pet
checkPetP = chooseL splitPetLens checkDog checkCat
  where
    splitPetLens :: Lens' Pet (Either (Name, Age) Name) -- forall f. Functor f => (Either (Name, Age) Age -> f (Either (Name Age), Age)) -> Pet -> f Pet
    splitPetLens f = \case
      Dog name age -> either (uncurry Dog) Cat <$> f (Left (name, age))
      Cat name -> either (uncurry Dog) Cat <$> f (Right name)
    checkDog = divideL id checkNotEmptyAndNoSemicolonP mempty
    checkCat = checkNotEmptyAndNoSemicolonP



-- No we can wrap it up using our TemplateHaskell-derived 'Lens'es: Additionally, we throw out websites that are not https.
makeLenses ''Profile
checkProfileP :: CheckPatch String IO Profile
checkProfileP =  contramapL name checkNotEmptyAndNoSemicolonP
              <> contramapL age  checkAdultP
              <> contramapL pet  checkPetP
              <> contramapL otherWebsites (liftNoPatch  checkWebsites)

Checkable typeclass

The typeclass is deprecated as its use was very limited and is basically redundant with the new SOP-functions.