{-# 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 { StreamlyEffects -> LogSeverity -> Text -> IO ()
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 :: 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 #-}

-- | IO with a ReaderTlayer we can use to expose effects we need.  For now just logging.
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)

-- | 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 :: 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 #-}

-- | 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 :: 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 #-}