{-# LANGUAGE PackageImports #-} module Language.PureScript.Ide.Logging ( runLogger , logPerf , displayTimeSpec , labelTimespec ) where import Protolude import "monad-logger" Control.Monad.Logger (LogLevel(..), LoggingT, MonadLogger, filterLogger, logOtherN, runStdoutLoggingT) import Data.Text qualified as T import Language.PureScript.Ide.Types (IdeLogLevel(..)) import System.Clock (Clock(..), TimeSpec, diffTimeSpec, getTime, toNanoSecs) import Text.Printf (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"