{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}

-- |
-- Module : Test.Method.Monitor
-- Description:
-- License: BSD-3
-- Maintainer: autotaker@gmail.com
-- Stability: experimental
--
-- Validating method calls by monitoring
module Test.Method.Monitor
  ( Event,
    Monitor,
    newMonitor,
    watch,
    watchBy,
    listenEventLog,
    withMonitor,
    withMonitor_,
    times,
    call,
  )
where

import Control.Method (Method (Args, Base, Ret), decorate)
import Data.Coerce (coerce)
import RIO
  ( MonadIO (liftIO),
    MonadUnliftIO,
    readSomeRef,
  )
import Test.Method.Matcher (Matcher)
import Test.Method.Monitor.Internal
  ( EqUptoShow (EqUptoShow),
    Event (Enter, Leave),
    Monitor (monitorTrace),
    logEvent,
    newMonitor,
    tick,
  )

-- | @watchBy fArgs fRet monitor method@ decorates @method@
-- so that @monitor@ logs the method calls.
-- This function is suited for monitoring multiple methods.
--
-- @fArgs@ and @fRet@ is converter for arguments/return values of given method.
--
-- @
-- foo :: Int -> IO String
-- foo = ...
-- bar :: Int -> String -> IO ()
-- bar = ...
--
-- data MonitorArgs = FooArgs Int | BarArgs (Int,String) deriving(Eq,Show)
-- data MonitorRet = FooRet String | BarRet () deriving(Eq, Show)
--
-- foo' :: Monitor MonitorArgs MonitorRet -> Int -> IO String
-- foo' monitor = watch monitor (FooArgs . toTuple) FooRet foo
-- bar' :: Monitor MonitorArgs MonitorRet -> Int -> String -> IO ()
-- bar' monitor = watch monitor (BarArgs . toTuple) BarRet bar
-- @
{-# INLINEABLE watchBy #-}
watchBy ::
  (Method method, MonadUnliftIO (Base method)) =>
  (Args method -> args) ->
  (Ret method -> ret) ->
  Monitor args ret ->
  method ->
  method
watchBy :: (Args method -> args)
-> (Ret method -> ret) -> Monitor args ret -> method -> method
watchBy Args method -> args
fargs Ret method -> ret
fret Monitor args ret
m method
method = method
method'
  where
    method' :: method
method' = (Args method -> Base method Tick)
-> (Tick -> Either SomeException (Ret method) -> Base method ())
-> (Tick -> method)
-> method
forall method a.
(Method method, MonadUnliftIO (Base method)) =>
(Args method -> Base method a)
-> (a -> Either SomeException (Ret method) -> Base method ())
-> (a -> method)
-> method
decorate Args method -> Base method Tick
forall (m :: * -> *). MonadIO m => Args method -> m Tick
before Tick -> Either SomeException (Ret method) -> Base method ()
forall (m :: * -> *).
MonadIO m =>
Tick -> Either SomeException (Ret method) -> m ()
after (method -> Tick -> method
forall a b. a -> b -> a
const method
method)
    before :: Args method -> m Tick
before Args method
args = do
      Tick
t <- Monitor args ret -> m Tick
forall (m :: * -> *) args ret.
MonadIO m =>
Monitor args ret -> m Tick
tick Monitor args ret
m
      Monitor args ret -> Event args ret -> m ()
forall (m :: * -> *) args ret.
MonadIO m =>
Monitor args ret -> Event args ret -> m ()
logEvent Monitor args ret
m (Tick -> args -> Event args ret
forall args ret. Tick -> args -> Event args ret
Enter Tick
t (Args method -> args
fargs Args method
args))
      Tick -> m Tick
forall (f :: * -> *) a. Applicative f => a -> f a
pure Tick
t
    after :: Tick -> Either SomeException (Ret method) -> m ()
after Tick
t Either SomeException (Ret method)
result = do
      Tick
t' <- Monitor args ret -> m Tick
forall (m :: * -> *) args ret.
MonadIO m =>
Monitor args ret -> m Tick
tick Monitor args ret
m
      Monitor args ret -> Event args ret -> m ()
forall (m :: * -> *) args ret.
MonadIO m =>
Monitor args ret -> Event args ret -> m ()
logEvent Monitor args ret
m (Tick
-> Tick -> Either (EqUptoShow SomeException) ret -> Event args ret
forall args ret.
Tick
-> Tick -> Either (EqUptoShow SomeException) ret -> Event args ret
Leave Tick
t' Tick
t (Either (EqUptoShow SomeException) ret -> Event args ret)
-> Either (EqUptoShow SomeException) ret -> Event args ret
forall a b. (a -> b) -> a -> b
$ Either SomeException ret -> Either (EqUptoShow SomeException) ret
coerce (Either SomeException ret -> Either (EqUptoShow SomeException) ret)
-> Either SomeException ret
-> Either (EqUptoShow SomeException) ret
forall a b. (a -> b) -> a -> b
$ (Ret method -> ret)
-> Either SomeException (Ret method) -> Either SomeException ret
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Ret method -> ret
fret Either SomeException (Ret method)
result)

-- | Simplified version of 'watchBy'. It is suitable to monitor single method.
{-# INLINE watch #-}
watch ::
  (Method method, MonadUnliftIO (Base method)) =>
  Monitor (Args method) (Ret method) ->
  method ->
  method
watch :: Monitor (Args method) (Ret method) -> method -> method
watch = (Args method -> Args method)
-> (Ret method -> Ret method)
-> Monitor (Args method) (Ret method)
-> method
-> method
forall method args ret.
(Method method, MonadUnliftIO (Base method)) =>
(Args method -> args)
-> (Ret method -> ret) -> Monitor args ret -> method -> method
watchBy Args method -> Args method
forall a. a -> a
id Ret method -> Ret method
forall a. a -> a
id

-- | Get current event logs from monitor
{-# INLINE listenEventLog #-}
listenEventLog :: MonadIO m => Monitor args ret -> m [Event args ret]
listenEventLog :: Monitor args ret -> m [Event args ret]
listenEventLog Monitor args ret
m = [Event args ret] -> [Event args ret]
forall a. [a] -> [a]
reverse ([Event args ret] -> [Event args ret])
-> m [Event args ret] -> m [Event args ret]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SomeRef [Event args ret] -> m [Event args ret]
forall (m :: * -> *) a. MonadIO m => SomeRef a -> m a
readSomeRef (Monitor args ret -> SomeRef [Event args ret]
forall args ret. Monitor args ret -> SomeRef [Event args ret]
monitorTrace Monitor args ret
m)

-- | @'times' countMatcher eventMatcher@ counts events that matches @eventMatcher@,
--   and then the count matches @countMatcher@
times :: Matcher Int -> Matcher (Event args ret) -> Matcher [Event args ret]
times :: Matcher Int -> Matcher (Event args ret) -> Matcher [Event args ret]
times Matcher Int
countMatcher Matcher (Event args ret)
eventMatcher =
  Matcher Int
countMatcher Matcher Int
-> ([Event args ret] -> Int) -> Matcher [Event args ret]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Event args ret] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Event args ret] -> Int)
-> ([Event args ret] -> [Event args ret])
-> [Event args ret]
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Matcher (Event args ret) -> [Event args ret] -> [Event args ret]
forall a. (a -> Bool) -> [a] -> [a]
filter Matcher (Event args ret)
eventMatcher

