{-# LANGUAGE DataKinds #-} {-# LANGUAGE DerivingVia #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE UndecidableInstances #-} module Knit.Utilities.Streamly ( StreamlyM , StreamlyEffects(..) , streamlyToKnit , streamlyToKnitS , logStreamly ) where import qualified Knit.Report as Knit import qualified Knit.Effect.Logger as Knit.Logger import qualified Streamly import qualified Streamly.Internal.Prelude as Streamly import qualified Polysemy --import qualified Polysemy.Error --import Control.Monad.Catch (SomeException) import qualified Control.Monad.Reader as Reader import Control.Monad.Catch (MonadThrow, MonadCatch) import Control.Monad.Base (MonadBase) import Control.Monad.Trans.Control (MonadBaseControl) import qualified Data.Text as Text -- | record-of-functions to hold access to effects we want to have available in this -- ReaderT over IO wrapper for Streamly data StreamlyEffects = StreamlyEffects { logIO :: Knit.Logger.LogSeverity -> Text.Text -> IO () } -- | Use the logging function in the Reader to log in a StreamlyM context. logStreamly :: Knit.Logger.LogSeverity -> Text.Text -> StreamlyM () logStreamly ls t = do logFunction <- Reader.asks logIO Reader.liftIO $ logFunction ls t {-# INLINEABLE logStreamly #-} -- | IO with a ReaderTlayer we can use to expose effects we need. For now just logging. newtype StreamlyM a = StreamlyM { unStreamlyM :: Reader.ReaderT StreamlyEffects IO a } deriving newtype (Functor, Applicative, Monad, Reader.MonadReader StreamlyEffects) deriving (MonadThrow, MonadCatch, Reader.MonadIO, MonadBase IO, MonadBaseControl IO) via (Reader.ReaderT StreamlyEffects IO) -- | lift a 'StreamlyM' computation into a 'Knit.Sem' computation streamlyToKnit :: (Polysemy.Member (Polysemy.Embed IO) r , Knit.Logger.LogWithPrefixesLE r ) => StreamlyM a -> Knit.Sem r a streamlyToKnit sa = do curPrefix <- Knit.Logger.getPrefix let logFunction = Knit.Logger.logWithPrefixToIO se = StreamlyEffects (\ls lmsg -> logFunction curPrefix (Knit.Logger.LogEntry ls lmsg)) Polysemy.embed $ Reader.runReaderT (unStreamlyM sa) se {-# INLINEABLE streamlyToKnit #-} -- | Serial streams work fine over Sem, so we can lift the effectful serial stream into @Sem r@ without running. streamlyToKnitS :: (Polysemy.Member (Polysemy.Embed IO) r , Knit.Logger.LogWithPrefixesLE r ) => Streamly.SerialT StreamlyM a -> Streamly.SerialT (Knit.Sem r) a streamlyToKnitS = Streamly.hoist streamlyToKnit {-# INLINEABLE streamlyToKnitS #-}