{-|
Module      : Gargantext.Utils.UTCTime
Description : Gargantext utilities
Copyright   : (c) CNRS, 2017
License     : AGPL + CECILL v3
Maintainer  : team@gargantext.org
Stability   : experimental
Portability : POSIX
-}


{-# LANGUAGE DeriveAnyClass             #-}
{-# LANGUAGE TemplateHaskell            #-}
{-# LANGUAGE TypeFamilies               #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE TypeApplications #-}

module Gargantext.Utils.UTCTime where

import Data.Fixed (Fixed(..))
import Data.Morpheus.Kind (SCALAR)
import Data.Morpheus.Types (GQLType(..), DecodeScalar(..), EncodeScalar(..))
import Data.Morpheus.Types qualified as DMT
import Data.String (fromString)
import Data.Swagger (ToSchema (..))
import Data.Text qualified as T
import Data.Time.Clock.POSIX (getPOSIXTime, POSIXTime)
import Data.Time (UTCTime, nominalDiffTimeToSeconds)
import Data.TreeDiff.Class
import Gargantext.Prelude
import Gargantext.System.Logging
import Prelude (String)
import Test.QuickCheck hiding (label)


newtype NUTCTime = NUTCTime UTCTime
  deriving (Eq, Show, Generic)
  deriving newtype NFData
instance DecodeScalar NUTCTime where
  decodeScalar (DMT.String x) = case (readEither $ T.unpack x) of
    Right r  -> pure $ NUTCTime r
    Left err -> Left $ T.pack err
  decodeScalar          _ = Left "Invalid value for NUTCTime"
instance EncodeScalar NUTCTime where
  encodeScalar (NUTCTime x) = DMT.String $ T.pack $ show x
instance GQLType NUTCTime where
  type KIND NUTCTime = SCALAR
instance FromJSON NUTCTime
instance ToJSON NUTCTime
instance ToSchema NUTCTime

newtype ElapsedSeconds = ElapsedSeconds { _Seconds :: POSIXTime }
  deriving stock (Show, Eq, Generic)
  deriving newtype (FromJSON, ToJSON, Num)

instance NFData ElapsedSeconds

instance ToExpr ElapsedSeconds where
  toExpr (ElapsedSeconds x) =
    let (MkFixed secs) = nominalDiffTimeToSeconds x
    in toExpr secs

instance ToSchema ElapsedSeconds where
  declareNamedSchema _ = declareNamedSchema (Proxy @Int)

instance Arbitrary ElapsedSeconds where
  arbitrary = ElapsedSeconds . fromInteger . getPositive <$> arbitrary

timeMeasured :: (MonadLogger m, MonadBase IO m, HasCallStack)
             => String
             -- ^ A label
             -> m a
             -- ^ The action to run
             -> m a
timeMeasured = withFrozenCallStack $ timeMeasured' DEBUG

-- | A version of timeMeasured that also returns the elapsed time, in seconds.
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 (ElapsedSeconds, a)
timeMeasured'' severity label action = withFrozenCallStack $ do
  startTime <- liftBase getPOSIXTime
  res       <- action
  endTime   <- liftBase getPOSIXTime
  let finalTime = endTime - startTime
  let msg = label <> " took " <> (show finalTime) <> " seconds to execute."
  $(logLocM) severity (fromString msg)
  pure (ElapsedSeconds finalTime, res)

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 $
  snd <$> timeMeasured'' severity label action