{-# LANGUAGE UndecidableInstances #-}

module Mensam.Server.Server.Handler.Profiler where

import Mensam.Server.Server.Handler.Profiler.Class

import Control.Monad.IO.Class
import Control.Monad.Logger.CallStack
import Control.Monad.Trans.Class
import Control.Monad.Trans.Compose
import Control.Monad.Trans.Control
import Control.Monad.Trans.Control.Identity
import Control.Monad.Trans.Reader
import Data.Kind
import Data.Text qualified as T
import Data.Time.Clock.POSIX qualified as Clock

type ProfilerT :: (Type -> Type) -> Type -> Type
newtype ProfilerT m a = ProfilerT {forall (m :: * -> *) a. ProfilerT m a -> ReaderT POSIXTime m a
unProfilerT :: ReaderT Clock.POSIXTime m a}
  deriving newtype (Functor (ProfilerT m)
Functor (ProfilerT m) =>
(forall a. a -> ProfilerT m a)
-> (forall a b.
    ProfilerT m (a -> b) -> ProfilerT m a -> ProfilerT m b)
-> (forall a b c.
    (a -> b -> c) -> ProfilerT m a -> ProfilerT m b -> ProfilerT m c)
-> (forall a b. ProfilerT m a -> ProfilerT m b -> ProfilerT m b)
-> (forall a b. ProfilerT m a -> ProfilerT m b -> ProfilerT m a)
-> Applicative (ProfilerT m)
forall a. a -> ProfilerT m a
forall a b. ProfilerT m a -> ProfilerT m b -> ProfilerT m a
forall a b. ProfilerT m a -> ProfilerT m b -> ProfilerT m b
forall a b. ProfilerT m (a -> b) -> ProfilerT m a -> ProfilerT m b
forall a b c.
(a -> b -> c) -> ProfilerT m a -> ProfilerT m b -> ProfilerT m c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
forall (m :: * -> *). Applicative m => Functor (ProfilerT m)
forall (m :: * -> *) a. Applicative m => a -> ProfilerT m a
forall (m :: * -> *) a b.
Applicative m =>
ProfilerT m a -> ProfilerT m b -> ProfilerT m a
forall (m :: * -> *) a b.
Applicative m =>
ProfilerT m a -> ProfilerT m b -> ProfilerT m b
forall (m :: * -> *) a b.
Applicative m =>
ProfilerT m (a -> b) -> ProfilerT m a -> ProfilerT m b
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> ProfilerT m a -> ProfilerT m b -> ProfilerT m c
$cpure :: forall (m :: * -> *) a. Applicative m => a -> ProfilerT m a
pure :: forall a. a -> ProfilerT m a
$c<*> :: forall (m :: * -> *) a b.
Applicative m =>
ProfilerT m (a -> b) -> ProfilerT m a -> ProfilerT m b
<*> :: forall a b. ProfilerT m (a -> b) -> ProfilerT m a -> ProfilerT m b
$cliftA2 :: forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> ProfilerT m a -> ProfilerT m b -> ProfilerT m c
liftA2 :: forall a b c.
(a -> b -> c) -> ProfilerT m a -> ProfilerT m b -> ProfilerT m c
$c*> :: forall (m :: * -> *) a b.
Applicative m =>
ProfilerT m a -> ProfilerT m b -> ProfilerT m b
*> :: forall a b. ProfilerT m a -> ProfilerT m b -> ProfilerT m b
$c<* :: forall (m :: * -> *) a b.
Applicative m =>
ProfilerT m a -> ProfilerT m b -> ProfilerT m a
<* :: forall a b. ProfilerT m a -> ProfilerT m b -> ProfilerT m a
Applicative, (forall a b. (a -> b) -> ProfilerT m a -> ProfilerT m b)
-> (forall a b. a -> ProfilerT m b -> ProfilerT m a)
-> Functor (ProfilerT m)
forall a b. a -> ProfilerT m b -> ProfilerT m a
forall a b. (a -> b) -> ProfilerT m a -> ProfilerT m b
forall (m :: * -> *) a b.
Functor m =>
a -> ProfilerT m b -> ProfilerT m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> ProfilerT m a -> ProfilerT m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> ProfilerT m a -> ProfilerT m b
fmap :: forall a b. (a -> b) -> ProfilerT m a -> ProfilerT m b
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> ProfilerT m b -> ProfilerT m a
<$ :: forall a b. a -> ProfilerT m b -> ProfilerT m a
Functor, Applicative (ProfilerT m)
Applicative (ProfilerT m) =>
(forall a b.
 ProfilerT m a -> (a -> ProfilerT m b) -> ProfilerT m b)
-> (forall a b. ProfilerT m a -> ProfilerT m b -> ProfilerT m b)
-> (forall a. a -> ProfilerT m a)
-> Monad (ProfilerT m)
forall a. a -> ProfilerT m a
forall a b. ProfilerT m a -> ProfilerT m b -> ProfilerT m b
forall a b. ProfilerT m a -> (a -> ProfilerT m b) -> ProfilerT m b
forall (m :: * -> *). Monad m => Applicative (ProfilerT m)
forall (m :: * -> *) a. Monad m => a -> ProfilerT m a
forall (m :: * -> *) a b.
Monad m =>
ProfilerT m a -> ProfilerT m b -> ProfilerT m b
forall (m :: * -> *) a b.
Monad m =>
ProfilerT m a -> (a -> ProfilerT m b) -> ProfilerT m b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
ProfilerT m a -> (a -> ProfilerT m b) -> ProfilerT m b
>>= :: forall a b. ProfilerT m a -> (a -> ProfilerT m b) -> ProfilerT m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
ProfilerT m a -> ProfilerT m b -> ProfilerT m b
>> :: forall a b. ProfilerT m a -> ProfilerT m b -> ProfilerT m b
$creturn :: forall (m :: * -> *) a. Monad m => a -> ProfilerT m a
return :: forall a. a -> ProfilerT m a
Monad)
  deriving newtype ((forall (m :: * -> *). Monad m => Monad (ProfilerT m)) =>
(forall (m :: * -> *) a. Monad m => m a -> ProfilerT m a)
-> MonadTrans ProfilerT
forall (m :: * -> *). Monad m => Monad (ProfilerT m)
forall (m :: * -> *) a. Monad m => m a -> ProfilerT m a
forall (t :: (* -> *) -> * -> *).
(forall (m :: * -> *). Monad m => Monad (t m)) =>
(forall (m :: * -> *) a. Monad m => m a -> t m a) -> MonadTrans t
$clift :: forall (m :: * -> *) a. Monad m => m a -> ProfilerT m a
lift :: forall (m :: * -> *) a. Monad m => m a -> ProfilerT m a
MonadTrans, MonadTrans ProfilerT
MonadTrans ProfilerT =>
(forall (m :: * -> *) a.
 Monad m =>
 (Run ProfilerT -> m a) -> ProfilerT m a)
-> (forall (m :: * -> *) a.
    Monad m =>
    m (StT ProfilerT a) -> ProfilerT m a)
-> MonadTransControl ProfilerT
forall (m :: * -> *) a.
Monad m =>
m (StT ProfilerT a) -> ProfilerT m a
forall (m :: * -> *) a.
Monad m =>
(Run ProfilerT -> m a) -> ProfilerT m a
forall (t :: (* -> *) -> * -> *).
MonadTrans t =>
(forall (m :: * -> *) a. Monad m => (Run t -> m a) -> t m a)
-> (forall (m :: * -> *) a. Monad m => m (StT t a) -> t m a)
-> MonadTransControl t
$cliftWith :: forall (m :: * -> *) a.
Monad m =>
(Run ProfilerT -> m a) -> ProfilerT m a
liftWith :: forall (m :: * -> *) a.
Monad m =>
(Run ProfilerT -> m a) -> ProfilerT m a
$crestoreT :: forall (m :: * -> *) a.
Monad m =>
m (StT ProfilerT a) -> ProfilerT m a
restoreT :: forall (m :: * -> *) a.
Monad m =>
m (StT ProfilerT a) -> ProfilerT m a
MonadTransControl, MonadTransControl ProfilerT
MonadTransControl ProfilerT =>
(forall (m :: * -> *) a.
 Monad m =>
 ((forall x. ProfilerT m x -> m x) -> m a) -> ProfilerT m a)
-> MonadTransControlIdentity ProfilerT
forall (m :: * -> *) a.
Monad m =>
((forall x. ProfilerT m x -> m x) -> m a) -> ProfilerT m a
forall (t :: (* -> *) -> * -> *).
MonadTransControl t =>
(forall (m :: * -> *) a.
 Monad m =>
 ((forall x. t m x -> m x) -> m a) -> t m a)
-> MonadTransControlIdentity t
$cliftWithIdentity :: forall (m :: * -> *) a.
Monad m =>
((forall x. ProfilerT m x -> m x) -> m a) -> ProfilerT m a
liftWithIdentity :: forall (m :: * -> *) a.
Monad m =>
((forall x. ProfilerT m x -> m x) -> m a) -> ProfilerT m a
MonadTransControlIdentity)

instance (MonadIO m, MonadLogger m) => MonadProfiler (ProfilerT m) where
  profilerDuration :: ProfilerT m ()
profilerDuration = do
    POSIXTime
referenceTime <- ReaderT POSIXTime m POSIXTime -> ProfilerT m POSIXTime
forall (m :: * -> *) a. ReaderT POSIXTime m a -> ProfilerT m a
ProfilerT ReaderT POSIXTime m POSIXTime
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
    POSIXTime
currentTime <- m POSIXTime -> ProfilerT m POSIXTime
forall (m :: * -> *) a. Monad m => m a -> ProfilerT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m POSIXTime -> ProfilerT m POSIXTime)
-> m POSIXTime -> ProfilerT m POSIXTime
forall a b. (a -> b) -> a -> b
$ IO POSIXTime -> m POSIXTime
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO POSIXTime
Clock.getPOSIXTime
    let duration :: POSIXTime
