{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE GADTSyntax #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}

-- | The internal core language of expectations in HMock.
module Test.HMock.Internal.ExpectSet where

import Test.HMock.Multiplicity
  ( Multiplicity,
    between,
    feasible, meetsMultiplicity
  )

-- | A set of expected steps and their responses.  This is the "core" language
-- of expectations for HMock.  It's based roughly on Svenningsson, Svensson,
-- Smallbone, Arts, Norell, and Hughes' Expressive Semantics of Mocking.
-- However, there are a few small adjustments.  We have two repetition operators
-- which respectively represent general repetition with interleaving, and
-- consecutive repetition.  We also attach arbitrary multiplicities to
-- repetition.
data ExpectSet step where
  ExpectStep :: step -> ExpectSet step
  ExpectNothing :: ExpectSet step
  ExpectSequence :: ExpectSet step -> ExpectSet step -> ExpectSet step
  ExpectInterleave :: ExpectSet step -> ExpectSet step -> ExpectSet step
  ExpectEither :: ExpectSet step -> ExpectSet step -> ExpectSet step
  ExpectMulti :: Multiplicity -> ExpectSet step -> ExpectSet step
  ExpectConsecutive :: Multiplicity -> ExpectSet step -> ExpectSet step
  deriving (Int -> ExpectSet step -> ShowS
[ExpectSet step] -> ShowS
ExpectSet step -> String
(Int -> ExpectSet step -> ShowS)
-> (ExpectSet step -> String)
-> ([ExpectSet step] -> ShowS)
-> Show (ExpectSet step)
forall step. Show step => Int -> ExpectSet step -> ShowS
forall step. Show step => [ExpectSet step] -> ShowS
forall step. Show step => ExpectSet step -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExpectSet step] -> ShowS
$cshowList :: forall step. Show step => [ExpectSet step] -> ShowS
show :: ExpectSet step -> String
$cshow :: forall step. Show step => ExpectSet step -> String
showsPrec :: Int -> ExpectSet step -> ShowS
$cshowsPrec :: forall step. Show step => Int -> ExpectSet step -> ShowS
Show, ExpectSet step -> ExpectSet step -> Bool
(ExpectSet step -> ExpectSet step -> Bool)
-> (ExpectSet step -> ExpectSet step -> Bool)
-> Eq (ExpectSet step)
forall step. Eq step => ExpectSet step -> ExpectSet step -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExpectSet step -> ExpectSet step -> Bool
$c/= :: forall step. Eq step => ExpectSet step -> ExpectSet step -> Bool
== :: ExpectSet step -> ExpectSet step -> Bool
$c== :: forall step. Eq step => ExpectSet step -> ExpectSet step -> Bool
Eq)

-- | Checks whether an ExpectSet is in an "accepting" state.  In other words, is
-- it okay for the test to end here?  If False, then there are still
-- expectations that must be satisfied before the test can succeed.
satisfied :: ExpectSet step -> Bool
satisfied :: ExpectSet step -> Bool
satisfied (ExpectStep step
_) = Bool
False
satisfied ExpectSet step
ExpectNothing = Bool
True
satisfied (ExpectSequence ExpectSet step
e ExpectSet step
f) = ExpectSet step -> Bool
forall step. ExpectSet step -> Bool
satisfied ExpectSet step
e Bool -> Bool -> Bool
&& ExpectSet step -> Bool
forall step. ExpectSet step -> Bool
satisfied ExpectSet step
f
satisfied (ExpectInterleave ExpectSet step
e ExpectSet step
f) = ExpectSet step -> Bool
forall step. ExpectSet step -> Bool
satisfied ExpectSet step
e Bool -> Bool -> Bool
&& ExpectSet step -> Bool
forall step. ExpectSet step -> Bool
satisfied ExpectSet step
f
satisfied (ExpectEither ExpectSet step
e ExpectSet step
f) = ExpectSet step -> Bool
forall step. ExpectSet step -> Bool
satisfied ExpectSet step
e Bool -> Bool -> Bool
|| ExpectSet step -> Bool
forall step. ExpectSet step -> Bool
satisfied ExpectSet step
f
satisfied (ExpectMulti Multiplicity
mult ExpectSet step
e) =
  Multiplicity -> Bool
feasible Multiplicity
mult Bool -> Bool -> Bool
&& (Multiplicity -> Int -> Bool
meetsMultiplicity Multiplicity
mult Int
0 Bool -> Bool -> Bool
|| ExpectSet step -> Bool
forall step. ExpectSet step -> Bool
satisfied ExpectSet step
e)
satisfied (ExpectConsecutive Multiplicity
mult ExpectSet step
e) =
  Multiplicity -> Bool
feasible Multiplicity
mult Bool -> Bool -> Bool
&& (Multiplicity -> Int -> Bool
meetsMultiplicity Multiplicity
mult Int
0 Bool -> Bool -> Bool
|| ExpectSet step -> Bool
forall step. ExpectSet step -> Bool
satisfied ExpectSet step
e)

-- | Computes the live steps of the ExpectSet.  In other words: which individual
-- steps can be matched right now, and what are the remaining expectations in
-- each case?
liveSteps :: ExpectSet step -> [(step, ExpectSet step)]
liveSteps :: ExpectSet step -> [(step, ExpectSet step)]
liveSteps (ExpectStep step
step) = [(step
step, ExpectSet step
forall step. ExpectSet step
ExpectNothing)]
liveSteps ExpectSet step
ExpectNothing = []
liveSteps (ExpectSequence ExpectSet step
e ExpectSet step
f) =
  ((ExpectSet step -> ExpectSet step)
-> (step, ExpectSet step) -> (step, ExpectSet step)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ExpectSet step -> ExpectSet step -> ExpectSet step
forall step. ExpectSet step -> ExpectSet step -> ExpectSet step
`ExpectSequence` ExpectSet step
f) ((step, ExpectSet step) -> (step, ExpectSet step))
-> [(step, ExpectSet step)] -> [(step, ExpectSet step)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ExpectSet step -> [(step, ExpectSet step)]
forall step. ExpectSet step -> [(step, ExpectSet step)]
liveSteps ExpectSet step
e)
    [(step, ExpectSet step)]
-> [(step, ExpectSet step)] -> [(step, ExpectSet step)]
forall a. [a] -> [a] -> [a]
++ if ExpectSet step -> Bool
forall step. ExpectSet step -> Bool
satisfied ExpectSet step
e then ExpectSet step -> [(step, ExpectSet step)]
forall step. ExpectSet step -> [(step, ExpectSet step)]
liveSteps ExpectSet step
f else []
liveSteps (ExpectInterleave ExpectSet step
e ExpectSet step
f) =
  ((ExpectSet step -> ExpectSet step)
-> (step, ExpectSet step) -> (step, ExpectSet step)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ExpectSet step -> ExpectSet step -> ExpectSet step
forall step. ExpectSet step -> ExpectSet step -> ExpectSet step
`ExpectInterleave` ExpectSet step
f) ((step, ExpectSet step) -> (step, ExpectSet step))
-> [(step, ExpectSet step)] -> [(step, ExpectSet step)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ExpectSet step -> [(step, ExpectSet step)]
forall step. ExpectSet step -> [(step, ExpectSet step)]
liveSteps ExpectSet step
e)
    [(step, ExpectSet step)]
