{-# LANGUAGE CPP                 #-}
{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE ScopedTypeVariables #-}

-------------------------------------------------------------------------------
-- Combining control flow manipulating monad transformers (MaybeT, exceptT,
-- ContT) with Streamly
-------------------------------------------------------------------------------
--
-- Streamly streams are non-determinism (nested looping) monads. We can use a
-- control flow monad on top or streamly on top depending on whether we want to
-- superimpose control flow manipulation on top of non-deterministic
-- composition or vice-versa.
--
-- This file provides an example where we enter a sequence of characters "x",
-- and "y" on separate lines, on the command line. When any other sequence is
-- entered the control flow short circuits at the first non-matching char and

-- exits.

#if !(MIN_VERSION_base(4,11,0))
import Data.Semigroup (Semigroup(..))
#endif
import Control.Concurrent (threadDelay)
import Control.Exception (catch, SomeException)
import Control.Monad (when, mzero)
import Control.Monad.Catch (MonadThrow, throwM, Exception)
import Control.Monad.IO.Class (MonadIO (..))
import Control.Monad.Trans.Class (MonadTrans(..))
import Control.Monad.Trans.Maybe (MaybeT (..))
import Control.Monad.Trans.Except (ExceptT, runExceptT, throwE, catchE)
import Control.Monad.Trans.Cont (ContT(..), callCC)
import Streamly.Prelude (IsStream)

import qualified Streamly.Prelude as Stream

-------------------------------------------------------------------------------
-- Using MaybeT below streamly
-------------------------------------------------------------------------------
--
-- When streamly is on top MaybeT would terminate all iterations of
-- non-determinism.
--
getSequenceMaybeBelow
    :: ( IsStream t
       , Monad m
       , MonadTrans t
       , MonadIO (t (MaybeT m))
       )
    => t (MaybeT m) ()
getSequenceMaybeBelow = do
    liftIO $ putStrLn "MaybeT below streamly: Enter one char per line: "

    i <- Stream.fromFoldable [1..2 :: Int]
    liftIO $ putStrLn $ "iteration = " <> show i

    r1 <- liftIO getLine
    when (r1 /= "x") $ lift mzero

    r2 <- liftIO getLine
    when (r2 /= "y") $ lift mzero

mainMaybeBelow :: IO ()
mainMaybeBelow = do
    r <- runMaybeT (Stream.drain getSequenceMaybeBelow)
    case r of
        Just _ -> putStrLn "Bingo"
        Nothing -> putStrLn "Wrong"

-------------------------------------------------------------------------------
-- Using MaybeT above streamly
-------------------------------------------------------------------------------
--
-- When MaybeT is on top a Nothing would terminate only the current iteration
-- of non-determinism below.
--
-- Note that this is redundant configuration as the same behavior can be
-- achieved with just streamly, using mzero.
--
getSequenceMaybeAbove :: (IsStream t, MonadIO (t m)) => MaybeT (t m) ()
getSequenceMaybeAbove = do
    liftIO $ putStrLn "MaybeT above streamly: Enter one char per line: "

    i <- lift $ Stream.fromFoldable [1..2 :: Int]
    liftIO $ putStrLn $ "iteration = " <> show i

    r1 <- liftIO getLine
    when (r1 /= "x") mzero

    r2 <- liftIO getLine
    when (r2 /= "y") mzero

mainMaybeAbove :: (IsStream t, MonadIO (t m)) => MaybeT (t m) ()
mainMaybeAbove = do
    getSequenceMaybeAbove
    liftIO $ putStrLn "Bingo"

-------------------------------------------------------------------------------
-- Using ExceptT below streamly
-------------------------------------------------------------------------------
--
-- XXX need to have a specialized liftCatch to lift catchE
--
-- Note that throwE would terminate all iterations of non-determinism
-- altogether.
getSequenceEitherBelow
    :: ( IsStream t
       , MonadTrans t
       , Monad m
       , MonadIO (t (ExceptT String m))
       )
    => t (ExceptT String m) ()
getSequenceEitherBelow = do
    liftIO $ putStrLn "ExceptT below streamly: Enter one char per line: "

    i <- Stream.fromFoldable [1..2 :: Int]
    liftIO $ putStrLn $ "iteration = " <> show i

    r1 <- liftIO getLine
    when (r1 /= "x") $ lift $ throwE $ "Expecting x got: " <> r1

    r2 <- liftIO getLine
    when (r2 /= "y") $ lift $ throwE $ "Expecting y got: " <> r2

mainEitherBelow :: IO ()
mainEitherBelow = do
    -- XXX Cannot lift catchE
    r <- runExceptT (Stream.drain getSequenceEitherBelow)
    case r of
        Right _ -> liftIO $ putStrLn "Bingo"
        Left s  -> liftIO $ putStrLn s

-------------------------------------------------------------------------------
-- Using ExceptT below concurrent streamly
-------------------------------------------------------------------------------
--
-- XXX does not work correctly yet
--
getSequenceEitherAsyncBelow
    :: ( IsStream t
       , MonadTrans t
       , MonadIO m
       , MonadIO (t (ExceptT String m))
       , Semigroup (t (ExceptT String m) Integer)
       )
    => t (ExceptT String m) ()
getSequenceEitherAsyncBelow = do
    liftIO $ putStrLn "ExceptT below concurrent streamly: "

    i <- (liftIO (threadDelay 1000)
            >> lift (throwE "First task")
            >> return 1)
            <> (lift (throwE "Second task") >> return 2)
            <> Stream.fromPure (3 :: Integer)
    liftIO $ putStrLn $ "iteration = " <> show i

mainEitherAsyncBelow :: IO ()
mainEitherAsyncBelow = do
    r <- runExceptT (Stream.drain $ Stream.fromAsync getSequenceEitherAsyncBelow)
    case r of
        Right _ -> liftIO $ putStrLn "Bingo"
        Left s  -> liftIO $ putStrLn s

-------------------------------------------------------------------------------
-- Using ExceptT above streamly
-------------------------------------------------------------------------------
--
-- When ExceptT is on top, we can lift the non-determinism of stream from
-- below.
--
-- Note that throwE would terminate/break only current iteration of
-- non-determinism and not all of them altogether.
--
-- Here we can use catchE directly but will have to use monad-control to lift
-- stream operations with stream arguments.
getSequenceEitherAbove :: (IsStream t, MonadIO (t m))
    => ExceptT String (t m) ()
getSequenceEitherAbove = do
    liftIO $ putStrLn "ExceptT above streamly: Enter one char per line: "

    i <- lift $ Stream.fromFoldable [1..2 :: Int]
    liftIO $ putStrLn $ "iteration = " <> show i

    r1 <- liftIO getLine
    when (r1 /= "x") $ throwE $ "Expecting x got: " <> r1

    r2 <- liftIO getLine
    when (r2 /= "y") $ throwE $ "Expecting y got: " <> r2

mainEitherAbove :: (IsStream t, MonadIO (t m)) => ExceptT String (t m) ()
mainEitherAbove =
    catchE (getSequenceEitherAbove >> liftIO (putStrLn "Bingo"))
           (liftIO . putStrLn)

-------------------------------------------------------------------------------
-- Using MonadThrow to throw exceptions in streamly
-------------------------------------------------------------------------------
--
newtype Unexpected = Unexpected String deriving Show

instance Exception Unexpected

-- Note that unlike when ExceptT is used on top, MonadThrow terminates all
-- iterations of non-determinism rather then just the current iteration.
--
getSequenceMonadThrow :: (IsStream t, MonadIO (t m), MonadThrow (t m))
    => t m ()
getSequenceMonadThrow = do
    liftIO $ putStrLn "MonadThrow in streamly: Enter one char per line: "

    i <- Stream.fromFoldable [1..2 :: Int]
    liftIO $ putStrLn $ "iteration = " <> show i

    r1 <- liftIO getLine
    when (r1 /= "x") $ throwM $ Unexpected $ "Expecting x got: " <> r1

    r2 <- liftIO getLine
    when (r2 /= "y") $ throwM $ Unexpected $ "Expecting y got: " <> r2

mainMonadThrow :: IO ()
mainMonadThrow =
    catch (Stream.drain getSequenceMonadThrow >> liftIO (putStrLn "Bingo"))
          (\(e :: SomeException) -> liftIO $ print e)

-------------------------------------------------------------------------------
-- Using ContT below streamly
-------------------------------------------------------------------------------
--
-- CallCC is the goto/setjmp/longjmp equivalent
-- Allows us to manipulate the control flow in arbitrary ways
--
-- XXX need to have a specialized liftCallCC to actually lift callCC
--
getSequenceContBelow
    :: (IsStream t, MonadTrans t, MonadIO m, MonadIO (t (ContT r m)))
    => t (ContT r m) (Either String ())
getSequenceContBelow = do
    liftIO $ putStrLn "ContT below streamly: Enter one char per line: "

    i <- Stream.fromFoldable [1..2 :: Int]
    liftIO $ putStrLn $ "iteration = " <> show i

    r <- lift $ callCC $ \exit -> do
        r1 <- liftIO getLine
        _ <- if r1 /= "x"
             then exit $ Left $ "Expecting x got: " <> r1
             else return $ Right ()

        r2 <- liftIO getLine
        if r2 /= "y"
        then exit $ Left $ "Expecting y got: " <> r2
        else return $ Right ()
    liftIO $ putStrLn $ "done iteration = " <> show i
    return r

mainContBelow
    :: (IsStream t, MonadIO m, MonadTrans t, MonadIO (t (ContT r m)))
    => t (ContT r m) ()
mainContBelow = do
    r <- getSequenceContBelow
    case r of
        Right _ -> liftIO $ putStrLn "Bingo"
        Left s  -> liftIO $ putStrLn s

-------------------------------------------------------------------------------
-- Using ContT above streamly
-------------------------------------------------------------------------------
--
getSequenceContAbove :: (IsStream t, MonadIO (t m))
    => ContT r (t m) (Either String ())
getSequenceContAbove = do
    liftIO $ putStrLn "ContT above streamly: Enter one char per line: "

    i <- lift $ Stream.fromFoldable [1..2 :: Int]
    liftIO $ putStrLn $ "iteration = " <> show i

    callCC $ \exit -> do
        r1 <- liftIO getLine
        _ <- if r1 /= "x"
             then exit $ Left $ "Expecting x got: " <> r1
             else return $ Right ()

        r2 <- liftIO getLine
        if r2 /= "y"
        then exit $ Left $ "Expecting y got: " <> r2
        else return $ Right ()

mainContAbove :: (IsStream t, MonadIO (t m)) => ContT r (t m) ()
mainContAbove = do
    r <- getSequenceContAbove
    case r of
        Right _ -> liftIO $ putStrLn "Bingo"
        Left s  -> liftIO $ putStrLn s

-------------------------------------------------------------------------------
-- Combining control flow manipulating monad transformers (MaybeT, exceptT,
-- ContT) with Streamly
-------------------------------------------------------------------------------

main :: IO ()
main = do
    mainMaybeBelow
    Stream.drain $ runMaybeT mainMaybeAbove
    runContT (Stream.drain mainContBelow) return
    Stream.drain (runContT mainContAbove return)
    mainEitherBelow
    Stream.drain (runExceptT mainEitherAbove)
    mainMonadThrow
    mainEitherAsyncBelow