problems due to laziness

FullLazinessPresumedWoes.hs

{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE LambdaCase #-}
-- | https://well-typed.com/blog/2016/09/sharing-conduit/
module Main where

import Control.Exception
import System.IO

retry :: IO a -> IO a
retry io = do
    ma <- try io
    case ma of
      Right a -> return a
      Left (_ :: IOException) -> retry io

data Pipe i o m r =
    Yield o (Pipe i o m r)
  | Await (Either r i -> Pipe i o m r)
  | Effect (m (Pipe i o m r))
  | Done r

countChars :: Int -> Pipe Char o IO Int
countChars cnt =
    Effect (do
        -- putChar 'c'
        pure $
            Await $ \foo -> case foo of
                Left  _ -> Done cnt
                Right _ -> countChars $! cnt + 1)

(=$=) :: Monad m => Pipe a b m r -> Pipe b c m r -> Pipe a c m r
{-# NOINLINE (=$=) #-}
_         =$= Done   r   = Done r
u         =$= Effect   d = Effect $ (u =$=) <$> d
u         =$= Yield  o d = Yield o (u =$= d)
Yield o u =$= Await    d = u =$= d (Right o)
Await   u =$= Await    d = Await $ \ma -> u ma =$= Await d
Effect  u =$= Await    d = Effect $ (=$= Await d) <$> u
Done  r   =$= Await    d = Done r =$= d (Left r)

countSpaces :: Int -> Pipe Char o IO Int
countSpaces cnt = 
    Await 
      \case 
        Left  _   -> Done cnt
        Right ' ' -> countSpaces $! cnt + 1
        Right _   -> countSpaces $! cnt

getN :: Int -> Pipe i Char IO Int
getN 0 = Done 0
getN n = Effect $ do
           return $ Yield ' ' (getN (n - 1))

feed :: Char -> Pipe Char o m Int -> IO ()
feed ch = feedFrom 10_000_000_000
  where
    feedFrom :: Int -> Pipe Char o m Int -> IO ()
    feedFrom _ (Done r)  = print r
    feedFrom 0 (Await k) = feedFrom 0     $ k (Left 0)
    feedFrom n (Await k) = feedFrom (n-1) $ k (Right ch)

runPipe :: Show r => Pipe i o IO r -> IO ()
runPipe (Done r)   = print r
runPipe (Effect k) = runPipe =<< k

--main :: IO ()
--main =  retry $ feed 'A' (countChars 0)
main :: IO ()
-- main = retry $ runPipe $ getN 100_000_000 =$= countChars 0
main = retry $ runPipe $ getN 100_000_000_000 =$= countChars 0