Haskell Tutorial: Validity, GenValid, Recursion Schemes, and Testing with Tasty

tutorial.md

Haskell Tutorial: Validity, GenValid, Recursion Schemes, and Testing with Tasty

This tutorial demonstrates using the validity and genvalidity packages along with recursion schemes and both property-based and unit testing using tasty-quickcheck and tasty-hunit for a simple arithmetic expression evaluator.

Setup

First, let's update our project structure:

validity-tutorial/
├── flake.nix
├── validity-tutorial.cabal
└── src/
    └── Main.hs

Let's start with flake.nix:

{
  description = "A tutorial for Haskell validity with GenValid, recursion schemes and tasty testing";

  inputs = {
    nixpkgs.url = "github:NixOS/nixpkgs/nixos-unstable";
    systems.url = "github:nix-systems/default";
    flake-parts.url = "github:hercules-ci/flake-parts";
  };

  outputs = inputs@{ flake-parts, systems, ... }:
    flake-parts.lib.mkFlake { inherit inputs; } {
      systems = import systems;
      perSystem = { config, self', pkgs, lib, system, ... }: {
        packages.default = pkgs.haskellPackages.callCabal2nix "validity-tutorial" ./. { };
        
        devShells.default = pkgs.mkShell {
          buildInputs = with pkgs.haskellPackages; [
            cabal-install
            ghc
            haskell-language-server
          ];
        };
      };
    };
}

Now, update the .cabal file:

cabal-version:      3.0
name:               validity-tutorial
version:            0.1.0.0
license:            MIT
author:             hhefesto
build-type:         Simple

executable validity-tutorial
    main-is:          Main.hs
    build-depends:    base ^>=4.16.4.0
                    , validity
                    , genvalidity
                    , recursion-schemes
                    , tasty
                    , tasty-quickcheck
                    , tasty-hunit
    hs-source-dirs:   src
    default-language: GHC2021

Now, let's create our src/Main.hs file with the updated code:

{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}

module Main where

import           Data.Functor.Foldable
import           Data.Functor.Foldable.TH
import           Data.GenValidity
import           Data.Validity
import           GHC.Generics             (Generic)
import           Test.Tasty
import           Test.Tasty.QuickCheck    as QC
import           Test.Tasty.HUnit

-- Define our sum algebra
data SumAlg = Operand Int | Plus SumAlg SumAlg
  deriving (Show, Eq, Generic)

-- Generate the recursion scheme type class instances
makeBaseFunctor ''SumAlg

-- Validity instance for SumAlg
instance Validity SumAlg where
  validate expr = case expr of
    Operand n -> check (abs n <= (maxBound :: Int) `div` 1024) "Operands must be small compared to the max Int value"
    Plus l r  -> mconcat
      [ validate l
      , validate r
      ]

-- GenValid instance for SumAlg
instance GenValid SumAlg where
  genValid = sized genValidSumAlg
    where
      smallOperand = Operand . (`div` 2048) <$> genValid
      genValidSumAlg 0 = smallOperand
      genValidSumAlg n = oneof
        [ smallOperand
        , Plus <$> genValidSumAlg (n `div` 2) <*> genValidSumAlg (n `div` 2)
        ]

-- QuickCheck Arbitrary instance using GenValid
instance Arbitrary SumAlg where
  arbitrary = genValid

-- Evaluator using recursion schemes
evalSumAlg :: SumAlg -> Int
evalSumAlg = cata algebra
  where
    algebra :: SumAlgF Int -> Int
    algebra (OperandF n) = n
    algebra (PlusF x y)  = x + y

-- Property: All generated SumAlg expressions should be valid
prop_validSumAlg :: SumAlg -> Property
prop_validSumAlg expr = property $ isValid expr

-- Property: Plus should be commutative
prop_plusCommutative :: SumAlg -> SumAlg -> Property
prop_plusCommutative a b =
  evalSumAlg (Plus a b) === evalSumAlg (Plus b a)

-- Unit Tests
unit_simpleAddition :: Assertion
unit_simpleAddition = evalSumAlg (Plus (Operand 2) (Operand 3)) @?= 5

unit_nestedAddition :: Assertion
unit_nestedAddition =
  evalSumAlg (Plus (Plus (Operand 1) (Operand 2)) (Operand 3)) @?= 6

-- Tasty test tree
tests :: TestTree
tests = testGroup "SumAlg Tests"
  [ testGroup "QuickCheck Tests"
    [ QC.testProperty "All generated expressions are valid" prop_validSumAlg
    , QC.testProperty "Plus is commutative" prop_plusCommutative
    ]
  , testGroup "Unit Tests"
    [ testCase "Simple addition" unit_simpleAddition
    , testCase "Nested addition" unit_nestedAddition
    ]
  ]

-- Main function to run examples and tests
main :: IO ()
main = do
  putStrLn "Example expressions:"
  let expr1 = Plus (Operand 5) (Operand 3)
  let expr2 = Plus (Plus (Operand 1) (Operand 2)) (Operand 3)

  putStrLn $ "Expression 1: " ++ show expr1
  putStrLn $ "Evaluation 1: " ++ show (evalSumAlg expr1)
  putStrLn $ "Validity 1: " ++ show (isValid expr1)

  putStrLn $ "\nExpression 2: " ++ show expr2
  putStrLn $ "Evaluation 2: " ++ show (evalSumAlg expr2)
  putStrLn $ "Validity 2: " ++ show (isValid expr2)

  -- Invalid expression example
  let invalidExpr = Plus (Operand (-1)) (Operand 5)
  putStrLn $ "\nInvalid expression: " ++ show invalidExpr
  putStrLn $ "Validity check: " ++ show (isValid invalidExpr)
  putStrLn $ "Validation result:\n" ++ show (prettyValidate invalidExpr)

  putStrLn "\nRunning Tasty test suite:"
  defaultMain tests

Running the Tutorial

1. Enter the development shell:

nix develop

2. Build and run the project:

cabal run