Search code examples
haskellconsoleinfinite-looplazy-evaluationconsole-output

Why does my Haskell program never print to the console?


I wanted to practice using the IO monad in Haskell so I decided to make a "screensaver" program which would recurse infinitely while printing to the console. When the code runs nothing appears on the console. When I send the SIGTERM to the program it prints the hard coded 'proof of concept' draw output but no output from the infinite recursion (go function).

I suspect this has something to do with lazy evaluation, that the code to output to the console in the go function is never called, but I don't know how to fix it. Any suggestions would be greatly appreciated!

Haskell Code:

import Data.Maybe (isJust, fromJust)
import System.Random
import System.Console.ANSI
import qualified System.Console.Terminal.Size as Term

data RainDrop a = RainDrop
  { row   :: !a
  , col   :: !a
  , count :: !a
  } deriving (Read,Show)

main :: IO ()
main = do
  clearScreen
  -- proof that draw works
  c <- applyX 10 draw (return (RainDrop 0 2 10))
  go [return (RainDrop 0 0 10)]

applyX :: Int -> (a -> a) -> a -> a
applyX 0 _ x = x
applyX n f x = applyX (n-1) f (f x)

go :: [IO (RainDrop Int)] -> IO ()
go []     = return ()
go (x:xs) = do
  prng <- newStdGen
  go $ map draw $ maybeAddToQueue prng (x:xs)

maybeAddToQueue :: RandomGen g => g -> [IO (RainDrop Int)] -> [IO (RainDrop Int)]
maybeAddToQueue _    []     = []
maybeAddToQueue prng (x:xs) =
  let
    (noNewDrop, gen0) = randomR (True,False) prng
  in
    if noNewDrop
    then x:xs
    else (
      do
        (colR,gen1) <- randomCol gen0
        return $ RainDrop 0 colR $ fst $ randomLen gen1
      ):x:xs

randomCol :: RandomGen g => g -> IO (Int, g)
randomCol prng = do
  w <- Term.size >>= (\x -> return . Term.width  $ fromJust x)
  return $ randomR (0,(w-1)) prng

randomLen :: RandomGen g => g -> (Int, g)
randomLen = randomR (4,32)

draw :: IO (RainDrop Int) -> IO (RainDrop Int)
draw rain = do
  x    <- rain
  prng <- newStdGen
  setCursorPosition (row x) (col x)
  putChar . toGlyph $ fst $ randomR range prng
  return (RainDrop (succ $ row x) (col x) (count x))

toGlyph x
 | isJust a  = fromJust a
 | otherwise = x
 where a = lookup x dictionary

dictionary =
  let (a,b) = range
  in zip [a..b] encoding

encoding =
  let (a,b) = splitAt 16 katakana
      (c,d) = splitAt 7  b
  in a ++ numbers ++ c ++ ['A'..'Z'] ++ d

range    = (' ','~')
katakana = ['・'..'゚']
numbers  = "012Ƹ߈Ƽ6ߖȣ9"

Solution

  • This line in the go function:

    go $ map draw $ maybeAddToQueue prng (x:xs)
    

    doesn't actually execute any of the IO actions - it just creates new IO actions from existing ones.

    Here are some type signatures of how I would approach the problem:

    type World = [Raindrop]
    
    -- draw the raindrops
    draw :: World -> IO ()
    
    -- advance the drops
    step :: World -> World
    
    -- add more drops
    moreRain :: World -> IO (World)
    
    -- the main loop
    loop :: World -> IO ()
    loop drops = do
      draw drops
      let drops' = step drops
      drops'' <- moreRain drops'
      -- delay for a while here???
      loop drops''
    

    Notes:

    • I've declared step to be a pure function on the assumption that motion of the drops is deterministic
    • moreRain however needs to use a random number generator, so it is an IO action