{- |
Module      : GHC.Eventlog.Live.Machine.Decoder
Description : Machines for processing eventlog data.
Stability   : experimental
Portability : portable
-}
module GHC.Eventlog.Live.Machine.Decoder (
  -- * Event decoding
  DecodeError (..),
  decodeEvent,
  decodeEventBatch,
) where

import Control.Exception (Exception, throwIO)
import Control.Monad.IO.Class (MonadIO (..))
import Data.ByteString qualified as BS
import Data.Machine (Is, PlanT, ProcessT, await, construct, yield)
import GHC.Eventlog.Live.Machine.Core (Tick (..), liftTick)
import GHC.RTS.Events (Event)
import GHC.RTS.Events.Incremental (Decoder (..), decodeEventLog)

-------------------------------------------------------------------------------
-- Decoding events

{- |
Parse t'Event's from a stream of 'BS.ByteString' chunks with ticks.

Throws a t'DecodeError' on error.
-}
decodeEvent :: (MonadIO m) => ProcessT m BS.ByteString Event
decodeEvent :: forall (m :: * -> *). MonadIO m => ProcessT m ByteString Event
decodeEvent = PlanT (Is ByteString) Event m ()
-> MachineT m (Is ByteString) Event
forall (m :: * -> *) (k :: * -> *) o a.
Monad m =>
PlanT k o m a -> MachineT m k o
construct (PlanT (Is ByteString) Event m ()
 -> MachineT m (Is ByteString) Event)
-> PlanT (Is ByteString) Event m ()
-> MachineT m (Is ByteString) Event
forall a b. (a -> b) -> a -> b
$ Decoder Event -> PlanT (Is ByteString) Event m ()
forall (m :: * -> *) a.
MonadIO m =>
Decoder a -> PlanT (Is ByteString) a m ()
loop Decoder Event
decodeEventLog
 where
  loop :: (MonadIO m) => Decoder a -> PlanT (Is BS.ByteString) a m ()
  loop :: forall (m :: * -> *) a.
MonadIO m =>
Decoder a -> PlanT (Is ByteString) a m ()
loop Done{} = () -> PlanT (Is ByteString) a m ()
forall a. a -> PlanT (Is ByteString) a m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  loop (Consume ByteString -> Decoder a
k) = PlanT (Is ByteString) a m ByteString
Plan (Is ByteString) a ByteString
forall (k :: * -> * -> *) i o. Category k => Plan (k i) o i
await PlanT (Is ByteString) a m ByteString
-> (ByteString -> PlanT (Is ByteString) a m ())
-> PlanT (Is ByteString) a m ()
forall a b.
PlanT (Is ByteString) a m a
-> (a -> PlanT (Is ByteString) a m b)
-> PlanT (Is ByteString) a m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ByteString
chunk -> Decoder a -> PlanT (Is ByteString) a m ()
forall (m :: * -> *) a.
MonadIO m =>
Decoder a -> PlanT (Is ByteString) a m ()
loop (ByteString -> Decoder a
k ByteString
chunk)
  loop (Produce a
a Decoder a
d') = a -> Plan (Is ByteString) a ()
forall o (k :: * -> *). o -> Plan k o ()
yield a
a PlanT (Is ByteString) a m ()
-> PlanT (Is ByteString) a m () -> PlanT (Is ByteString) a m ()
forall a b.
PlanT (Is ByteString) a m a
-> PlanT (Is ByteString) a m b -> PlanT (Is ByteString) a m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Decoder a -> PlanT (Is ByteString) a m ()
forall (m :: * -> *) a.
MonadIO m =>
Decoder a -> PlanT (Is ByteString) a m ()
loop Decoder a
d'
  loop (Error ByteString
_ String
err) = IO () -> PlanT (Is ByteString) a m ()
forall a. IO a -> PlanT (Is ByteString) a m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> PlanT (Is ByteString) a m ())
-> IO () -> PlanT (Is ByteString) a m ()
forall a b. (a -> b) -> a -> b
$ DecodeError -> IO ()
forall e a. Exception e => e -> IO a
throwIO (DecodeError -> IO ()) -> DecodeError -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> DecodeError
DecodeError String
err

{- |
Parse 'Event's from a stream of 'BS.ByteString' chunks with ticks.

Throws 'DecodeError' on error.
-}
decodeEventBatch :: (MonadIO m) => ProcessT m (Tick BS.ByteString) (Tick Event)
decodeEventBatch :: forall (m :: * -> *).
MonadIO m =>
ProcessT m (Tick ByteString) (Tick Event)
decodeEventBatch = ProcessT m ByteString Event
-> ProcessT m (Tick ByteString) (Tick Event)
forall (m :: * -> *) a b.
Monad m =>
ProcessT m a b -> ProcessT m (Tick a) (Tick b)
liftTick ProcessT m ByteString Event
forall (m :: * -> *). MonadIO m => ProcessT m ByteString Event
decodeEvent

newtype DecodeError = DecodeError String deriving (Int -> DecodeError -> ShowS
[DecodeError] -> ShowS
DecodeError -> String
(Int -> DecodeError -> ShowS)
-> (DecodeError -> String)
-> ([DecodeError] -> ShowS)
-> Show DecodeError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DecodeError -> ShowS
showsPrec :: Int -> DecodeError -> ShowS
$cshow :: DecodeError -> String
show :: DecodeError -> String
$cshowList :: [DecodeError] -> ShowS
showList :: [DecodeError] -> ShowS
Show)

instance Exception DecodeError