{-# LANGUAGE DeriveDataTypeable #-}

-- | This module provides the basic vocabulary for talking about multiplicity,
-- which is the number of times something is allowed to happen.  Multiplicities
-- can be any range of natural numbers, with or without an upper bound.
module Test.HMock.Multiplicity
  ( Multiplicity,
    meetsMultiplicity,
    feasible,
    once,
    anyMultiplicity,
    atLeast,
    atMost,
    between,
  )
where

-- | An acceptable range of number of times for something to happen.
--
-- A multiplicity can have a lower and an upper bound.
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"

-- | A 'Multiplicity' value representing inconsistent expectations.
infeasible :: Multiplicity
infeasible :: Multiplicity
infeasible = Int -> Maybe Int -> Multiplicity
Multiplicity Int
0 (Int -> Maybe Int
forall a. a -> Maybe a
Just (-Int
1))

-- | This is an incomplete instance, provided for convenience.
--
-- >>> meetsMultiplicity 5 4
-- False
-- >>> meetsMultiplicity 5 5
-- True
-- >>> between 4 6 - between 1 2
-- 2 to 5 times
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

-- | Checks whether a certain number satisfies the 'Multiplicity'.
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

-- | A 'Multiplicity' that means exactly once.
--
-- >>> meetsMultiplicity once 0
-- False
-- >>> meetsMultiplicity once 1
-- True
-- >>> meetsMultiplicity once 2
-- False
once :: Multiplicity
once :: Multiplicity
once = Multiplicity
1

-- | A 'Multiplicity' that means any number of times.
-- >>> meetsMultiplicity anyMultiplicity 0
-- True
-- >>> meetsMultiplicity anyMultiplicity 1
-- True
-- >>> meetsMultiplicity anyMultiplicity 10
-- True
anyMultiplicity :: Multiplicity
anyMultiplicity :: Multiplicity
anyMultiplicity = Multiplicity -> Multiplicity
atLeast Multiplicity
0

-- | A 'Multiplicity' that means at least this many times.
--
-- >>> meetsMultiplicity (atLeast 2) 1
-- False
-- >>> meetsMultiplicity (atLeast 2) 2
-- True
-- >>> meetsMultiplicity (atLeast 2) 3
-- True
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

-- | A 'Multiplicity' that means at most this many times.
--
-- >>> meetsMultiplicity (atMost 2) 1
-- True
-- >>> meetsMultiplicity (atMost 2) 2
-- True
-- >>> meetsMultiplicity (atMost 2) 3
-- False
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

-- | A 'Multiplicity' that means any number in this interval, endpoints
-- included.  For example, @'between' 2 3@ means 2 or 3 times, while
-- @'between' n n@ is equivalent to @n@.
--
-- >>> meetsMultiplicity (between 2 3) 1
-- False
-- >>> meetsMultiplicity (between 2 3) 2
-- True
-- >>> meetsMultiplicity (between 2 3) 3
-- True
-- >>> meetsMultiplicity (between 2 3) 4
-- False
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

-- | Checks whether a 'Multiplicity' is capable of matching any number at all.
--
-- >>> feasible once
-- True
-- >>> feasible 0
-- True
-- >>> feasible (once - 2)
-- False
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