{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeFamilies #-}

module Test.Method.Behavior
  ( Behave (..),
    thenReturn,
    thenAction,
  )
where

import Control.Method (Method (Base, Ret, curryMethod))

-- | A type class whose behavior is specified by a method
class Behave x where
  -- | Type of the first argument of 'thenMethod',
  --   representing the condition when the method is called
  type Condition x

  -- | Type of the second argument of 'thenMethod',
  --   representing a method to be called.
  type MethodOf x

  -- | Specify behavior from a pair of a condition and a method.
  thenMethod :: Condition x -> MethodOf x -> x

-- | Specify behavior that return a constant value for a call
thenReturn ::
  (Behave x, Method (MethodOf x)) =>
  Condition x ->
  Ret (MethodOf x) ->
  x
thenReturn :: Condition x -> Ret (MethodOf x) -> x
thenReturn Condition x
lhs Ret (MethodOf x)
v =
  Condition x -> MethodOf x -> x
forall x. Behave x => Condition x -> MethodOf x -> x
thenMethod Condition x
lhs (MethodOf x -> x) -> MethodOf x -> x
forall a b. (a -> b) -> a -> b
$ (Args (MethodOf x) -> Base (MethodOf x) (Ret (MethodOf x)))
-> MethodOf x
forall method.
Method method =>
(Args method -> Base method (Ret method)) -> method
curryMethod ((Args (MethodOf x) -> Base (MethodOf x) (Ret (MethodOf x)))
 -> MethodOf x)
-> (Args (MethodOf x) -> Base (MethodOf x) (Ret (MethodOf x)))
-> MethodOf x
forall a b. (a -> b) -> a -> b
$ Base (MethodOf x) (Ret (MethodOf x))
-> Args (MethodOf x) -> Base (MethodOf x) (Ret (MethodOf x))
forall a b. a -> b -> a
const (Base (MethodOf x) (Ret (MethodOf x))
 -> Args (MethodOf x) -> Base (MethodOf x) (Ret (MethodOf x)))
-> Base (MethodOf x) (Ret (MethodOf x))
-> Args (MethodOf x)
-> Base (MethodOf x) (Ret (MethodOf x))
forall a b. (a -> b) -> a -> b
$ Ret (MethodOf x) -> Base (MethodOf x) (Ret (MethodOf x))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ret (MethodOf x)
v

-- | Specify behavior that executes an action for a call
thenAction ::
  (Behave x, Method (MethodOf x)) =>
  Condition x ->
  Base (MethodOf x) (Ret (MethodOf x)) ->
  x
thenAction :: Condition x -> Base (MethodOf x) (Ret (MethodOf x)) -> x
thenAction Condition x
lhs Base (MethodOf x) (Ret (MethodOf x))
action =
  Condition x -> MethodOf x -> x
forall x. Behave x => Condition x -> MethodOf x -> x
thenMethod Condition x
lhs (MethodOf x -> x) -> MethodOf x -> x
forall a b. (a -> b) -> a -> b
$ (Args (MethodOf x) -> Base (MethodOf x) (Ret (MethodOf x)))
-> MethodOf x
forall method.
Method method =>
(Args method -> Base method (Ret method)) -> method
curryMethod ((Args (MethodOf x) -> Base (MethodOf x) (Ret (MethodOf x)))
 -> MethodOf x)
-> (Args (MethodOf x) -> Base (MethodOf x) (Ret (MethodOf x)))
-> MethodOf x
forall a b. (a -> b) -> a -> b
$ Base (MethodOf x) (Ret (MethodOf x))
-> Args (MethodOf x) -> Base (MethodOf x) (Ret (MethodOf x))
forall a b. a -> b -> a
const Base (MethodOf x) (Ret (MethodOf x))
action