出力の一時停止と再開 in Haskell DouKaku?

起動すると、標準出力に1秒毎に'a'の1文字を出力し続けるプログラムで、以下の条件を満たすものを「どう書く？」

'q'キーが押されるとプログラムは終了する
出力中に'p'キーが押されると一時停止する
一時停止中に'p'キーが押されると出力を再開する

Haskellでも多言語同様にコンソール入力がエンターを押すまで読めない病にかかっています。

module Main where

import System
import System.IO
import System.IO.Error
import Control.Monad

weaveIO :: (IO Bool) -> IO a -> (a -> IO a) -> IO a
weaveIO w m f = do
    a <- m 
    b <- w
    if b then f a
        else return a

getChar' :: IO Char
getChar' = getLine >>= return.head.(++" ")

nonBlockingGetCh :: IO (Maybe Char)
nonBlockingGetCh = do
    f <- hReady stdin
    if (not f) then return Nothing
        else do
            getChar' >>= return.Just

respondToKey :: IO Bool
respondToKey = nonBlockingGetCh >>= evalCh
    where
        evalCh Nothing = return True
        evalCh (Just 'q') = print "+++ quitting +++" >> return False
        evalCh (Just 'p') = waitForP ' '
        evalCh _ = return True
        waitForP 'p' = return True
        waitForP 'q' = print "+++ quitting +++" >> return False
        waitForP _ = print "+++ paused, hit 'p' again +++" >> getChar' >>= waitForP


showLineWeave :: Handle -> IO ()
showLineWeave h = weaveIO (respondToKey) (hGetLine h >>= putStrLn) (\_ -> showLineWeave h)
    

main = do
    args <- getArgs
    withFile (head args) ReadMode $ \h ->
        catch (showLineWeave h) (\e -> if (isEOFError e) then return () else ioError e)

こちらが題意に沿ったものになります

module Main where

import System
import System.IO
import System.IO.Error
import Control.Monad
import Control.Concurrent

weaveIO :: (IO Bool) -> IO a -> (a -> IO a) -> IO a
weaveIO w m f = do
    a <- m 
    b <- w
    if b then f a
        else return a

getChar' :: IO Char
getChar' = getLine >>= return.head.(++" ")

nonBlockingGetCh :: IO (Maybe Char)
nonBlockingGetCh = do
    f <- hReady stdin
    if (not f) then return Nothing
        else do
            getChar' >>= return.Just

respondToKey :: IO Bool
respondToKey = nonBlockingGetCh >>= evalCh
    where
        evalCh Nothing = return True
        evalCh (Just 'q') = print "+++ quitting +++" >> return False
        evalCh (Just 'p') = waitForP ' '
        evalCh _ = return True
        waitForP 'p' = return True
        waitForP 'q' = print "+++ quitting +++" >> return False
        waitForP _ = print "+++ paused, hit 'p' again +++" >> getChar' >>= waitForP


showLineWeave :: IO ()
showLineWeave = weaveIO (respondToKey) (putStr "a" >> hFlush stdout >> threadDelay 1000000) (\_ -> showLineWeave)
    

main = showLineWeave

ghc-6.8.2 の System.Timeout を使ってみた
標準入出力をNoBufferingモードで使う
ユーザキー入力はechoしないようにする
Windowsで動くかどうかは未確認

module Main where
import System.IO
import System.Posix
import System.Timeout

main :: IO ()
main =  do { hSetBuffering stdin NoBuffering
           ; hSetBuffering stdout NoBuffering
           ; at <- getTerminalAttributes stdInput
           ; setTerminalAttributes stdInput (withoutMode at EnableEcho) Immediately
           ; loop False
           }

loop :: Bool -> IO ()
loop False = do {
 ; mc <- timeout (10^6) (hGetChar stdin)
 ; case mc of
     Nothing  -> hPutChar stdout 'a' >> loop False
     Just 'p' -> loop True
     Just 'q' -> return ()
     Just _   -> loop False
 }
loop True = do {
 ; c <- hGetChar stdin
 ; case c of
     'p' -> loop False
     'q' -> return ()
     _   -> loop True
 }

DouKaku?

出力の一時停止と再開

Posted feedbacks - Haskell

Index

Feed

Other

Link

Pathtraq