{-# 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 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
data StreamlyEffects = StreamlyEffects { StreamlyEffects -> LogSeverity -> Text -> IO ()
logIO :: Knit.Logger.LogSeverity -> Text.Text -> IO () }
logStreamly :: Knit.Logger.LogSeverity -> Text.Text -> StreamlyM ()
logStreamly :: LogSeverity -> Text -> StreamlyM ()
logStreamly ls :: LogSeverity
ls t :: Text
t = do
LogSeverity -> Text -> IO ()
logFunction <- (StreamlyEffects -> LogSeverity -> Text -> IO ())
-> StreamlyM (LogSeverity -> Text -> IO ())
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
Reader.asks StreamlyEffects -> LogSeverity -> Text -> IO ()
logIO
IO () -> StreamlyM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
Reader.liftIO (IO () -> StreamlyM ()) -> IO () -> StreamlyM ()
forall a b. (a -> b) -> a -> b
$ LogSeverity -> Text -> IO ()
logFunction LogSeverity
ls Text
t
{-# INLINEABLE logStreamly #-}
newtype StreamlyM a = StreamlyM { StreamlyM a -> ReaderT StreamlyEffects IO a
unStreamlyM :: Reader.ReaderT StreamlyEffects IO a }
deriving newtype (a -> StreamlyM b -> StreamlyM a
(a -> b) -> StreamlyM a -> StreamlyM b
(forall a b. (a -> b) -> StreamlyM a -> StreamlyM b)
-> (forall a b. a -> StreamlyM b -> StreamlyM a)
-> Functor StreamlyM
forall a b. a -> StreamlyM b -> StreamlyM a
forall a b. (a -> b) -> StreamlyM a -> StreamlyM b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> StreamlyM b -> StreamlyM a
$c<$ :: forall a b. a -> StreamlyM b -> StreamlyM a
fmap :: (a -> b) -> StreamlyM a -> StreamlyM b
$cfmap :: forall a b. (a -> b) -> StreamlyM a -> StreamlyM b
Functor, Functor StreamlyM
a -> StreamlyM a
Functor StreamlyM =>
(forall a. a -> StreamlyM a)
-> (forall a b. StreamlyM (a -> b) -> StreamlyM a -> StreamlyM b)
-> (forall a b c.
(a -> b -> c) -> StreamlyM a -> StreamlyM b -> StreamlyM c)
-> (forall a b. StreamlyM a -> StreamlyM b -> StreamlyM b)
-> (forall a b. StreamlyM a -> StreamlyM b -> StreamlyM a)
-> Applicative StreamlyM
StreamlyM a -> StreamlyM b -> StreamlyM b
StreamlyM a -> StreamlyM b -> StreamlyM a
StreamlyM (a -> b) -> StreamlyM a -> StreamlyM b
(a -> b -> c) -> StreamlyM a -> StreamlyM b -> StreamlyM c
forall a. a -> StreamlyM a
forall a b. StreamlyM a -> StreamlyM b -> StreamlyM a
forall a b. StreamlyM a -> StreamlyM b -> StreamlyM b
forall a b. StreamlyM (a -> b) -> StreamlyM a -> StreamlyM b
forall a b c.
(a -> b -> c) -> StreamlyM a -> StreamlyM b -> StreamlyM c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: StreamlyM a -> StreamlyM b -> StreamlyM a
$c<* :: forall a b. StreamlyM a -> StreamlyM b -> StreamlyM a
*> :: StreamlyM a -> StreamlyM b -> StreamlyM b
$c*> :: forall a b. StreamlyM a -> StreamlyM b -> StreamlyM b
liftA2 :: (a -> b -> c) -> StreamlyM a -> StreamlyM b -> StreamlyM c
$cliftA2 :: forall a b c.
(a -> b -> c) -> StreamlyM a -> StreamlyM b -> StreamlyM c
<*> :: StreamlyM (a -> b) -> StreamlyM a -> StreamlyM b
$c<*> :: forall a b. StreamlyM (a -> b) -> StreamlyM a -> StreamlyM b
pure :: a -> StreamlyM a
$cpure :: forall a. a -> StreamlyM a
$cp1Applicative :: Functor StreamlyM
Applicative, Applicative StreamlyM
a -> StreamlyM a
Applicative StreamlyM =>
(forall a b. StreamlyM a -> (a -> StreamlyM b) -> StreamlyM b)
-> (forall a b. StreamlyM a -> StreamlyM b -> StreamlyM b)
-> (forall a. a -> StreamlyM a)
-> Monad StreamlyM
StreamlyM a -> (a -> StreamlyM b) -> StreamlyM b
StreamlyM a -> StreamlyM b -> StreamlyM b
forall a. a -> StreamlyM a
forall a b. StreamlyM a -> StreamlyM b -> StreamlyM b
forall a b. StreamlyM a -> (a -> StreamlyM b) -> StreamlyM b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> StreamlyM a
$creturn :: forall a. a -> StreamlyM a
>> :: StreamlyM a -> StreamlyM b -> StreamlyM b
$c>> :: forall a b. StreamlyM a -> StreamlyM b -> StreamlyM b
>>= :: StreamlyM a -> (a -> StreamlyM b) -> StreamlyM b
$c>>= :: forall a b. StreamlyM a -> (a -> StreamlyM b) -> StreamlyM b
$cp1Monad :: Applicative StreamlyM
Monad, Reader.MonadReader StreamlyEffects)
deriving (Monad StreamlyM
e -> StreamlyM a
Monad StreamlyM =>
(forall e a. Exception e => e -> StreamlyM a)
-> MonadThrow StreamlyM
forall e a. Exception e => e -> StreamlyM a
forall (m :: * -> *).
Monad m =>
(forall e a. Exception e => e -> m a) -> MonadThrow m
throwM :: e -> StreamlyM a
$cthrowM :: forall e a. Exception e => e -> StreamlyM a
$cp1MonadThrow :: Monad StreamlyM
MonadThrow, MonadThrow StreamlyM
MonadThrow StreamlyM =>
(forall e a.
Exception e =>
StreamlyM a -> (e -> StreamlyM a) -> StreamlyM a)
-> MonadCatch StreamlyM
StreamlyM a -> (e -> StreamlyM a) -> StreamlyM a
forall e a.
Exception e =>
StreamlyM a -> (e -> StreamlyM a) -> StreamlyM a
forall (m :: * -> *).
MonadThrow m =>
(forall e a. Exception e => m a -> (e -> m a) -> m a)
-> MonadCatch m
catch :: StreamlyM a -> (e -> StreamlyM a) -> StreamlyM a
$ccatch :: forall e a.
Exception e =>
StreamlyM a -> (e -> StreamlyM a) -> StreamlyM a
$cp1MonadCatch :: MonadThrow StreamlyM
MonadCatch, Monad StreamlyM
Monad StreamlyM =>
(forall a. IO a -> StreamlyM a) -> MonadIO StreamlyM
IO a -> StreamlyM a
forall a. IO a -> StreamlyM a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
liftIO :: IO a -> StreamlyM a
$cliftIO :: forall a. IO a -> StreamlyM a
$cp1MonadIO :: Monad StreamlyM
Reader.MonadIO, MonadBase IO, MonadBaseControl IO) via (Reader.ReaderT StreamlyEffects IO)
streamlyToKnit :: (Polysemy.Member (Polysemy.Embed IO) r
, Knit.Logger.LogWithPrefixesLE r
)
=> StreamlyM a -> Knit.Sem r a
streamlyToKnit :: StreamlyM a -> Sem r a
streamlyToKnit sa :: StreamlyM a
sa = do
Text
curPrefix <- Sem r Text
forall (effs :: [(* -> *) -> * -> *]).
Member PrefixLog effs =>
Sem effs Text
Knit.Logger.getPrefix
let logFunction :: LogWithPrefixIO
logFunction = LogWithPrefixIO
Knit.Logger.logWithPrefixToIO
se :: StreamlyEffects
se = (LogSeverity -> Text -> IO ()) -> StreamlyEffects
StreamlyEffects (\ls :: LogSeverity
ls lmsg :: Text
lmsg -> LogWithPrefixIO
logFunction Text
curPrefix (LogSeverity -> Text -> LogEntry
Knit.Logger.LogEntry LogSeverity
ls Text
lmsg))
IO a -> Sem r a
forall (m :: * -> *) (r :: [(* -> *) -> * -> *]) a.
Member (Embed m) r =>
m a -> Sem r a
Polysemy.embed (IO a -> Sem r a) -> IO a -> Sem r a
forall a b. (a -> b) -> a -> b
$ ReaderT StreamlyEffects IO a -> StreamlyEffects -> IO a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
Reader.runReaderT (StreamlyM a -> ReaderT StreamlyEffects IO a
forall a. StreamlyM a -> ReaderT StreamlyEffects IO a
unStreamlyM StreamlyM a
sa) StreamlyEffects
se
{-# INLINEABLE streamlyToKnit #-}
streamlyToKnitS :: (Polysemy.Member (Polysemy.Embed IO) r
, Knit.Logger.LogWithPrefixesLE r
)
=> Streamly.SerialT StreamlyM a -> Streamly.SerialT (Knit.Sem r) a
streamlyToKnitS :: SerialT StreamlyM a -> SerialT (Sem r) a
streamlyToKnitS = (forall x. StreamlyM x -> Sem r x)
-> SerialT StreamlyM a -> SerialT (Sem r) a
forall (m :: * -> *) (n :: * -> *) a.
(Monad m, Monad n) =>
(forall x. m x -> n x) -> SerialT m a -> SerialT n a
Streamly.hoist forall (r :: [(* -> *) -> * -> *]) a.
(Member (Embed IO) r, LogWithPrefixesLE r) =>
StreamlyM a -> Sem r a
forall x. StreamlyM x -> Sem r x
streamlyToKnit
{-# INLINEABLE streamlyToKnitS #-}