Implementation of `MonadReader` instance for `ParserK`

[adithyaov]

The implementation is not straightforward. The following implementation does not work as expected for specific cases. Following is the minimal example to play with,

{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE UndecidableInstances #-}

import Streamly.Data.Stream (Stream)
import Streamly.Data.ParserK (ParserK)
import qualified Streamly.Data.Parser as Parser
import qualified Streamly.Data.ParserK as ParserK
import qualified Streamly.Data.Stream as Stream
import qualified Streamly.Data.StreamK as StreamK
import qualified Streamly.Internal.Data.Parser as Parser
    (Step(..), Initial(..), Parser(..))
import qualified Streamly.Internal.Data.ParserK as ParserK
    (Step(..), ParserK(..), adapt)
import qualified Streamly.Internal.Data.StreamK as StreamK (parse, hoist)
import Control.Monad.Reader

instance MonadReader r m => MonadReader r (ParserK a m) where
    {-# INLINE ask #-}
    ask = ParserK.fromEffect ask
    {-# INLINE local #-}
    local f parser =
      ParserK.MkParser $ \k n st input -> do
          let k1 prev pres i inp = do
                  res <- local (const prev) (k pres i inp)
                  pure $ case res of
                      ParserK.Done i1 r -> ParserK.Done i1 r
                      ParserK.Partial i1 next ->
                          let next1 = local (const prev) . next
                          in ParserK.Partial i1 next1
                      ParserK.Continue i1 next ->
                          let next1 = local (const prev) . next
                          in ParserK.Continue i1 next1
                      ParserK.Error i1 r -> ParserK.Error i1 r
          prev <- ask
          local f (ParserK.runParser parser (k1 prev) n st input)

{-# INLINE anyEvent #-}
anyEvent :: Monad m => Parser.Parser a m (Maybe a)
anyEvent = Parser.Parser step initial extract
  where
  initial = pure $ Parser.IPartial ()
  step _ a = pure $ Parser.Done 0 (Just a)
  extract _ = pure $ Parser.Done 0 Nothing

test_MonadReader :: ParserK Int (ReaderT [Int] IO) ()
test_MonadReader = do
    -- Does not work as expected
    local (1:) $ do
        val <- ask
        liftIO $ putStrLn $ "<[1]:" ++ show val ++ ">"
        _ <- ParserK.adapt anyEvent
        val <- ask
        liftIO $ putStrLn $ "<[1]:" ++ show val ++ ">"
        val <- ask
        liftIO $ putStrLn $ "<[1]:" ++ show val ++ ">"
        _ <- ParserK.adapt anyEvent
        val <- ask
        liftIO $ putStrLn $ "<[1]:" ++ show val ++ ">"
        -- _ <- ParserK.adapt anyEvent
        val <- ask
        liftIO $ putStrLn $ "<[1]:" ++ show val ++ ">"

{-
    -- Works as expected
    val <- ask
    liftIO $ putStrLn $ "<[]:" ++ show val ++ ">"
    local (1:) $ do
        val <- ask
        liftIO $ putStrLn $ "<[1]:" ++ show val ++ ">"
    local (2:) $ do
        val <- ask
        liftIO $ putStrLn $ "<[2]:" ++ show val ++ ">"
        local (3:) $ do
            val <- ask
            liftIO $ putStrLn $ "<[3, 2]:" ++ show val ++ ">"
            local (4:) $ do
                val <- ask
                liftIO $ putStrLn $ "<[4, 3, 2]:" ++ show val ++ ">"
    val <- ask
    liftIO $ putStrLn $ "<[]:" ++ show val ++ ">"
-}

run_test_MonadReader :: IO ()
run_test_MonadReader =
    flip runReaderT [] $ do
      res <-
          StreamK.parse
              test_MonadReader
              (StreamK.fromStream (Stream.fromList [0, 1, 2, 3, 4, 5, 6]))
      case res of
        Left err -> error "failed"
        Right val -> pure val

main :: IO ()
main = run_test_MonadReader

[harendra-kumar]

local cannot be implemented for ParserK because there is no way to override all continuations. Earlier also local was implemented for ParserD only and ParserK was converted to ParserD for local.

Ideally, we should remove the usage of local when ParserK is being used, or use ParserD if it is suitable for the use case. Conversion from ParserD to ParserK and then back to ParserD may not be good for performance.

Anyway, I have provided a way to convert ParserK to ParserD in this PR: https://github.com/composewell/streamly/pull/2705 . We can also port this to 0.10.

With this we can use the following instances:

instance (Show r, MonadReader r m) => MonadReader r (Parser a m) where
    {-# INLINE ask #-}
    ask = Parser.fromEffect ask
    {-# INLINE local #-}
    local f (Parser step initial extract) =
        Parser
            ((local f .) . step)
            (local f initial)
            (local f . extract)

instance (Show r, MonadReader r m) => MonadReader r (ParserK a m) where
    {-# INLINE ask #-}
    ask = ParserK.fromEffect ask
    {-# INLINE local #-}
    local f parser = ParserK.adapt $ local f $ ParserK.toParser parser

[adithyaov]

Should the usage of ParserK.toParser be encouraged?