-> [(step, ExpectSet step)] -> [(step, ExpectSet step)]
forall a. [a] -> [a] -> [a]
++ ((ExpectSet step -> ExpectSet step)
-> (step, ExpectSet step) -> (step, ExpectSet step)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ExpectSet step -> ExpectSet step -> ExpectSet step
forall step. ExpectSet step -> ExpectSet step -> ExpectSet step
ExpectInterleave ExpectSet step
e) ((step, ExpectSet step) -> (step, ExpectSet step))
-> [(step, ExpectSet step)] -> [(step, ExpectSet step)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ExpectSet step -> [(step, ExpectSet step)]
forall step. ExpectSet step -> [(step, ExpectSet step)]
liveSteps ExpectSet step
f)
liveSteps (ExpectEither ExpectSet step
e ExpectSet step
f) = ExpectSet step -> [(step, ExpectSet step)]
forall step. ExpectSet step -> [(step, ExpectSet step)]
liveSteps ExpectSet step
e [(step, ExpectSet step)]
-> [(step, ExpectSet step)] -> [(step, ExpectSet step)]
forall a. [a] -> [a] -> [a]
++ ExpectSet step -> [(step, ExpectSet step)]
forall step. ExpectSet step -> [(step, ExpectSet step)]
liveSteps ExpectSet step
f
liveSteps (ExpectMulti Multiplicity
mult ExpectSet step
e)
  | Multiplicity -> Bool
feasible (Multiplicity
mult Multiplicity -> Multiplicity -> Multiplicity
forall a. Num a => a -> a -> a
- Multiplicity
1) =
    [ (step
step, ExpectSet step -> ExpectSet step -> ExpectSet step
forall step. ExpectSet step -> ExpectSet step -> ExpectSet step
ExpectInterleave ExpectSet step
f (Multiplicity -> ExpectSet step -> ExpectSet step
forall step. Multiplicity -> ExpectSet step -> ExpectSet step
ExpectMulti (Multiplicity
mult Multiplicity -> Multiplicity -> Multiplicity
forall a. Num a => a -> a -> a
- Multiplicity
1) ExpectSet step
e))
      | (step
step, ExpectSet step
f) <- ExpectSet step -> [(step, ExpectSet step)]
forall step. ExpectSet step -> [(step, ExpectSet step)]
liveSteps ExpectSet step
e
    ]
  | Bool
otherwise = []
liveSteps (ExpectConsecutive Multiplicity
mult ExpectSet step
e)
  | Multiplicity -> Bool
feasible (Multiplicity
mult Multiplicity -> Multiplicity -> Multiplicity
forall a. Num a => a -> a -> a
- Multiplicity
1) =
    [ (step
step, ExpectSet step -> ExpectSet step -> ExpectSet step
forall step. ExpectSet step -> ExpectSet step -> ExpectSet step
ExpectSequence ExpectSet step
f (Multiplicity -> ExpectSet step -> ExpectSet step
forall step. Multiplicity -> ExpectSet step -> ExpectSet step
ExpectConsecutive (Multiplicity
mult Multiplicity -> Multiplicity -> Multiplicity
forall a. Num a => a -> a -> a
- Multiplicity
1) ExpectSet step
e))
      | (step
step, ExpectSet step
f) <- ExpectSet step -> [(step, ExpectSet step)]
forall step. ExpectSet step -> [(step, ExpectSet step)]
liveSteps ExpectSet step
e
    ]
  | Bool
otherwise = []

-- | Performs a complete simplification of the ExpectSet.  This could be slow,
-- but we intend to do it only for error messages, so it need not be very fast.
simplify :: ExpectSet step -> ExpectSet step
simplify :: ExpectSet step -> ExpectSet step
simplify (ExpectSequence ExpectSet step
e ExpectSet step
f)
  | ExpectSet step
ExpectNothing <- ExpectSet step
e' = ExpectSet step
f'
  | ExpectSet step
ExpectNothing <- ExpectSet step
f' = ExpectSet step
e'
  | ExpectSequence ExpectSet step
e1 ExpectSet step
e2 <- ExpectSet step
e' =
    ExpectSet step -> ExpectSet step
forall step. ExpectSet step -> ExpectSet step
simplify (ExpectSet step -> ExpectSet step -> ExpectSet step
forall step. ExpectSet step -> ExpectSet step -> ExpectSet step
ExpectSequence ExpectSet step
e1 (ExpectSet step -> ExpectSet step -> ExpectSet step
forall step. ExpectSet step -> ExpectSet step -> ExpectSet step
ExpectSequence ExpectSet step
e2 ExpectSet step
f'))
  | Bool
otherwise = ExpectSet step -> ExpectSet step -> ExpectSet step
forall step. ExpectSet step -> ExpectSet step -> ExpectSet step
ExpectSequence ExpectSet step
e' ExpectSet step
f'
  where
    e' :: ExpectSet step
e' = ExpectSet step -> ExpectSet step
forall step. ExpectSet step -> ExpectSet step
simplify ExpectSet step
e
    f' :: ExpectSet step
f' = ExpectSet step -> ExpectSet step
forall step. ExpectSet step -> ExpectSet step
simplify ExpectSet step
f
simplify (ExpectInterleave ExpectSet step
e ExpectSet step
f)
  | ExpectSet step
ExpectNothing <- ExpectSet step
e' = ExpectSet step
f'
  | ExpectSet step
ExpectNothing <- ExpectSet step
f' = ExpectSet step
e'
  | ExpectInterleave ExpectSet step
e1 ExpectSet step
e2 <- ExpectSet step
e' =
    ExpectSet step -> ExpectSet step
forall step. ExpectSet step -> ExpectSet step
simplify (ExpectSet step -> ExpectSet step -> ExpectSet step
forall step. ExpectSet step -> ExpectSet step -> ExpectSet step
ExpectInterleave ExpectSet step
e1 (ExpectSet step -> ExpectSet step -> ExpectSet step
forall step. ExpectSet step -> ExpectSet step -> ExpectSet step
ExpectInterleave ExpectSet step
e2 ExpectSet step
f'))
  | Bool
otherwise = ExpectSet step -> ExpectSet step -> ExpectSet step
forall step. ExpectSet step -> ExpectSet step -> ExpectSet step
ExpectInterleave ExpectSet step
e' ExpectSet step
f'
  where
    e' :: ExpectSet step
e' = ExpectSet step -> ExpectSet step
forall step. ExpectSet step -> ExpectSet step
simplify ExpectSet step
e
    f' :: ExpectSet step
f' = ExpectSet step -> ExpectSet step
forall step. ExpectSet step -> ExpectSet step
simplify ExpectSet step
f
simplify (ExpectEither ExpectSet step
e ExpectSet step
f)
  | ExpectSet step
ExpectNothing <- ExpectSet step
e', ExpectSet step
ExpectNothing <- ExpectSet step
f' = ExpectSet step
forall step. ExpectSet step
ExpectNothing
  | ExpectSet step
ExpectNothing <- ExpectSet step
e' = ExpectSet step -> ExpectSet step
forall step. ExpectSet step -> ExpectSet step
simplify (ExpectSet step -> ExpectSet step -> ExpectSet step
forall step. ExpectSet step -> ExpectSet step -> ExpectSet step
ExpectEither ExpectSet step
f' ExpectSet step
forall step. ExpectSet step
ExpectNothing)
  | ExpectEither ExpectSet step
e1 ExpectSet step
e2 <- ExpectSet step
e' =
    ExpectSet step -> ExpectSet step
forall step. ExpectSet step -> ExpectSet step
simplify (ExpectSet step -> ExpectSet step -> ExpectSet step
forall step. ExpectSet step -> ExpectSet step -> ExpectSet step
ExpectEither ExpectSet step
e1 (ExpectSet step -> ExpectSet step -> ExpectSet step
forall step. ExpectSet step -> ExpectSet step -> ExpectSet step
ExpectEither ExpectSet step
e2 ExpectSet step
f'))
  | ExpectSet step
ExpectNothing <- ExpectSet step
f', ExpectSet step -> Bool
forall step. ExpectSet step -> Bool
satisfied ExpectSet step
e' = ExpectSet step
e'
  | ExpectSet step
ExpectNothing <- ExpectSet step
f' = ExpectSet step -> ExpectSet step
forall step. ExpectSet step -> ExpectSet step
simplify (Multiplicity -> ExpectSet step -> ExpectSet step
forall step. Multiplicity -> ExpectSet step -> ExpectSet step
ExpectMulti (Multiplicity -> Multiplicity -> Multiplicity
between Multiplicity
0 Multiplicity
1) ExpectSet step
e')
  | Bool
otherwise = ExpectSet step -> ExpectSet step -> ExpectSet step
forall step. ExpectSet step -> ExpectSet step -> ExpectSet step
ExpectEither ExpectSet step
e' ExpectSet step
f'
  where
    e' :: ExpectSet step
e' = ExpectSet step -> ExpectSet step
forall step. ExpectSet step -> ExpectSet step
simplify ExpectSet step
e
    f' :: ExpectSet step
f' = ExpectSet step -> ExpectSet step
forall step. ExpectSet step -> ExpectSet step
simplify ExpectSet step
f
simplify (ExpectMulti Multiplicity
m ExpectSet step
e)
  | Bool -> Bool
not (Multiplicity -> Bool
feasible Multiplicity
m) = Multiplicity -> ExpectSet step -> ExpectSet step
forall step. Multiplicity -> ExpectSet step -> ExpectSet step
ExpectMulti Multiplicity
m ExpectSet step
forall step. ExpectSet step
ExpectNothing 
  | ExpectSet step
ExpectNothing <- ExpectSet step
e' = ExpectSet step
forall step. ExpectSet step
ExpectNothing
  | Multiplicity
m Multiplicity -> Multiplicity -> Bool
forall a. Eq a => a -> a -> Bool
== Multiplicity
0 = ExpectSet step
forall step. ExpectSet step
ExpectNothing
  | Multiplicity
m Multiplicity -> Multiplicity -> Bool
forall a. Eq a => a -> a -> Bool
== Multiplicity
1 = ExpectSet step
e'
  | Bool
otherwise = Multiplicity -> ExpectSet step -> ExpectSet step
forall step. Multiplicity -> ExpectSet step -> ExpectSet step
ExpectMulti Multiplicity
m ExpectSet step
e'
  where
    e' :: ExpectSet step
e' = ExpectSet step -> ExpectSet step
forall step. ExpectSet step -> ExpectSet step
simplify ExpectSet step
e
simplify (ExpectConsecutive Multiplicity
m ExpectSet step
e)
  | Bool -> Bool
not (Multiplicity -> Bool
feasible Multiplicity
m) = Multiplicity -> ExpectSet step -> ExpectSet step
forall step. Multiplicity -> ExpectSet step -> ExpectSet step
ExpectConsecutive Multiplicity
m ExpectSet step
forall step. ExpectSet step
ExpectNothing 
  | ExpectSet step
ExpectNothing <- ExpectSet step
e' = ExpectSet step
forall step. ExpectSet step
ExpectNothing
  | Multiplicity
m Multiplicity -> Multiplicity -> Bool
forall a. Eq a => a -> a -> Bool
== Multiplicity
0 = ExpectSet step
forall step. ExpectSet step
ExpectNothing
  | Multiplicity
m Multiplicity -> Multiplicity -> Bool
forall a. Eq a => a -> a -> Bool
== Multiplicity
1 = ExpectSet step
e'
  | Bool
otherwise = Multiplicity -> ExpectSet step -> ExpectSet step
forall step. Multiplicity -> ExpectSet step -> ExpectSet step
ExpectConsecutive Multiplicity
m ExpectSet step
e'
  where
    e' :: ExpectSet step
e' = ExpectSet step -> ExpectSet step
forall step. ExpectSet step -> ExpectSet step
simplify ExpectSet step
e
simplify ExpectSet step
other = ExpectSet step
other

-- | Get a list of all steps mentioned by an 'ExpectSet'.  This is used to
-- determine which classes need to be initialized before adding an expectation.
getSteps :: ExpectSet step -> [step]
getSteps :: ExpectSet step -> [step]
getSteps ExpectSet step
ExpectNothing = []
getSteps (ExpectStep step
step) = [step
step]
getSteps (ExpectInterleave ExpectSet step
e ExpectSet step
f) = ExpectSet step -> [step]
forall step. ExpectSet step -> [step]
getSteps ExpectSet step
e [step] -> [step] -> [step]
forall a. [a] -> [a] -> [a]
++ ExpectSet step -> [step]
forall step. ExpectSet step -> [step]
getSteps ExpectSet step
f
getSteps (ExpectSequence ExpectSet step
e ExpectSet step
f) = ExpectSet step -> [step]
forall step. ExpectSet step -> [step]
getSteps ExpectSet step
e [step] -> [step] -> [step]
forall a. [a] -> [a] -> [a]
++ ExpectSet step -> [step]
forall step. ExpectSet step -> [step]
getSteps ExpectSet step
f
getSteps (ExpectEither ExpectSet step
e ExpectSet step
f) = ExpectSet step -> [step]
forall step. ExpectSet step -> [step]
getSteps ExpectSet step
e [step] -> [step] -> [step]
forall a. [a] -> [a] -> [a]
++ ExpectSet step -> [step]
forall step. ExpectSet step -> [step]
getSteps ExpectSet step
f
getSteps (ExpectMulti Multiplicity
_ ExpectSet step
e) = ExpectSet step -> [step]
forall step. ExpectSet step -> [step]
getSteps ExpectSet step
e
getSteps (ExpectConsecutive Multiplicity
_ ExpectSet step
e) = ExpectSet step -> [step]
forall step. ExpectSet step -> [step]
getSteps ExpectSet step
e

-- | A higher-level intermediate form of an ExpectSet suitable for communication
-- with the user.  Chains of binary operators are collected into sequences to
-- be displayed in lists rather than arbitrary nesting.
data CollectedSet step where
  CollectedStep :: step -> CollectedSet step
  CollectedNothing :: CollectedSet step
  CollectedSequence :: [CollectedSet step] -> CollectedSet step
  CollectedInterleave :: [CollectedSet step] -> CollectedSet step
  CollectedChoice :: [CollectedSet step] -> CollectedSet step
  CollectedMulti :: Multiplicity -> CollectedSet step -> CollectedSet step
  CollectedConsecutive :: Multiplicity -> CollectedSet step -> CollectedSet step

-- | Collects an ExpectSet into the intermediate form for display.  It's assumed
-- that the expression was simplified before this operation.
collect :: ExpectSet step -> CollectedSet step
collect :: ExpectSet step -> CollectedSet step
collect (ExpectStep step
s) = step -> CollectedSet step
forall step. step -> CollectedSet step
CollectedStep step
s
collect ExpectSet step
ExpectNothing = CollectedSet step
forall step. CollectedSet step
CollectedNothing
collect (ExpectSequence ExpectSet step
e ExpectSet step
f) = [CollectedSet step] -> CollectedSet step
forall step. [CollectedSet step] -> CollectedSet step
CollectedSequence (ExpectSet step -> CollectedSet step
forall step. ExpectSet step -> CollectedSet step
collect ExpectSet step
e CollectedSet step -> [CollectedSet step] -> [CollectedSet step]
forall a. a -> [a] -> [a]
: [CollectedSet step]
fs)
  where
    fs :: [CollectedSet step]
fs = case ExpectSet step -> CollectedSet step
forall step. ExpectSet step -> CollectedSet step
collect ExpectSet step
f of
      CollectedSequence [CollectedSet step]
f' -> [CollectedSet step]
f'
      CollectedSet step
f' -> [CollectedSet step
f']
collect (ExpectInterleave ExpectSet step
e ExpectSet step
f) = [CollectedSet step] -> CollectedSet step
forall step. [CollectedSet step] -> CollectedSet step
CollectedInterleave (ExpectSet step -> CollectedSet step
forall step. ExpectSet step -> CollectedSet step
collect ExpectSet step
e CollectedSet step -> [CollectedSet step] -> [CollectedSet step]
forall a. a -> [a] -> [a]
: [CollectedSet step]
fs)
  where
    fs :: [CollectedSet step]
fs = case ExpectSet step -> CollectedSet step
forall step. ExpectSet step -> CollectedSet step
collect ExpectSet step
f of
      CollectedInterleave [CollectedSet step]
f' -> [CollectedSet step]
f'
      CollectedSet step
f' -> [CollectedSet step
f']
collect (ExpectEither ExpectSet step
e ExpectSet step
f) = [CollectedSet step] -> CollectedSet step
forall step. [CollectedSet step] -> CollectedSet step
CollectedChoice (ExpectSet step -> CollectedSet step
forall step. ExpectSet step -> CollectedSet step
collect ExpectSet step
e CollectedSet step -> [CollectedSet step] -> [CollectedSet step]
forall a. a -> [a] -> [a]
: [CollectedSet step]
fs)
  where
    fs :: [CollectedSet step]
fs = case ExpectSet step -> CollectedSet step
forall step. ExpectSet step -> CollectedSet step
collect ExpectSet step
f of
      CollectedChoice [CollectedSet step]
f' -> [CollectedSet step]
f'
      CollectedSet step
f' -> [CollectedSet step
f']
collect (ExpectMulti Multiplicity
m ExpectSet step
e) = Multiplicity -> CollectedSet step -> CollectedSet step
forall step. Multiplicity -> CollectedSet step -> CollectedSet step
CollectedMulti Multiplicity
m (ExpectSet step -> CollectedSet step
forall step. ExpectSet step -> CollectedSet step
collect ExpectSet step
e)
collect (ExpectConsecutive Multiplicity
m ExpectSet step
e) = Multiplicity -> CollectedSet step -> CollectedSet step
forall step. Multiplicity -> CollectedSet step -> CollectedSet step
CollectedConsecutive Multiplicity
m (ExpectSet step -> CollectedSet step
forall step. ExpectSet step -> CollectedSet step
collect ExpectSet step
e)

-- | Converts a set of expectations into a string that summarizes them, with
-- the given prefix (used to indent).
formatExpectSet :: (Show step) => ExpectSet step -> String
formatExpectSet :: ExpectSet step -> String
formatExpectSet = String -> CollectedSet step -> String
forall a. Show a => String -> CollectedSet a -> String
go String
"" (CollectedSet step -> String)
-> (ExpectSet step -> CollectedSet step)
-> ExpectSet step
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExpectSet step -> CollectedSet step
forall step. ExpectSet step -> CollectedSet step
collect (ExpectSet step -> CollectedSet step)
-> (ExpectSet step -> ExpectSet step)
-> ExpectSet step
-> CollectedSet step
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExpectSet step -> ExpectSet step
forall step. ExpectSet step -> ExpectSet step
simplify
  where
    go :: String -> CollectedSet a -> String
go String
prefix CollectedSet a
CollectedNothing = String
prefix String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"* nothing"
    go String
prefix (CollectedStep a
step) = String
prefix String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"* " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
step
    go String
prefix (CollectedSequence [CollectedSet a]
cs) =
      String
prefix String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"* in sequence:\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
unlines ((CollectedSet a -> String) -> [CollectedSet a] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String -> CollectedSet a -> String
go (String
"    " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
prefix)) [CollectedSet a]
cs)
    go String
prefix (CollectedInterleave [CollectedSet a]
cs) =
      String
prefix String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"* in any order:\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
unlines ((CollectedSet a -> String) -> [CollectedSet a] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String -> CollectedSet a -> String
go (String
"    " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
prefix)) [CollectedSet a]
cs)
    go String
prefix (CollectedChoice [CollectedSet a]
cs) =
      String
prefix String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"* any of:\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
unlines ((CollectedSet a -> String) -> [CollectedSet a] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String -> CollectedSet a -> String
go (String
"    " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
prefix)) [CollectedSet a]
cs)
    go String
prefix (CollectedMulti Multiplicity
m CollectedSet a
e) =
      String
prefix String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"* " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Multiplicity -> String
forall a. Show a => a -> String
show Multiplicity
m String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
":\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> CollectedSet a -> String
go (String
"    " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
prefix) CollectedSet a
e
    go String
prefix (CollectedConsecutive Multiplicity
m CollectedSet a
e) =
      String
prefix String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"* " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Multiplicity -> String
forall a. Show a => a -> String
show Multiplicity
m String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" consecutively:\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> CollectedSet a -> String
go (String
"    " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
prefix) CollectedSet a
e

-- | Reduces a set of expectations to the minimum steps that would be required
-- to satisfy the entire set.  This weeds out unnecessary information before
-- reporting that there were unmet expectations at the end of the test.
excess :: ExpectSet step -> ExpectSet step
excess :: ExpectSet step -> ExpectSet step
excess = ExpectSet step -> ExpectSet step
forall step. ExpectSet step -> ExpectSet step
simplify (ExpectSet step -> ExpectSet step)
-> (ExpectSet step -> ExpectSet step)
-> ExpectSet step
-> ExpectSet step
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExpectSet step -> ExpectSet step
forall step. ExpectSet step -> ExpectSet step
go
  where
    go :: ExpectSet step -> ExpectSet step
go (ExpectSequence ExpectSet step
e ExpectSet step
f) = ExpectSet step -> ExpectSet step -> ExpectSet step
forall step. ExpectSet step -> ExpectSet step -> ExpectSet step
ExpectSequence (ExpectSet step -> ExpectSet step
go ExpectSet step
e) (ExpectSet step -> ExpectSet step
go ExpectSet step
f)
    go (ExpectInterleave ExpectSet step
e ExpectSet step
f) = ExpectSet step -> ExpectSet step -> ExpectSet step
forall step. ExpectSet step -> ExpectSet step -> ExpectSet step
ExpectInterleave (ExpectSet step -> ExpectSet step
go ExpectSet step
e) (ExpectSet step -> ExpectSet step
go ExpectSet step
f)
    go (ExpectEither ExpectSet step
e ExpectSet step
f)
      | ExpectSet step -> Bool
forall step. ExpectSet step -> Bool
satisfied ExpectSet step
e Bool -> Bool -> Bool
|| ExpectSet step -> Bool
forall step. ExpectSet step -> Bool
satisfied ExpectSet step
f = ExpectSet step
forall step. ExpectSet step
ExpectNothing
      | Bool
otherwise = ExpectSet step -> ExpectSet step -> ExpectSet step
forall step. ExpectSet step -> ExpectSet step -> ExpectSet step
ExpectEither (ExpectSet step -> ExpectSet step
go ExpectSet step
e) (ExpectSet step -> ExpectSet step
go ExpectSet step
f)
    go (ExpectMulti Multiplicity
m ExpectSet step
e)
      | Multiplicity -> Int -> Bool
meetsMultiplicity Multiplicity
m Int
0 = ExpectSet step
forall step. ExpectSet step
ExpectNothing
      | Bool
otherwise = Multiplicity -> ExpectSet step -> ExpectSet step
forall step. Multiplicity -> ExpectSet step -> ExpectSet step
ExpectMulti Multiplicity
m (ExpectSet step -> ExpectSet step
go ExpectSet step
e)
    go (ExpectConsecutive Multiplicity
m ExpectSet step
e)
      | Multiplicity -> Int -> Bool
meetsMultiplicity Multiplicity
m Int
0 = ExpectSet step
forall step. ExpectSet step
ExpectNothing
      | Bool
otherwise = Multiplicity -> ExpectSet step -> ExpectSet step
forall step. Multiplicity -> ExpectSet step -> ExpectSet step
ExpectConsecutive Multiplicity
m (ExpectSet step -> ExpectSet step
go ExpectSet step
e)
    go ExpectSet step
other = ExpectSet step
other