{-# LANGUAGE DeriveDataTypeable #-}
module Test.HMock.Multiplicity
( Multiplicity,
meetsMultiplicity,
feasible,
once,
anyMultiplicity,
atLeast,
atMost,
between,
)
where
data Multiplicity = Multiplicity Int (Maybe Int) deriving (Multiplicity -> Multiplicity -> Bool
(Multiplicity -> Multiplicity -> Bool)
-> (Multiplicity -> Multiplicity -> Bool) -> Eq Multiplicity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Multiplicity -> Multiplicity -> Bool
$c/= :: Multiplicity -> Multiplicity -> Bool
== :: Multiplicity -> Multiplicity -> Bool
$c== :: Multiplicity -> Multiplicity -> Bool
Eq)
instance Show Multiplicity where
show :: Multiplicity -> String
show Multiplicity
mult = Multiplicity -> String
go (Multiplicity -> Multiplicity
normalize Multiplicity
mult)
where
go :: Multiplicity -> String
go Multiplicity
m | Bool -> Bool
not (Multiplicity -> Bool
feasible Multiplicity
m) = String
"infeasible"
go (Multiplicity Int
0 (Just Int
0)) = String
"never"
go (Multiplicity Int
1 (Just Int
1)) = String
"once"
go (Multiplicity Int
2 (Just Int
2)) = String
"twice"
go (Multiplicity Int
0 Maybe Int
Nothing) = String
"any number of times"
go (Multiplicity Int
1 Maybe Int
Nothing) = String
"at least once"
go (Multiplicity Int
2 Maybe Int
Nothing) = String
"at least twice"
go (Multiplicity Int
n Maybe Int
Nothing) = String
"at least " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" times"
go (Multiplicity Int
0 (Just Int
1)) = String
"at most once"
go (Multiplicity Int
0 (Just Int
2)) = String
"at most twice"
go (Multiplicity Int
0 (Just Int
n)) = String
"at most " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" times"
go (Multiplicity Int
m (Just Int
n))
| Int
m Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n = Int -> String
forall a. Show a => a -> String
show Int
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" times"
| Int
m Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 = Int -> String
forall a. Show a => a -> String
show Int
m String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" or " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" times"
| Bool
otherwise = Int -> String
forall a. Show a => a -> String
show Int
m String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" to " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" times"
infeasible :: Multiplicity
infeasible :: Multiplicity
infeasible = Int -> Maybe Int -> Multiplicity
Multiplicity Int
0 (Int -> Maybe Int
forall a. a -> Maybe a
Just (-Int
1))
instance Num Multiplicity where
fromInteger :: Integer -> Multiplicity
fromInteger Integer
n
| Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 = Multiplicity
infeasible
| Bool
otherwise =
Multiplicity -> Multiplicity
normalize (Multiplicity -> Multiplicity) -> Multiplicity -> Multiplicity
forall a b. (a -> b) -> a -> b
$
Int -> Maybe Int -> Multiplicity
Multiplicity (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
n) (Int -> Maybe Int
forall a. a -> Maybe a
Just (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
n))
m1 :: Multiplicity
m1@(Multiplicity Int
a Maybe Int
b) + :: Multiplicity -> Multiplicity -> Multiplicity
+ m2 :: Multiplicity
m2@(Multiplicity Int
c Maybe Int
d)
| Multiplicity -> Bool
feasible Multiplicity
m1 Bool -> Bool -> Bool
&& Multiplicity -> Bool
feasible Multiplicity
m2 =
Multiplicity -> Multiplicity
normalize (Multiplicity -> Multiplicity) -> Multiplicity -> Multiplicity
forall a b. (a -> b) -> a -> b
$ Int -> Maybe Int -> Multiplicity
Multiplicity (Int
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
c) (Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) (Int -> Int -> Int) -> Maybe Int -> Maybe (Int -> Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Int
b Maybe (Int -> Int) -> Maybe Int -> Maybe Int
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Int
d)
| Bool
otherwise = Multiplicity
infeasible
m1 :: Multiplicity
m1@(Multiplicity Int
a Maybe Int
b) - :: Multiplicity -> Multiplicity -> Multiplicity
- m2 :: Multiplicity
m2@(Multiplicity Int
c Maybe Int
d)
| Multiplicity -> Bool
feasible Multiplicity
m1 Bool -> Bool -> Bool
&& Multiplicity -> Bool
feasible Multiplicity
m2 =
Multiplicity -> Multiplicity
normalize (Multiplicity -> Multiplicity) -> Multiplicity -> Multiplicity
forall a b. (a -> b) -> a -> b
$ Int -> Maybe Int -> Multiplicity
Multiplicity (Int -> (Int -> Int) -> Maybe Int -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 (Int
a Int -> Int -> Int
forall a. Num a => a -> a -> a
-) Maybe Int
d) (Int -> Int -> Int
forall a. Num a => a -> a -> a
subtract Int
c (Int -> Int) -> Maybe Int -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Int
b)
| Bool
otherwise = Multiplicity
infeasible
* :: Multiplicity -> Multiplicity -> Multiplicity
(*) = String -> Multiplicity -> Multiplicity -> Multiplicity
forall a. HasCallStack => String -> a
error String
"Multiplicities are not closed under multiplication"
abs :: Multiplicity -> Multiplicity
abs = Multiplicity -> Multiplicity
forall a. a -> a
id
signum :: Multiplicity -> Multiplicity
signum Multiplicity
x = if Multiplicity
x Multiplicity -> Multiplicity -> Bool
forall a. Eq a => a -> a -> Bool
== Multiplicity
0 then Multiplicity
0 else Multiplicity
1
normalize :: Multiplicity -> Multiplicity
normalize :: Multiplicity -> Multiplicity
normalize m :: Multiplicity
m@(Multiplicity Int
a Maybe Int
b)
| Bool -> Bool
not (Multiplicity -> Bool
feasible Multiplicity
m) = Multiplicity
infeasible
| Bool
otherwise = Int -> Maybe Int -> Multiplicity
Multiplicity (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
a Int
0) Maybe Int
b
meetsMultiplicity :: Multiplicity -> Int -> Bool
meetsMultiplicity :: Multiplicity -> Int -> Bool
meetsMultiplicity (Multiplicity Int
lo Maybe Int
mbhi) Int
n
| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
lo = Bool
False
| Just Int
hi <- Maybe Int
mbhi, Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
hi = Bool
False
| Bool
otherwise = Bool
True
once :: Multiplicity
once :: Multiplicity
once = Multiplicity
1
anyMultiplicity :: Multiplicity
anyMultiplicity :: Multiplicity
anyMultiplicity = Multiplicity -> Multiplicity
atLeast Multiplicity
0
atLeast :: Multiplicity -> Multiplicity
atLeast :: Multiplicity -> Multiplicity
atLeast (Multiplicity Int
n Maybe Int
_) = Multiplicity -> Multiplicity
normalize (Multiplicity -> Multiplicity) -> Multiplicity -> Multiplicity
forall a b. (a -> b) -> a -> b
$ Int -> Maybe Int -> Multiplicity
Multiplicity Int
n Maybe Int
forall a. Maybe a
Nothing
atMost :: Multiplicity -> Multiplicity
atMost :: Multiplicity -> Multiplicity
atMost (Multiplicity Int
_ Maybe Int
n) = Multiplicity -> Multiplicity
normalize (Multiplicity -> Multiplicity) -> Multiplicity -> Multiplicity
forall a b. (a -> b) -> a -> b
$ Int -> Maybe Int -> Multiplicity
Multiplicity Int
0 Maybe Int
n
between :: Multiplicity -> Multiplicity -> Multiplicity
between :: Multiplicity -> Multiplicity -> Multiplicity
between (Multiplicity Int
m Maybe Int
_) (Multiplicity Int
_ Maybe Int
n) = Multiplicity -> Multiplicity
normalize (Multiplicity -> Multiplicity) -> Multiplicity -> Multiplicity
forall a b. (a -> b) -> a -> b
$ Int -> Maybe Int -> Multiplicity
Multiplicity Int
m Maybe Int
n
feasible :: Multiplicity -> Bool
feasible :: Multiplicity -> Bool
feasible (Multiplicity Int
a Maybe Int
b) = Bool -> (Int -> Bool) -> Maybe Int -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 Int
a) Maybe Int
b