GivenWhenThen

1-readme.md

v0.3.0 of a Given-When-Then implementation for Haskell's HSpec. In similar vein to Ruby's rspec-given and Javascript's (Node's) jasmine-given.

I guess we could call it hspec-given.

If there is some interest I could package it up for Hackage. Ideas on improvements and contributions are also welcome, as I suspect I've only found a local optimum while implementing, e.g. in terms of syntax.

See here for a usage example.

Which executes like this with HSpec:

GivenWhenThen.hs

{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE NoMonomorphismRestriction #-}

module GivenWhenThen where

import            GHC.Stack                       (HasCallStack)
import            Data.IORef
import            Test.Hspec                      as Hspec
import            ComposeLTR
import            Language.Haskell.TH
import            Test.Hspec.Core.Spec            (SpecM)

noop :: Monad m => m ()
noop = return ()

given = noop
when  = noop

(#=) = writeIORef
(#~) = modifyIORef
var #=? expectation = do
  readIORef var `shouldReturn` expectation

c1 :: (a           -> b) -> (b -> c) -> (a           -> c)
c2 :: (a -> z      -> b) -> (b -> c) -> (a -> z      -> c)
c3 :: (a -> z -> y -> b) -> (b -> c) -> (a -> z -> y -> c)
c1 f g a      = f a     $> g -- = (.>)
c2 f g a b    = f a b   $> g
c3 f g a b c  = f a b c $> g


g = [|
  let
    -- f :: (Monad m, Monad m3) => m3 b -> m (m3 b)
    f cont = return $ do
      $gi
      -- if $alr
      --   then error "`given`s should come before `then_`s"
      --   else cont
      cont
   in f
  |]
  where
  gi = varE $ mkName "given"
  alr = varE $ mkName "alreadyRanAThenLine"

w = [|
  let
    f cont = return $ do
      $wh
      cont
   in f
  |]
  where
  wh = varE $ mkName "when"

then_ = [|
  let
    -- f :: HasCallStack => _
    f cont = do
      if (focusCount <= 1) then
        it "then" $ do
          $gi >> $wh
          cont
          -- (cont :: HasCallStack => _ ())
      else return ()
   in f
  |]
  where
  gi = varE $ mkName "given"
  wh = varE $ mkName "when"

thenn_ = [|
  let
    -- f :: HasCallStack => _
    f cont = do
      if (focusCount <= 2) then
        it "then" $ do
          $gi >> $wh
          cont
          -- (cont :: HasCallStack => _ ())
      else return ()
   in f
  |]
  where
  gi = varE $ mkName "given"
  wh = varE $ mkName "when"

thenn = thenn_

focusCount =
  1
  -- + 1

and = [|
  let
    f cont = do
      it "and" $ do
        cont
   in f
  |]

newUninitIORef :: HasCallStack => SpecM a (IORef a1)
newUninitIORef = Hspec.runIO $ newIORef uninit
  where
  uninit = error "Uninitialized IORef"

-- -- TODO Try setting a flag in each context to only set up Givens & Whens once per Then blocks
-- desc = [|
--   let
--     f title cont = context title $ $guard2
--    in f
--   |]
--   where
--   -- alr = varE $ mkName "alreadyRanAThenLine"
--   -- guard1 = LetS [ValD (VarP $ mkName "alreadyRanAThenLine") (NormalB (ConE GHC.Types.False)) []]
--   guard2 = return $ DoE
--     [ LetS [ValD (VarP $ mkName "alreadyRanAThenLine") (NormalB (ConE $ mkName "False")) []]
--     , NoBindS (UnboundVarE $ mkName "cont")
--     ]

GivenWhenThenSpec.hs

{-# language DoAndIfThenElse #-}
{-# language TemplateHaskell #-}
{-# language FlexibleContexts #-}
{-# language PartialTypeSignatures #-}

module GivenWhenThenSpec (spec) where

import            Prelude                    hiding (and)
import            Test.Hspec
import            Data.IORef
import            GivenWhenThen.Main

spec :: Spec
spec = do
  context "GivenWhenThen toolkit" $ do

    counter <- newUninitIORef
    given <- $g $ counter #= 0

    string <- newUninitIORef
    given <- $g $ string #= ""

    $then_ $ counter #=? 0

    context "`given`s are chained" $ do
      given <- $g $ counter #~ (+1)
      given <- $g $ counter #~ (+1)
      $then_ $ counter #=? 2
      $and   $ counter #=? 2

    context "`when`s are chained" $ do
      when  <- $w $ counter #~ (+1)
      when  <- $w $ counter #~ (+1)
      $then_ $ counter #=? 2
      $and   $ counter #=? 2

    context "`given`s and `when`s are chained" $ do
      given <- $g $ counter #= 20
      given <- $g $ counter #~ (+1)
      when  <- $w $ counter #~ (+1)
      $then_ $ counter #=? 22

    context "`given`s and `when`s are chained even if wrong order" $ do
      context "in order" $ do
        given <- $g $ string #= "a"
        given <- $g $ string #~ (++"b")
        when  <- $w $ string #~ (++"c")
        $then_ $ string #=? "abc"

      context "out of order" $ do
        given <- $g $ string #= "a"
        when  <- $w $ string #~ (++"c")
        given <- $g $ string #~ (++"b")
        $then_ $ string #=? "abc"

    context "`given` can reset the initial conditions that `when`s act on" $ do
      given <- $g $ string #= "a"
      when  <- $w $ string #~ (++"b")
      $then_ $ string #=? "ab"

      context "reset" $ do
        given <- $g $ string #= "x"
        $then_ $ string #=? "xb"

  context "GivenWhenThen manual (less sugary version of what happens above)" $ do
    counter <- newUninitIORef
    given <- return $ do given; counter #= 0
    given <- return $ do given; counter #~ (+1)

    it "then" $ do
      given
      readIORef counter `shouldReturn` 1

    $then_ $ readIORef counter `shouldReturn` 1