duration = POSIXTime
currentTime POSIXTime -> POSIXTime -> POSIXTime
forall a. Num a => a -> a -> a
- POSIXTime
referenceTime
    m () -> ProfilerT m ()
forall (m :: * -> *) a. Monad m => m a -> ProfilerT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ProfilerT m ()) -> m () -> ProfilerT m ()
forall a b. (a -> b) -> a -> b
$ LogLevel -> Text -> m ()
forall (m :: * -> *).
(HasCallStack, MonadLogger m) =>
LogLevel -> Text -> m ()
logOther LogLevel
logLevel (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ POSIXTime -> String
forall a. Show a => a -> String
show POSIXTime
duration

deriving via
  ProfilerT ((t2 :: (Type -> Type) -> Type -> Type) m)
  instance
    (MonadIO (t2 m), MonadLogger (t2 m)) => MonadProfiler (ComposeT ProfilerT t2 m)

runProfilerT :: (MonadIO m, MonadLogger m) => ProfilerT m a -> m a
runProfilerT :: forall (m :: * -> *) a.
(MonadIO m, MonadLogger m) =>
ProfilerT m a -> m a
runProfilerT ProfilerT m a
tma = do
  POSIXTime
referenceTime <- IO POSIXTime -> m POSIXTime
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO POSIXTime
Clock.getPOSIXTime
  ReaderT POSIXTime m a -> POSIXTime -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (ProfilerT m a -> ReaderT POSIXTime m a
forall (m :: * -> *) a. ProfilerT m a -> ReaderT POSIXTime m a
unProfilerT (ProfilerT m a
tma ProfilerT m a -> ProfilerT m () -> ProfilerT m a
forall a b. ProfilerT m a -> ProfilerT m b -> ProfilerT m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ProfilerT m ()
forall (m :: * -> *). MonadProfiler m => m ()
profilerDuration)) POSIXTime
referenceTime

logLevel :: LogLevel
logLevel :: LogLevel
logLevel = Text -> LogLevel
LevelOther Text
"Profiler"