Skip to content

Instantly share code, notes, and snippets.

@danidiaz
Created October 19, 2023 21:35
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
Star You must be signed in to star a gist
Save danidiaz/512aaf61e068a650ba5d4908758e30bd to your computer and use it in GitHub Desktop.
problems due to laziness
{-# 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
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment