{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module UntypedPlutusCore.Evaluation.Machine.Cek.EmitterMode (noEmitter, logEmitter, logWithTimeEmitter, logWithBudgetEmitter) where

import UntypedPlutusCore.Evaluation.Machine.Cek.Internal

import Control.Monad.ST.Unsafe (unsafeIOToST)
import Data.ByteString.Builder qualified as BS
import Data.ByteString.Lazy qualified as BSL
import Data.Csv qualified as CSV
import Data.Csv.Builder qualified as CSV
import Data.DList qualified as DList
import Data.Fixed
import Data.Functor
import Data.STRef (modifySTRef, newSTRef, readSTRef)
import Data.Text qualified as T
import Data.Text.Encoding qualified as T
import Data.Time.Clock
import Data.Time.Clock.POSIX
import PlutusCore.Evaluation.Machine.ExBudget
import PlutusCore.Evaluation.Machine.ExMemory

-- | No emitter.
noEmitter :: EmitterMode uni fun
noEmitter :: EmitterMode uni fun
noEmitter = (forall s. ST s ExBudget -> ST s (CekEmitterInfo uni fun s))
-> EmitterMode uni fun
forall (uni :: * -> *) fun.
(forall s. ST s ExBudget -> ST s (CekEmitterInfo uni fun s))
-> EmitterMode uni fun
EmitterMode ((forall s. ST s ExBudget -> ST s (CekEmitterInfo uni fun s))
 -> EmitterMode uni fun)
-> (forall s. ST s ExBudget -> ST s (CekEmitterInfo uni fun s))
-> EmitterMode uni fun
forall a b. (a -> b) -> a -> b
$ \ST s ExBudget
_ -> CekEmitterInfo uni fun s -> ST s (CekEmitterInfo uni fun s)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CekEmitterInfo uni fun s -> ST s (CekEmitterInfo uni fun s))
-> CekEmitterInfo uni fun s -> ST s (CekEmitterInfo uni fun s)
forall a b. (a -> b) -> a -> b
$ CekEmitter uni fun s -> ST s [Text] -> CekEmitterInfo uni fun s
forall (uni :: * -> *) fun s.
CekEmitter uni fun s -> ST s [Text] -> CekEmitterInfo uni fun s
CekEmitterInfo (\DList Text
_ -> () -> CekM uni fun s ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) ([Text] -> ST s [Text]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Text]
forall a. Monoid a => a
mempty)

-- | Emits log only.
logEmitter :: EmitterMode uni fun
logEmitter :: EmitterMode uni fun
logEmitter = (forall s. ST s ExBudget -> ST s (CekEmitterInfo uni fun s))
-> EmitterMode uni fun
forall (uni :: * -> *) fun.
(forall s. ST s ExBudget -> ST s (CekEmitterInfo uni fun s))
-> EmitterMode uni fun
EmitterMode ((forall s. ST s ExBudget -> ST s (CekEmitterInfo uni fun s))
 -> EmitterMode uni fun)
-> (forall s. ST s ExBudget -> ST s (CekEmitterInfo uni fun s))
-> EmitterMode uni fun
forall a b. (a -> b) -> a -> b
$ \ST s ExBudget
_ -> do
    STRef s (DList Text)
logsRef <- DList Text -> ST s (STRef s (DList Text))
forall a s. a -> ST s (STRef s a)
newSTRef DList Text
forall a. DList a
DList.empty
    let emitter :: DList Text -> CekM uni fun s ()
emitter DList Text
logs = ST s () -> CekM uni fun s ()
forall (uni :: * -> *) fun s a. ST s a -> CekM uni fun s a
CekM (ST s () -> CekM uni fun s ()) -> ST s () -> CekM uni fun s ()
forall a b. (a -> b) -> a -> b
$ STRef s (DList Text) -> (DList Text -> DList Text) -> ST s ()
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef STRef s (DList Text)
logsRef (DList Text -> DList Text -> DList Text
forall a. DList a -> DList a -> DList a
`DList.append` DList Text
logs)
    CekEmitterInfo uni fun s -> ST s (CekEmitterInfo uni fun s)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CekEmitterInfo uni fun s -> ST s (CekEmitterInfo uni fun s))
-> CekEmitterInfo uni fun s -> ST s (CekEmitterInfo uni fun s)
forall a b. (a -> b) -> a -> b
$ CekEmitter uni fun s -> ST s [Text] -> CekEmitterInfo uni fun s
forall (uni :: * -> *) fun s.
CekEmitter uni fun s -> ST s [Text] -> CekEmitterInfo uni fun s
CekEmitterInfo CekEmitter uni fun s
forall (uni :: * -> *) fun. DList Text -> CekM uni fun s ()
emitter (DList Text -> [Text]
forall a. DList a -> [a]
DList.toList (DList Text -> [Text]) -> ST s (DList Text) -> ST s [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> STRef s (DList Text) -> ST s (DList Text)
forall s a. STRef s a -> ST s a
readSTRef STRef s (DList Text)
logsRef)

-- A wrapper around encoding a record. `cassava` insists on including a trailing newline, which is
-- annoying since we're recording the output line-by-line.
encodeRecord :: CSV.ToRecord a => a -> T.Text
encodeRecord :: a -> Text
encodeRecord a
a = Text -> Text
T.stripEnd (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
T.decodeUtf8 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BSL.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Builder -> ByteString
BS.toLazyByteString (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$ a -> Builder
forall a. ToRecord a => a -> Builder
CSV.encodeRecord a
a

-- | Emits log with timestamp.
logWithTimeEmitter :: EmitterMode uni fun
logWithTimeEmitter :: EmitterMode uni fun
logWithTimeEmitter = (forall s. ST s ExBudget -> ST s (CekEmitterInfo uni fun s))
-> EmitterMode uni fun
forall (uni :: * -> *) fun.
(forall s. ST s ExBudget -> ST s (CekEmitterInfo uni fun s))
-> EmitterMode uni fun
EmitterMode ((forall s. ST s ExBudget -> ST s (CekEmitterInfo uni fun s))
 -> EmitterMode uni fun)
-> (forall s. ST s ExBudget -> ST s (CekEmitterInfo uni fun s))
-> EmitterMode uni fun
forall a b. (a -> b) -> a -> b
$ \ST s ExBudget
_ -> do
    STRef s (DList Text)
logsRef <- DList Text -> ST s (STRef s (DList Text))
forall a s. a -> ST s (STRef s a)
newSTRef DList Text
forall a. DList a
DList.empty
    let emitter :: DList a -> CekM uni fun s ()
emitter DList a
logs = ST s () -> CekM uni fun s ()
forall (uni :: * -> *) fun s a. ST s a -> CekM uni fun s a
CekM (ST s () -> CekM uni fun s ()) -> ST s () -> CekM uni fun s ()
forall a b. (a -> b) -> a -> b
$ do
            UTCTime
time <- IO UTCTime -> ST s UTCTime
forall a s. IO a -> ST s a
unsafeIOToST IO UTCTime
getCurrentTime
            let secs :: Integer
secs = let MkFixed Integer
s = NominalDiffTime -> Fixed E12
nominalDiffTimeToSeconds (NominalDiffTime -> Fixed E12) -> NominalDiffTime -> Fixed E12
forall a b. (a -> b) -> a -> b
$ UTCTime -> NominalDiffTime
utcTimeToPOSIXSeconds UTCTime
time in Integer
s
            let withTime :: DList Text
withTime = DList a
logs DList a -> (a -> Text) -> DList Text
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \a
str -> (a, Integer) -> Text
forall a. ToRecord a => a -> Text
encodeRecord (a
str, Integer
secs)
            STRef s (DList Text) -> (DList Text -> DList Text) -> ST s ()
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef STRef s (DList Text)
logsRef (DList Text -> DList Text -> DList Text
forall a. DList a -> DList a -> DList a
`DList.append` DList Text
withTime)
    CekEmitterInfo uni fun s -> ST s (CekEmitterInfo uni fun s)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CekEmitterInfo uni fun s -> ST s (CekEmitterInfo uni fun s))
-> CekEmitterInfo uni fun s -> ST s (CekEmitterInfo uni fun s)
forall a b. (a -> b) -> a -> b
$ CekEmitter uni fun s -> ST s [Text] -> CekEmitterInfo uni fun s
forall (uni :: * -> *) fun s.
CekEmitter uni fun s -> ST s [Text] -> CekEmitterInfo uni fun s
CekEmitterInfo CekEmitter uni fun s
forall a (uni :: * -> *) fun.
ToField a =>
DList a -> CekM uni fun s ()
emitter (DList Text -> [Text]
forall a. DList a -> [a]
DList.toList (DList Text -> [Text]) -> ST s (DList Text) -> ST s [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> STRef s (DList Text) -> ST s (DList Text)
forall s a. STRef s a -> ST s a
readSTRef STRef s (DList Text)
logsRef)

instance CSV.ToField ExCPU where
    toField :: ExCPU -> ByteString
toField (ExCPU CostingInteger
t) = Integer -> ByteString
forall a. ToField a => a -> ByteString
CSV.toField (Integer -> ByteString) -> Integer -> ByteString
forall a b. (a -> b) -> a -> b
$ CostingInteger -> Integer
forall a. Integral a => a -> Integer
toInteger CostingInteger
t

instance CSV.ToField ExMemory where
    toField :: ExMemory -> ByteString
toField (ExMemory CostingInteger
t) = Integer -> ByteString
forall a. ToField a => a -> ByteString
CSV.toField (Integer -> ByteString) -> Integer -> ByteString
forall a b. (a -> b) -> a -> b
$ CostingInteger -> Integer
forall a. Integral a => a -> Integer
toInteger CostingInteger
t

-- | Emits log with the budget.
logWithBudgetEmitter :: EmitterMode uni fun
logWithBudgetEmitter :: EmitterMode uni fun
logWithBudgetEmitter = (forall s. ST s ExBudget -> ST s (CekEmitterInfo uni fun s))
-> EmitterMode uni fun
forall (uni :: * -> *) fun.
(forall s. ST s ExBudget -> ST s (CekEmitterInfo uni fun s))
-> EmitterMode uni fun
EmitterMode ((forall s. ST s ExBudget -> ST s (CekEmitterInfo uni fun s))
 -> EmitterMode uni fun)
-> (forall s. ST s ExBudget -> ST s (CekEmitterInfo uni fun s))
-> EmitterMode uni fun
forall a b. (a -> b) -> a -> b
$ \ST s ExBudget
getBudget -> do
    STRef s (DList Text)
logsRef <- DList Text -> ST s (STRef s (DList Text))
forall a s. a -> ST s (STRef s a)
newSTRef DList Text
forall a. DList a
DList.empty
    let emitter :: DList a -> CekM uni fun s ()
emitter DList a
logs = ST s () -> CekM uni fun s ()
forall (uni :: * -> *) fun s a. ST s a -> CekM uni fun s a
CekM (ST s () -> CekM uni fun s ()) -> ST s () -> CekM uni fun s ()
forall a b. (a -> b) -> a -> b
$ do
            ExBudget ExCPU
exCpu ExMemory
exMemory <- ST s ExBudget
getBudget
            let withBudget :: DList Text
withBudget = DList a
logs DList a -> (a -> Text) -> DList Text
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \a
str -> (a, ExCPU, ExMemory) -> Text
forall a. ToRecord a => a -> Text
encodeRecord (a
str, ExCPU
exCpu, ExMemory
exMemory)
            STRef s (DList Text) -> (DList Text -> DList Text) -> ST s ()
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef STRef s (DList Text)
logsRef (DList Text -> DList Text -> DList Text
forall a. DList a -> DList a -> DList a
`DList.append` DList Text
withBudget)
    CekEmitterInfo uni fun s -> ST s (CekEmitterInfo uni fun s)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CekEmitterInfo uni fun s -> ST s (CekEmitterInfo uni fun s))
-> CekEmitterInfo uni fun s -> ST s (CekEmitterInfo uni fun s)
forall a b. (a -> b) -> a -> b
$ CekEmitter uni fun s -> ST s [Text] -> CekEmitterInfo uni fun s
forall (uni :: * -> *) fun s.
CekEmitter uni fun s -> ST s [Text] -> CekEmitterInfo uni fun s
CekEmitterInfo CekEmitter uni fun s
forall a (uni :: * -> *) fun.
ToField a =>
DList a -> CekM uni fun s ()
emitter (DList Text -> [Text]
forall a. DList a -> [a]
DList.toList (DList Text -> [Text]) -> ST s (DList Text) -> ST s [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> STRef s (DList Text) -> ST s (DList Text)
forall s a. STRef s a -> ST s a
readSTRef STRef s (DList Text)
logsRef)