{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE GADTSyntax #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
module Test.HMock.Internal.ExpectSet where
import Test.HMock.Multiplicity
( Multiplicity,
between,
feasible, meetsMultiplicity
)
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
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
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)
satisfied :: ExpectSet step -> Bool
satisfied :: forall step. ExpectSet step -> Bool
satisfied (ExpectStep step
_) = Bool
False
satisfied ExpectSet step
ExpectNothing = Bool
True
satisfied (ExpectSequence ExpectSet step
e ExpectSet step
f) = forall step. ExpectSet step -> Bool
satisfied ExpectSet step
e Bool -> Bool -> Bool
&& forall step. ExpectSet step -> Bool
satisfied ExpectSet step
f
satisfied (ExpectInterleave ExpectSet step
e ExpectSet step
f) = forall step. ExpectSet step -> Bool
satisfied ExpectSet step
e Bool -> Bool -> Bool
&& forall step. ExpectSet step -> Bool
satisfied ExpectSet step
f
satisfied (ExpectEither ExpectSet step
e ExpectSet step
f) = forall step. ExpectSet step -> Bool
satisfied ExpectSet step
e Bool -> Bool -> 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
|| 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
|| forall step. ExpectSet step -> Bool
satisfied ExpectSet step
e)
liveSteps :: ExpectSet step -> [(step, ExpectSet step)]
liveSteps :: forall step. ExpectSet step -> [(step, ExpectSet step)]
liveSteps (ExpectStep step
step) = [(step
step, forall step. ExpectSet step
ExpectNothing)]
liveSteps ExpectSet step
ExpectNothing = []
liveSteps (ExpectSequence ExpectSet step
e ExpectSet step
f) =
(forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall step. ExpectSet step -> ExpectSet step -> ExpectSet step
`ExpectSequence` ExpectSet step
f) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall step. ExpectSet step -> [(step, ExpectSet step)]
liveSteps ExpectSet step
e)
forall a. [a] -> [a] -> [a]
++ if forall step. ExpectSet step -> Bool
satisfied ExpectSet step
e then forall step. ExpectSet step -> [(step, ExpectSet step)]
liveSteps ExpectSet step
f else []
liveSteps (ExpectInterleave ExpectSet step
e ExpectSet step
f) =
(forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall step. ExpectSet step -> ExpectSet step -> ExpectSet step
`ExpectInterleave` ExpectSet step
f) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall step. ExpectSet step -> [(step, ExpectSet step)]
liveSteps ExpectSet step
e)
forall a. [a] -> [a] -> [a]
++ (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall step. ExpectSet step -> ExpectSet step -> ExpectSet step
ExpectInterleave ExpectSet step
e) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall step. ExpectSet step -> [(step, ExpectSet step)]
liveSteps ExpectSet step
f)
liveSteps (ExpectEither ExpectSet step
e ExpectSet step
f) = forall step. ExpectSet step -> [(step, ExpectSet step)]
liveSteps ExpectSet step
e forall a. [a] -> [a] -> [a]
++ forall step. ExpectSet step -> [(step, ExpectSet step)]
liveSteps ExpectSet step
f
liveSteps (ExpectMulti Multiplicity
mult ExpectSet step
e)
| Multiplicity -> Bool
feasible (Multiplicity
mult forall a. Num a => a -> a -> a
- Multiplicity
1) =
[ (step
step, forall step. ExpectSet step -> ExpectSet step -> ExpectSet step
ExpectInterleave ExpectSet step
f (forall step. Multiplicity -> ExpectSet step -> ExpectSet step
ExpectMulti (Multiplicity
mult forall a. Num a => a -> a -> a
- Multiplicity
1) ExpectSet step
e))
| (step
step, ExpectSet step
f) <- 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 forall a. Num a => a -> a -> a
- Multiplicity
1) =
[ (step
step, forall step. ExpectSet step -> ExpectSet step -> ExpectSet step
ExpectSequence ExpectSet step
f (forall step. Multiplicity -> ExpectSet step -> ExpectSet step
ExpectConsecutive (Multiplicity
mult forall a. Num a => a -> a -> a
- Multiplicity
1) ExpectSet step
e))
| (step
step, ExpectSet step
f) <- forall step. ExpectSet step -> [(step, ExpectSet step)]
liveSteps ExpectSet step
e
]
| Bool
otherwise = []
simplify :: ExpectSet step -> ExpectSet step
simplify :: forall step. 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' =
forall step. ExpectSet step -> ExpectSet step
simplify (forall step. ExpectSet step -> ExpectSet step -> ExpectSet step
ExpectSequence ExpectSet step
e1 (forall step. ExpectSet step -> ExpectSet step -> ExpectSet step
ExpectSequence ExpectSet step
e2 ExpectSet step
f'))
| Bool
otherwise = forall step. ExpectSet step -> ExpectSet step -> ExpectSet step
ExpectSequence ExpectSet step
e' ExpectSet step
f'
where
e' :: ExpectSet step
e' = forall step. ExpectSet step -> ExpectSet step
simplify ExpectSet step
e
f' :: ExpectSet step
f' = 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' =
forall step. ExpectSet step -> ExpectSet step
simplify (forall step. ExpectSet step -> ExpectSet step -> ExpectSet step
ExpectInterleave ExpectSet step
e1 (forall step. ExpectSet step -> ExpectSet step -> ExpectSet step
ExpectInterleave ExpectSet step
e2 ExpectSet step
f'))
| Bool
otherwise = forall step. ExpectSet step -> ExpectSet step -> ExpectSet step
ExpectInterleave ExpectSet step
e' ExpectSet step
f'
where
e' :: ExpectSet step
e' = forall step. ExpectSet step -> ExpectSet step
simplify ExpectSet step
e
f' :: ExpectSet step
f' = 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' = forall step. ExpectSet step
ExpectNothing
| ExpectSet step
ExpectNothing <- ExpectSet step
e' = forall step. ExpectSet step -> ExpectSet step
simplify (forall step. ExpectSet step -> ExpectSet step -> ExpectSet step
ExpectEither ExpectSet step
f' forall step. ExpectSet step
ExpectNothing)
| ExpectEither ExpectSet step
e1 ExpectSet step
e2 <- ExpectSet step
e' =
forall step. ExpectSet step -> ExpectSet step
simplify (forall step. ExpectSet step -> ExpectSet step -> ExpectSet step
ExpectEither ExpectSet step
e1 (forall step. ExpectSet step -> ExpectSet step -> ExpectSet step
ExpectEither ExpectSet step
e2 ExpectSet step
f'))
| ExpectSet step
ExpectNothing <- ExpectSet step
f', forall step. ExpectSet step -> Bool
satisfied ExpectSet step
e' = ExpectSet step
e'
| ExpectSet step
ExpectNothing <- ExpectSet step
f' = forall step. ExpectSet step -> ExpectSet step
simplify (forall step. Multiplicity -> ExpectSet step -> ExpectSet step
ExpectMulti (Multiplicity -> Multiplicity -> Multiplicity
between Multiplicity
0 Multiplicity
1) ExpectSet step
e')
| Bool
otherwise = forall step. ExpectSet step -> ExpectSet step -> ExpectSet step
ExpectEither ExpectSet step
e' ExpectSet step
f'
where
e' :: ExpectSet step
e' = forall step. ExpectSet step -> ExpectSet step
simplify ExpectSet step
e
f' :: ExpectSet step
f' = 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) = forall step. Multiplicity -> ExpectSet step -> ExpectSet step
ExpectMulti Multiplicity
m forall step. ExpectSet step
ExpectNothing
| ExpectSet step
ExpectNothing <- ExpectSet step
e' = forall step. ExpectSet step
ExpectNothing
| Multiplicity
m forall a. Eq a => a -> a -> Bool
== Multiplicity
0 = forall step. ExpectSet step
ExpectNothing
| Multiplicity
m forall a. Eq a => a -> a -> Bool
== Multiplicity
1 = ExpectSet step
e'
| Bool
otherwise = forall step. Multiplicity -> ExpectSet step -> ExpectSet step
ExpectMulti Multiplicity
m ExpectSet step
e'
where
e' :: ExpectSet step
e' = 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) = forall step. Multiplicity -> ExpectSet step -> ExpectSet step
ExpectConsecutive Multiplicity
m forall step. ExpectSet step
ExpectNothing
| ExpectSet step
ExpectNothing <- ExpectSet step
e' = forall step. ExpectSet step
ExpectNothing
| Multiplicity
m forall a. Eq a => a -> a -> Bool
== Multiplicity
0 = forall step. ExpectSet step
ExpectNothing
| Multiplicity
m forall a. Eq a => a -> a -> Bool
== Multiplicity
1 = ExpectSet step
e'
| Bool
otherwise = forall step. Multiplicity -> ExpectSet step -> ExpectSet step
ExpectConsecutive Multiplicity
m ExpectSet step
e'
where
e' :: ExpectSet step
e' = forall step. ExpectSet step -> ExpectSet step
simplify ExpectSet step
e
simplify ExpectSet step
other = ExpectSet step
other
getSteps :: ExpectSet step -> [step]
getSteps :: forall step. ExpectSet step -> [step]
getSteps ExpectSet step
ExpectNothing = []
getSteps (ExpectStep step
step) = [step
step]
getSteps (ExpectInterleave ExpectSet step
e ExpectSet step
f) = forall step. ExpectSet step -> [step]
getSteps ExpectSet step
e forall a. [a] -> [a] -> [a]
++ forall step. ExpectSet step -> [step]
getSteps ExpectSet step
f
getSteps (ExpectSequence ExpectSet step
e ExpectSet step
f) = forall step. ExpectSet step -> [step]
getSteps ExpectSet step
e forall a. [a] -> [a] -> [a]
++ forall step. ExpectSet step -> [step]
getSteps ExpectSet step
f
getSteps (ExpectEither ExpectSet step
e ExpectSet step
f) = forall step. ExpectSet step -> [step]
getSteps ExpectSet step
e forall a. [a] -> [a] -> [a]
++ forall step. ExpectSet step -> [step]
getSteps ExpectSet step
f
getSteps (ExpectMulti Multiplicity
_ ExpectSet step
e) = forall step. ExpectSet step -> [step]
getSteps ExpectSet step
e
getSteps (ExpectConsecutive Multiplicity
_ ExpectSet step
e) = forall step. ExpectSet step -> [step]
getSteps ExpectSet step
e
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
collect :: ExpectSet step -> CollectedSet step
collect :: forall step. ExpectSet step -> CollectedSet step
collect (ExpectStep step
s) = forall step. step -> CollectedSet step
CollectedStep step
s
collect ExpectSet step
ExpectNothing = forall step. CollectedSet step
CollectedNothing
collect (ExpectSequence ExpectSet step
e ExpectSet step
f) = forall step. [CollectedSet step] -> CollectedSet step
CollectedSequence (forall step. ExpectSet step -> CollectedSet step
collect ExpectSet step
e forall a. a -> [a] -> [a]
: [CollectedSet step]
fs)
where
fs :: [CollectedSet step]
fs = case 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) = forall step. [CollectedSet step] -> CollectedSet step
CollectedInterleave (forall step. ExpectSet step -> CollectedSet step
collect ExpectSet step
e forall a. a -> [a] -> [a]
: [CollectedSet step]
fs)
where
fs :: [CollectedSet step]
fs = case 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) = forall step. [CollectedSet step] -> CollectedSet step
CollectedChoice (forall step. ExpectSet step -> CollectedSet step
collect ExpectSet step
e forall a. a -> [a] -> [a]
: [CollectedSet step]
fs)
where
fs :: [CollectedSet step]
fs = case 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) = forall step. Multiplicity -> CollectedSet step -> CollectedSet step
CollectedMulti Multiplicity
m (forall step. ExpectSet step -> CollectedSet step
collect ExpectSet step
e)
collect (ExpectConsecutive Multiplicity
m ExpectSet step
e) = forall step. Multiplicity -> CollectedSet step -> CollectedSet step
CollectedConsecutive Multiplicity
m (forall step. ExpectSet step -> CollectedSet step
collect ExpectSet step
e)
formatExpectSet :: (Show step) => ExpectSet step -> String
formatExpectSet :: forall step. Show step => ExpectSet step -> String
formatExpectSet = forall {a}. Show a => String -> CollectedSet a -> String
go String
"" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall step. ExpectSet step -> CollectedSet step
collect forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall step. ExpectSet step -> ExpectSet step
simplify
where
go :: String -> CollectedSet a -> String
go String
prefix CollectedSet a
CollectedNothing = String
prefix forall a. [a] -> [a] -> [a]
++ String
"* nothing"
go String
prefix (CollectedStep a
step) = String
prefix forall a. [a] -> [a] -> [a]
++ String
"* " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show a
step
go String
prefix (CollectedSequence [CollectedSet a]
cs) =
String
prefix forall a. [a] -> [a] -> [a]
++ String
"* in sequence:\n" forall a. [a] -> [a] -> [a]
++ [String] -> String
unlines (forall a b. (a -> b) -> [a] -> [b]
map (String -> CollectedSet a -> String
go (String
" " forall a. [a] -> [a] -> [a]
++ String
prefix)) [CollectedSet a]
cs)
go String
prefix (CollectedInterleave [CollectedSet a]
cs) =
String
prefix forall a. [a] -> [a] -> [a]
++ String
"* in any order:\n" forall a. [a] -> [a] -> [a]
++ [String] -> String
unlines (forall a b. (a -> b) -> [a] -> [b]
map (String -> CollectedSet a -> String
go (String
" " forall a. [a] -> [a] -> [a]
++ String
prefix)) [CollectedSet a]
cs)
go String
prefix (CollectedChoice [CollectedSet a]
cs) =
String
prefix forall a. [a] -> [a] -> [a]
++ String
"* any of:\n" forall a. [a] -> [a] -> [a]
++ [String] -> String
unlines (forall a b. (a -> b) -> [a] -> [b]
map (String -> CollectedSet a -> String
go (String
" " forall a. [a] -> [a] -> [a]
++ String
prefix)) [CollectedSet a]
cs)
go String
prefix (CollectedMulti Multiplicity
m CollectedSet a
e) =
String
prefix forall a. [a] -> [a] -> [a]
++ String
"* " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Multiplicity
m forall a. [a] -> [a] -> [a]
++ String
":\n" forall a. [a] -> [a] -> [a]
++ String -> CollectedSet a -> String
go (String
" " forall a. [a] -> [a] -> [a]
++ String
prefix) CollectedSet a
e
go String
prefix (CollectedConsecutive Multiplicity
m CollectedSet a
e) =
String
prefix forall a. [a] -> [a] -> [a]
++ String
"* " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Multiplicity
m forall a. [a] -> [a] -> [a]
++ String
" consecutively:\n" forall a. [a] -> [a] -> [a]
++ String -> CollectedSet a -> String
go (String
" " forall a. [a] -> [a] -> [a]
++ String
prefix) CollectedSet a
e
excess :: ExpectSet step -> ExpectSet step
excess :: forall step. ExpectSet step -> ExpectSet step
excess = forall step. ExpectSet step -> ExpectSet step
simplify forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall step. ExpectSet step -> ExpectSet step
go
where
go :: ExpectSet step -> ExpectSet step
go (ExpectSequence ExpectSet step
e ExpectSet step
f) = 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) = 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)
| forall step. ExpectSet step -> Bool
satisfied ExpectSet step
e Bool -> Bool -> Bool
|| forall step. ExpectSet step -> Bool
satisfied ExpectSet step
f = forall step. ExpectSet step
ExpectNothing
| Bool
otherwise = 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 = forall step. ExpectSet step
ExpectNothing
| Bool
otherwise = 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 = forall step. ExpectSet step
ExpectNothing
| Bool
otherwise = 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