Skip to content

Instantly share code, notes, and snippets.

@owickstrom
Created July 1, 2019 19:37
Show Gist options
  • Save owickstrom/57f44cf4f4780aaaebc88d9959ee5d0b to your computer and use it in GitHub Desktop.
Save owickstrom/57f44cf4f4780aaaebc88d9959ee5d0b to your computer and use it in GitHub Desktop.
Defining overridable default generators for Hedgehog using Higgledy
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE TypeApplications #-}
module HiggledyHedgehog where
import Control.Lens
import Data.Generic.HKD
import GHC.Generics (Generic)
import Hedgehog
import qualified Hedgehog.Gen as Gen
import qualified Hedgehog.Range as Range
-- * Implementation
--------------------------------------------------------------------------------
data Programmer = Programmer
{ name :: String
, writesTests :: Bool
, nbrOwnedMechanicalKeyboards :: Int
} deriving (Generic, Show)
maxKeyboardOneCanOwn :: Int
maxKeyboardOneCanOwn = 10 -- I mean, seriously.
-- It's important to be a hip programmer.
hipness :: Programmer -> Double
hipness Programmer { nbrOwnedMechanicalKeyboards } =
let ratio = fromIntegral nbrOwnedMechanicalKeyboards
/ fromIntegral maxKeyboardOneCanOwn
in max 0.05 ratio
-- Less so, hired.
hired :: Programmer -> Bool
hired programmer =
-- Either you're very responsible and keep the mechanical keyboard
-- madness at a minimum.
( writesTests programmer
&& nbrOwnedMechanicalKeyboards programmer <= 3
)
-- Or you're just so hip that you'll get the job regardless.
|| hipness programmer >= 0.5
-- * Generators and Tests
--------------------------------------------------------------------------------
-- Default generator of 'Programmer' values, lifted to a HKD.
genProgrammer :: MonadGen m => HKD Programmer m
genProgrammer =
build @Programmer
(Gen.element ["Alice", "Bob", "Carol"])
Gen.bool
(Gen.integral (Range.linear 0 maxKeyboardOneCanOwn))
-- For this property we can use the default generator. The property
-- should hold for all generated 'Programmer' values.
prop_every_programmer_is_a_bit_hip = property $ do
person <- forAll (construct genProgrammer)
assert (hipness person >= 0.05)
-- The default 'genProgrammer' won't cut it for this test. We need to
-- override some generators.
prop_some_programmers_get_hired = property $ do
let genResponibleProgrammer =
genProgrammer
& field @"writesTests".~ pure True
& field @"nbrOwnedMechanicalKeyboards" .~ Gen.integral (Range.linear 0 3)
& construct
person <- forAll genResponibleProgrammer
assert (hired person)
-- Again, we need to override some things.
prop_super_hip_programmers_get_hired = property $ do
let genSuperHipProgrammer =
genProgrammer
& field @"writesTests" .~ pure False
& field @"nbrOwnedMechanicalKeyboards" .~ Gen.integral (Range.linear 5 maxKeyboardOneCanOwn)
& construct
person <- forAll genSuperHipProgrammer
assert (hired person)
@moodmosaic
Copy link

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment