{-# 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.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 (\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 :: Text -> CekM uni fun s ()
emitter Text
str = 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 -> Text -> DList Text
forall a. DList a -> a -> DList a
`DList.snoc` Text
str)
    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. 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 :: a -> CekM uni fun s ()
emitter a
str = 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 :: Text
withTime = (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 -> Text -> DList Text
forall a. DList a -> a -> DList a
`DList.snoc` 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 => 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 :: a -> CekM uni fun s ()
emitter a
str = 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 :: Text
withBudget = (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 -> Text -> DList Text
forall a. DList a -> a -> DList a
`DList.snoc` 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 => 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)