{-# LANGUAGE FlexibleContexts #-}
{-# OPTIONS_GHC -Wno-missing-export-lists #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
{-# HLINT ignore "Use null" #-}
{-# OPTIONS_GHC -Wno-name-shadowing #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Test.MockCat.Internal.Types where

import Control.Monad (ap)
import Control.Concurrent.STM (TVar)
import Data.Maybe
import GHC.IO (unsafePerformIO)
import Test.MockCat.AssociationList (AssociationList)
import Prelude hiding (lookup)
import Control.Monad.State ( State )

data InvocationRecorder params = InvocationRecorder
  { forall params.
InvocationRecorder params -> TVar (InvocationRecord params)
invocationRef :: TVar (InvocationRecord params)
  , forall params. InvocationRecorder params -> FunctionNature
functionNature :: FunctionNature
  }

-- | Result of building a mock: function plus its recorder.
data BuiltMock fn params = BuiltMock
  { forall fn params. BuiltMock fn params -> fn
builtMockFn :: fn
  , forall fn params. BuiltMock fn params -> InvocationRecorder params
builtMockRecorder :: InvocationRecorder params
  }

data FunctionNature
  = PureConstant
  | IOConstant
  | ParametricFunction
  deriving (FunctionNature -> FunctionNature -> Bool
(FunctionNature -> FunctionNature -> Bool)
-> (FunctionNature -> FunctionNature -> Bool) -> Eq FunctionNature
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FunctionNature -> FunctionNature -> Bool
== :: FunctionNature -> FunctionNature -> Bool
$c/= :: FunctionNature -> FunctionNature -> Bool
/= :: FunctionNature -> FunctionNature -> Bool
Eq, Int -> FunctionNature -> ShowS
[FunctionNature] -> ShowS
FunctionNature -> String
(Int -> FunctionNature -> ShowS)
-> (FunctionNature -> String)
-> ([FunctionNature] -> ShowS)
-> Show FunctionNature
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FunctionNature -> ShowS
showsPrec :: Int -> FunctionNature -> ShowS
$cshow :: FunctionNature -> String
show :: FunctionNature -> String
$cshowList :: [FunctionNature] -> ShowS
showList :: [FunctionNature] -> ShowS
Show)

type InvocationList params = [params]
type InvocationCounts params = AssociationList params Int

data InvocationRecord params = InvocationRecord {
  forall params. InvocationRecord params -> InvocationList params
invocations :: InvocationList params,
  forall params. InvocationRecord params -> InvocationCounts params
invocationCounts :: InvocationCounts params
}
  deriving (InvocationRecord params -> InvocationRecord params -> Bool
(InvocationRecord params -> InvocationRecord params -> Bool)
-> (InvocationRecord params -> InvocationRecord params -> Bool)
-> Eq (InvocationRecord params)
forall params.
Eq params =>
InvocationRecord params -> InvocationRecord params -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall params.
Eq params =>
InvocationRecord params -> InvocationRecord params -> Bool
== :: InvocationRecord params -> InvocationRecord params -> Bool
$c/= :: forall params.
Eq params =>
InvocationRecord params -> InvocationRecord params -> Bool
/= :: InvocationRecord params -> InvocationRecord params -> Bool
Eq, Int -> InvocationRecord params -> ShowS
[InvocationRecord params] -> ShowS
InvocationRecord params -> String
(Int -> InvocationRecord params -> ShowS)
-> (InvocationRecord params -> String)
-> ([InvocationRecord params] -> ShowS)
-> Show (InvocationRecord params)
forall params.
Show params =>
Int -> InvocationRecord params -> ShowS
forall params. Show params => [InvocationRecord params] -> ShowS
forall params. Show params => InvocationRecord params -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall params.
Show params =>
Int -> InvocationRecord params -> ShowS
showsPrec :: Int -> InvocationRecord params -> ShowS
$cshow :: forall params. Show params => InvocationRecord params -> String
show :: InvocationRecord params -> String
$cshowList :: forall params. Show params => [InvocationRecord params] -> ShowS
showList :: [InvocationRecord params] -> ShowS
Show)

data CountVerifyMethod
  = Equal Int
  | LessThanEqual Int
  | GreaterThanEqual Int
  | LessThan Int
  | GreaterThan Int

instance Show CountVerifyMethod where
  show :: CountVerifyMethod -> String
show (Equal Int
e) = Int -> String
forall a. Show a => a -> String
show Int
e
  show (LessThanEqual Int
e) = String
"<= " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
e
  show (LessThan Int
e) = String
"< " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
e
  show (GreaterThanEqual Int
e) = String
">= " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
e
  show (GreaterThan Int
e) = String
"> " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
e

newtype Cases a b = Cases (State [a] b)

instance Functor (Cases a) where
  fmap :: forall a b. (a -> b) -> Cases a a -> Cases a b
fmap a -> b
f (Cases State [a] a
s) = State [a] b -> Cases a b
forall a b. State [a] b -> Cases a b
Cases ((a -> b) -> State [a] a -> State [a] b
forall a b.
(a -> b) -> StateT [a] Identity a -> StateT [a] Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f State [a] a
s)

instance Applicative (Cases a) where
  pure :: forall a. a -> Cases a a
pure a
x = State [a] a -> Cases a a
forall a b. State [a] b -> Cases a b
Cases (State [a] a -> Cases a a) -> State [a] a -> Cases a a
forall a b. (a -> b) -> a -> b
$ a -> State [a] a
forall a. a -> StateT [a] Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
  <*> :: forall a b. Cases a (a -> b) -> Cases a a -> Cases a b
(<*>) = Cases a (a -> b) -> Cases a a -> Cases a b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap

instance Monad (Cases a) where
  (Cases State [a] a
m) >>= :: forall a b. Cases a a -> (a -> Cases a b) -> Cases a b
>>= a -> Cases a b
f = State [a] b -> Cases a b
forall a b. State [a] b -> Cases a b
Cases (State [a] b -> Cases a b) -> State [a] b -> Cases a b
forall a b. (a -> b) -> a -> b
$ do
    a
result <- State [a] a
m
    let (Cases State [a] b
newState) = a -> Cases a b
f a
result
    State [a] b
newState

newtype VerifyFailed = VerifyFailed Message

data VerifyOrderMethod
  = ExactlySequence
  | PartiallySequence

data VerifyOrderResult a = VerifyOrderResult
  { forall a. VerifyOrderResult a -> Int
index :: Int,
    forall a. VerifyOrderResult a -> a
calledValue :: a,
    forall a. VerifyOrderResult a -> a
expectedValue :: a
  }

type Message = String

data VerifyMatchType a = MatchAny a | MatchAll a

type MockName = String

safeIndex :: [a] -> Int -> Maybe a
safeIndex :: forall a. [a] -> Int -> Maybe a
safeIndex [a]
xs Int
n
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = Maybe a
forall a. Maybe a
Nothing
  | Bool
otherwise = [a] -> Maybe a
forall a. [a] -> Maybe a
listToMaybe (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop Int
n [a]
xs)

{-# NOINLINE perform #-}
perform :: IO a -> a
perform :: forall a. IO a -> a
perform = IO a -> a
forall a. IO a -> a
unsafePerformIO