{-# 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
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 " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
n 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 " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
n forall a. [a] -> [a] -> [a]
++ String
" times"
go (Multiplicity Int
m (Just Int
n))
| Int
m forall a. Eq a => a -> a -> Bool
== Int
n = forall a. Show a => a -> String
show Int
n forall a. [a] -> [a] -> [a]
++ String
" times"
| Int
m forall a. Eq a => a -> a -> Bool
== Int
n forall a. Num a => a -> a -> a
- Int
1 = forall a. Show a => a -> String
show Int
m forall a. [a] -> [a] -> [a]
++ String
" or " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
n forall a. [a] -> [a] -> [a]
++ String
" times"
| Bool
otherwise = forall a. Show a => a -> String
show Int
m forall a. [a] -> [a] -> [a]
++ String
" to " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
n forall a. [a] -> [a] -> [a]
++ String
" times"
infeasible :: Multiplicity
infeasible :: Multiplicity
infeasible = Int -> Maybe Int -> Multiplicity
Multiplicity Int
0 (forall a. a -> Maybe a
Just (-Int
1))
instance Num Multiplicity where
fromInteger :: Integer -> Multiplicity
fromInteger Integer
n
| Integer
n forall a. Ord a => a -> a -> Bool
< Integer
0 = Multiplicity
infeasible
| Bool
otherwise =
Multiplicity -> Multiplicity
normalize forall a b. (a -> b) -> a -> b
$
Int -> Maybe Int -> Multiplicity
Multiplicity (forall a. Num a => Integer -> a
fromInteger Integer
n) (forall a. a -> Maybe a
Just (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 forall a b. (a -> b) -> a -> b
$ Int -> Maybe Int -> Multiplicity
Multiplicity (Int
a forall a. Num a => a -> a -> a
+ Int
c) (forall a. Num a => a -> a -> a
(+) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Int
b 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 forall a b. (a -> b) -> a -> b
$ Int -> Maybe Int -> Multiplicity
Multiplicity (forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 (Int
a forall a. Num a => a -> a -> a
-) Maybe Int
d) (forall a. Num a => a -> a -> a
subtract Int
c forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Int
b)
| Bool
otherwise = Multiplicity
infeasible
* :: Multiplicity -> Multiplicity -> Multiplicity
(*) = forall a. HasCallStack => String -> a
error String
"Multiplicities are not closed under multiplication"
abs :: Multiplicity -> Multiplicity
abs = forall a. a -> a
id
signum :: Multiplicity -> Multiplicity
signum Multiplicity
x = if Multiplicity
x 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 (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 forall a. Ord a => a -> a -> Bool
< Int
lo = Bool
False
| Just Int
hi <- Maybe Int
mbhi, Int
n 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 forall a b. (a -> b) -> a -> b
$ Int -> Maybe Int -> Multiplicity
Multiplicity Int
n forall a. Maybe a
Nothing
atMost :: Multiplicity -> Multiplicity
atMost :: Multiplicity -> Multiplicity
atMost (Multiplicity Int
_ Maybe Int
n) = Multiplicity -> Multiplicity
normalize 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 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) = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (forall a. Ord a => a -> a -> Bool
>= forall a. Ord a => a -> a -> a
max Int
0 Int
a) Maybe Int
b