validation-1: test/hunit_tests.hs

{-# LANGUAGE ScopedTypeVariables #-}

module Main (main) where

import Test.HUnit

import Prelude hiding (length)
import Control.Lens ((#))
import Control.Monad (when)
import Data.Foldable (length)
import Data.Proxy (Proxy (Proxy))
import Data.Validation (Validation (Success, Failure), Validate, _Failure, _Success, ensure,
                        orElse, validate, validation, validationNel)
import System.Exit (exitFailure)

seven :: Int
seven = 7

three :: Int
three = 3

testYY :: Test
testYY =
  let subject  = _Success # (+1) <*> _Success # seven :: Validation String Int
      expected = Success 8
  in  TestCase (assertEqual "Success <*> Success" subject expected)

testNY :: Test
testNY =
  let subject  = _Failure # ["f1"] <*> _Success # seven :: Validation [String] Int
      expected = Failure ["f1"]
  in  TestCase (assertEqual "Failure <*> Success" subject expected)

testYN :: Test
testYN =
  let subject  = _Success # (+1) <*> _Failure # ["f2"] :: Validation [String] Int
      expected = Failure ["f2"]
  in  TestCase (assertEqual "Success <*> Failure" subject expected)

testNN :: Test
testNN =
  let subject  = _Failure # ["f1"] <*> _Failure # ["f2"] :: Validation [String] Int
      expected = Failure ["f1","f2"]
  in  TestCase (assertEqual "Failure <*> Failure" subject expected)

testValidationNel :: Test
testValidationNel =
  let subject  = validation length (const 0) $ validationNel (Left ())
  in  TestCase (assertEqual "validationNel makes lists of length 1" subject 1)

testEnsureLeftFalse, testEnsureLeftTrue, testEnsureRightFalse, testEnsureRightTrue,
  testOrElseRight, testOrElseLeft
  :: forall v. (Validate v, Eq (v Int Int), Show (v Int Int)) => Proxy v -> Test

testEnsureLeftFalse _ =
  let subject :: v Int Int
      subject = ensure three (const False) (_Failure # seven)
  in  TestCase (assertEqual "ensure Left False" subject (_Failure # seven))

testEnsureLeftTrue _ =
  let subject :: v Int Int
      subject = ensure three (const True) (_Failure # seven)
  in  TestCase (assertEqual "ensure Left True" subject (_Failure # seven))

testEnsureRightFalse _ =
  let subject :: v Int Int
      subject = ensure three (const False) (_Success # seven)
  in  TestCase (assertEqual "ensure Right False" subject (_Failure # three))

testEnsureRightTrue _ =
  let subject :: v Int Int
      subject = ensure three (const True ) (_Success # seven)
  in  TestCase (assertEqual "ensure Right True" subject (_Success # seven))

testOrElseRight _ =
  let v :: v Int Int
      v = _Success # seven
      subject = v `orElse` three
  in  TestCase (assertEqual "orElseRight" subject seven)

testOrElseLeft _ =
  let v :: v Int Int
      v = _Failure # seven
      subject = v `orElse` three
  in  TestCase (assertEqual "orElseLeft" subject three)

testValidateTrue :: Test
testValidateTrue =
  let subject = validate three (const True) seven
      expected = Success seven
  in  TestCase (assertEqual "testValidateTrue" subject expected)

testValidateFalse :: Test
testValidateFalse =
  let subject = validate three (const False) seven
      expected = Failure three
  in  TestCase (assertEqual "testValidateFalse" subject expected)

tests :: Test
tests =
  let eitherP :: Proxy Either
      eitherP = Proxy
      validationP :: Proxy Validation
      validationP = Proxy
      generals :: forall v. (Validate v, Eq (v Int Int), Show (v Int Int)) => [Proxy v -> Test]
      generals =
        [ testEnsureLeftFalse
        , testEnsureLeftTrue
        , testEnsureRightFalse
        , testEnsureRightTrue
        , testOrElseLeft
        , testOrElseRight
        ]
      eithers = fmap ($ eitherP) generals
      validations = fmap ($ validationP) generals
  in  TestList $ [
    testYY
  , testYN
  , testNY
  , testNN
  , testValidationNel
  , testValidateFalse
  , testValidateTrue
  ] ++ eithers ++ validations
  where

main :: IO ()
main = do
  c <- runTestTT tests
  when (errors c > 0 || failures c > 0) exitFailure