-- | @'call' matcher@ matches method call whose arguments matches @matcher@
call :: Matcher args -> Matcher (Event args ret)
call :: Matcher args -> Matcher (Event args ret)
call Matcher args
argsM (Enter Tick
_ args
args) = Matcher args
argsM args
args
call Matcher args
_ Leave {} = Bool
False

-- | @withMonitor f@ calls @f@ with 'Monitor',
-- and then returns monitored event logs during the function call
-- in addition to the return value of the function call
{-# INLINE withMonitor #-}
withMonitor :: MonadIO m => (Monitor args ret -> m a) -> m (a, [Event args ret])
withMonitor :: (Monitor args ret -> m a) -> m (a, [Event args ret])
withMonitor Monitor args ret -> m a
f = do
  Monitor args ret
monitor <- IO (Monitor args ret) -> m (Monitor args ret)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (Monitor args ret)
forall args ret. IO (Monitor args ret)
newMonitor
  a
r <- Monitor args ret -> m a
f Monitor args ret
monitor
  [Event args ret]
logs <- Monitor args ret -> m [Event args ret]
forall (m :: * -> *) args ret.
MonadIO m =>
Monitor args ret -> m [Event args ret]
listenEventLog Monitor args ret
monitor
  (a, [Event args ret]) -> m (a, [Event args ret])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
r, [Event args ret]
logs)

-- | @withMonitor_ f@ calls @f@ with 'Monitor', and returns event logs during the call.
{-# INLINE withMonitor_ #-}
withMonitor_ :: MonadIO m => (Monitor args ret -> m ()) -> m [Event args ret]
withMonitor_ :: (Monitor args ret -> m ()) -> m [Event args ret]
withMonitor_ Monitor args ret -> m ()
f = do
  Monitor args ret
monitor <- IO (Monitor args ret) -> m (Monitor args ret)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (Monitor args ret)
forall args ret. IO (Monitor args ret)
newMonitor
  Monitor args ret -> m ()
f Monitor args ret
monitor
  Monitor args ret -> m [Event args ret]
forall (m :: * -> *) args ret.
MonadIO m =>
Monitor args ret -> m [Event args ret]
listenEventLog Monitor args ret
monitor