Lazy.hs

{- |
Caution:

- Although this module calls 'unsafeInterleaveIO' for you,
  it cannot take the responsibility from you.
  Using this module is still as unsafe as calling 'unsafeInterleaveIO' manually.
  Thus we recommend to wrap the lazy I/O monad
  into a custom @newtype@ with a restricted set of operations
  which is considered safe for interleaving I/O actions.

- Operations like 'System.IO.hClose' are usually not safe within this monad,
  since they will only executed, if their result is consumed.
  Since this result is often @()@ this is quite unusual.
  It will also often be the case, that not the complete output is read,
  and thus the closing action is never reached.
  It is certainly best to call a closing action after you wrote
  the complete result of the lazy I/O monad somewhere

- @return a :: LazyIO a@ is very different from @liftIO (return a) :: LazyIO a@.
  The first one does not trigger previous IO actions,
  whereas the second one does.

Use it like

> import qualified System.IO.Lazy as LazyIO
>
> LazyIO.run $
>    do liftIO $ putStr "enter first line:"
>       x <- liftIO getLine
>       liftIO $ putStr "enter second line:"
>       y <- liftIO getLine
>       return x

Because only the first line is needed,
only the first prompt and the first 'getLine' is executed.

We advise to lift strict IO functions into the lazy IO monad.
Lifting a function like @readFile@ may lead to unintended interleaving.
-}
module System.IO.Lazy (
   T,
   run,
   ) where

import Control.Monad.IO.Class (MonadIO(liftIO), )
import Control.Monad.Trans.State (StateT(StateT), mapStateT, evalStateT, {- runStateT, -} )
import Control.Monad (ap, {- liftM2, -} )
import Control.Applicative (Applicative(pure, (<*>)), )
import System.IO.Unsafe (unsafeInterleaveIO, )


newtype T a = Cons {decons :: StateT RunAll IO a}

data RunAll = RunAll
   deriving Show

instance Monad T where
   return x = Cons $ return x
   x >>= f = Cons $
      mapStateT unsafeInterleaveIO . decons . f =<<
      mapStateT unsafeInterleaveIO (decons x)

instance Functor T where
   fmap f = Cons . fmap f . decons

instance Applicative T where
   pure = return
   (<*>) = ap

instance MonadIO T where
   liftIO m = Cons $ StateT $ \RunAll -> fmap (\x->(x,RunAll)) m

run :: T a -> IO a
run =
   flip evalStateT RunAll . decons

{-
correct:
run $ do x <- liftIO getLine; y <- liftIO getLine; a <- return (x,y); return (fst a)

*LazyIO> run (Control.Monad.replicateM 5 (liftIO getChar)) >>= putStrLn
0011223344

*LazyIO> run (liftIO (putStrLn "bla") >> liftIO getLine) >>= print
"bla
1
1"

*LazyIO> run $ Monad.liftM (\ ((a,b),(c,d))->b) $ liftM2 (,) (liftM2 (,) (liftIO getLine) (liftIO getLine)) (liftM2 (,) (liftIO getLine) (liftIO getLine))
"1
2
2"
-}

{-
testLazy, testStrict :: IO String
testLazy   = run $ liftM2 (const)      (liftIO getLine) (liftIO getLine)
testStrict = run $ liftM2 (flip const) (liftIO getLine) (liftIO getLine)

test :: IO (String, RunAll)
test = flip runStateT RunAll $ decons $
   liftIO getLine >>= \x ->
   liftIO getLine >>
   return x
-}