validation-based test suites

Main.hs

-- using https://hackage.haskell.org/package/validation-1.1.2/docs/Data-Validation.html#t:Validate to bundle multiple "asserts" in a same "check"

module Main where

import Control.Lens
import Prelude
import Data.Validation

type Message = String

-- primitive assertions
data Assertion
  = Equals Message
  | Differs Message
  | SmallerThan Message
  | Other Message
  deriving (Eq,Ord,Show)

-- an assert logs multiple assertions as errors
type Assert a = Validation [Assertion] a

-- lowest-level building block to bundle some check (THE Assert smart constructor)
predicate ::  Bool -> a -> Assertion -> Assert a
predicate p a x
  | p = _Success # a
  | otherwise = _Failure # [x]

-- some helpers
equalsTo :: (Show v, Eq v) => v -> v -> Assert v
equalsTo x y =
    predicate (x == y) x (Equals msg)
  where
    msg = mconcat [show x, " equals to ", show y]

differsFrom :: (Show v, Eq v) => v -> v -> Assert v
differsFrom x y =
    predicate (x /= y) x (Differs msg)
  where
    msg = mconcat [show x, " differs from ", show y]

smallerThan :: (Show v, Ord v) => v -> v -> Assert v
smallerThan x y =
    predicate (x < y) x (SmallerThan msg)
  where
    msg = mconcat [show x, " is smaller than ", show y]


-- a test-suite runner checking "assertions"
check :: (Show a) => String -> Validation [Assertion] a -> IO ()
check name v = do
  print name
  print $ v


-- example where a check output verifies three ints
data Output0 = Output0 Int Int Int
  deriving (Show, Ord, Eq)

test0 :: IO ()
test0 = do
  x <- pure 123
  y <- pure 234

  check "test0" $
   Output0 <$> x `differsFrom` 42
           <*> x `smallerThan` 1000
           <*> y `equalsTo` 234


-- example where a check output verifies two ints and a string
data Output1 = Output1 Int Int String
  deriving (Show, Ord, Eq)

test1 :: IO ()
test1 = do
  x <- pure 123
  y <- pure 234

  check "test1.1"
    $ Output1 <$> (x `differsFrom` 123)
              <*> (y `smallerThan` 234)
              <*> predicate False "false" (Other "always failing")

  check "test1.2"
    $ Output1 <$> (x `differsFrom` 1)
              <*> (y `smallerThan` 3)
              <*> predicate True "true" (Other "always succeeding")

main :: IO ()
main = do
  test0 -- one "check" with three "assertions"
  test1 -- two "checks" with one "assertion"

output.log

Test suite demo-test: RUNNING...
"test0"
Success (Output0 123 123 234)
"test1.1"
Failure [Differs "123 differs from 123",SmallerThan "234 is smaller than 234",Other "always failing"]
"test1.2"
Failure [SmallerThan "234 is smaller than 3"]