{-# 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.SatInt
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
noEmitter :: EmitterMode uni fun
noEmitter :: forall (uni :: * -> *) fun. 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 a. a -> ST s a
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 a. a -> CekM uni fun s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) ([Text] -> ST s [Text]
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Text]
forall a. Monoid a => a
mempty)
logEmitter :: EmitterMode uni fun
logEmitter :: forall (uni :: * -> *) fun. 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 a. a -> ST s a
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)
encodeRecord :: (CSV.ToRecord a) => a -> T.Text
encodeRecord :: forall a. ToRecord a => 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
logWithTimeEmitter :: EmitterMode uni fun
logWithTimeEmitter :: forall (uni :: * -> *) fun. 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 a. a -> ST s a
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) = Int -> ByteString
forall a. ToField a => a -> ByteString
CSV.toField (Int -> ByteString) -> Int -> ByteString
forall a b. (a -> b) -> a -> b
$ CostingInteger -> Int
unSatInt CostingInteger
t
instance CSV.ToField ExMemory where
toField :: ExMemory -> ByteString
toField (ExMemory CostingInteger
t) = Int -> ByteString
forall a. ToField a => a -> ByteString
CSV.toField (Int -> ByteString) -> Int -> ByteString
forall a b. (a -> b) -> a -> b
$ CostingInteger -> Int
unSatInt CostingInteger
t
logWithBudgetEmitter :: EmitterMode uni fun
logWithBudgetEmitter :: forall (uni :: * -> *) fun. 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 a. a -> ST s a
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)