Commit 821d9677 authored by Alfredo Di Napoli's avatar Alfredo Di Napoli

Add the timeMeasured function

It's a useful function to log (with `DEBUG` severity) the execution time
of various functions. Debug logs won't be printed in production.
parent a856c093
...@@ -11,6 +11,7 @@ Portability : POSIX ...@@ -11,6 +11,7 @@ Portability : POSIX
{-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeFamilies #-}
module Gargantext.Utils.UTCTime where module Gargantext.Utils.UTCTime where
...@@ -19,10 +20,14 @@ import Data.Aeson (FromJSON, ToJSON) ...@@ -19,10 +20,14 @@ import Data.Aeson (FromJSON, ToJSON)
import Data.Morpheus.Kind (SCALAR) import Data.Morpheus.Kind (SCALAR)
import Data.Morpheus.Types (GQLType(..), DecodeScalar(..), EncodeScalar(..)) import Data.Morpheus.Types (GQLType(..), DecodeScalar(..), EncodeScalar(..))
import Data.Morpheus.Types qualified as DMT import Data.Morpheus.Types qualified as DMT
import Data.String (fromString)
import Data.Swagger (ToSchema) import Data.Swagger (ToSchema)
import Data.Text qualified as T import Data.Text qualified as T
import Data.Time (UTCTime) import Data.Time (UTCTime)
import Data.Time.Clock.POSIX (getPOSIXTime)
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.System.Logging
import Prelude (String)
newtype NUTCTime = NUTCTime UTCTime newtype NUTCTime = NUTCTime UTCTime
...@@ -39,3 +44,27 @@ instance GQLType NUTCTime where ...@@ -39,3 +44,27 @@ instance GQLType NUTCTime where
instance FromJSON NUTCTime instance FromJSON NUTCTime
instance ToJSON NUTCTime instance ToJSON NUTCTime
instance ToSchema NUTCTime instance ToSchema NUTCTime
timeMeasured :: (MonadLogger m, MonadBase IO m, HasCallStack)
=> String
-- ^ A label
-> m a
-- ^ The action to run
-> m a
timeMeasured = withFrozenCallStack $ timeMeasured' DEBUG
timeMeasured' :: (MonadLogger m, MonadBase IO m, HasCallStack)
=> LogLevel
-- ^ The severity of the log
-> String
-- ^ A label to identify the action.
-> m a
-- ^ The action to run
-> m a
timeMeasured' severity label action = withFrozenCallStack $ do
startTime <- liftBase getPOSIXTime
res <- action
endTime <- liftBase getPOSIXTime
let msg = label <> " took " <> (show $ endTime - startTime) <> " seconds to execute."
$(logLocM) severity (fromString msg)
return res
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment