{-# LANGUAGE PackageImports        #-}

module Language.PureScript.Ide.Logging
       ( runLogger
       , logPerf
       , displayTimeSpec
       , labelTimespec
       ) where

import           Protolude

import           "monad-logger" Control.Monad.Logger
import qualified Data.Text as T
import           Language.PureScript.Ide.Types
import           System.Clock
import           Text.Printf

runLogger :: MonadIO m => IdeLogLevel -> LoggingT m a -> m a
runLogger :: forall (m :: * -> *) a.
MonadIO m =>
IdeLogLevel -> LoggingT m a -> m a
runLogger IdeLogLevel
logLevel' =
  forall (m :: * -> *) a. MonadIO m => LoggingT m a -> m a
runStdoutLoggingT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
(Text -> LogLevel -> Bool) -> LoggingT m a -> LoggingT m a
filterLogger (\Text
_ LogLevel
logLevel ->
                                       case IdeLogLevel
logLevel' of
                                         IdeLogLevel
LogAll -> Bool
True
                                         IdeLogLevel
LogDefault -> Bool -> Bool
not (LogLevel
logLevel forall a. Eq a => a -> a -> Bool
== Text -> LogLevel
LevelOther Text
"perf" Bool -> Bool -> Bool
|| LogLevel
logLevel forall a. Eq a => a -> a -> Bool
== LogLevel
LevelDebug)
                                         IdeLogLevel
LogNone -> Bool
False
                                         IdeLogLevel
LogDebug -> LogLevel
logLevel forall a. Eq a => a -> a -> Bool
/= Text -> LogLevel
LevelOther Text
"perf"
                                         IdeLogLevel
LogPerf -> LogLevel
logLevel forall a. Eq a => a -> a -> Bool
== Text -> LogLevel
LevelOther Text
"perf")

labelTimespec :: Text -> TimeSpec -> Text
labelTimespec :: Text -> TimeSpec -> Text
labelTimespec Text
label TimeSpec
duration = Text
label forall a. Semigroup a => a -> a -> a
<> Text
": " forall a. Semigroup a => a -> a -> a
<> TimeSpec -> Text
displayTimeSpec TimeSpec
duration

logPerf :: (MonadIO m, MonadLogger m) => (TimeSpec -> Text) -> m t -> m t
logPerf :: forall (m :: * -> *) t.
(MonadIO m, MonadLogger m) =>
(TimeSpec -> Text) -> m t -> m t
logPerf TimeSpec -> Text
format m t
f = do
  TimeSpec
start <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Clock -> IO TimeSpec
getTime Clock
Monotonic)
  t
result <- m t
f
  TimeSpec
end <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Clock -> IO TimeSpec
getTime Clock
Monotonic)
  forall (m :: * -> *). MonadLogger m => LogLevel -> Text -> m ()
logOtherN (Text -> LogLevel
LevelOther Text
"perf") (TimeSpec -> Text
format (TimeSpec -> TimeSpec -> TimeSpec
diffTimeSpec TimeSpec
start TimeSpec
end))
  forall (f :: * -> *) a. Applicative f => a -> f a
pure t
result

displayTimeSpec :: TimeSpec -> Text
displayTimeSpec :: TimeSpec -> Text
displayTimeSpec TimeSpec
ts =
  String -> Text
T.pack (forall r. PrintfType r => String -> r
printf String
"%0.2f" (forall a b. (Integral a, Num b) => a -> b
fromIntegral (TimeSpec -> Integer
toNanoSecs TimeSpec
ts) forall a. Fractional a => a -> a -> a
/ Double
1000000 :: Double)) forall a. Semigroup a => a -> a -> a
<> Text
"ms"