nptools-0.2.2: timer.hs

{-# LANGUAGE PatternGuards #-}
import Prelude hiding (min,and)
import System.Environment (getArgs)
import Control.Concurrent (threadDelay)
import System.IO (hFlush, stdout)
import Control.Monad (forM_, when)
import Data.Char (isDigit)

-- one day this would be standard (the Applicative version)
void :: IO a -> IO ()
void x = x >> return ()

setupTitle :: String -> IO ()
setupTitle title = do
  putStr "\ESC]2;"
  putStr title
  putStr "\a"
  hFlush stdout

redrawLn :: String -> IO ()
redrawLn str = do
  putStr "\r\ESC[K"
  putStr str
  hFlush stdout

type Microseconds = Int
type Seconds = Int
type Minutes = Int

minute, minutes :: Minutes -> Microseconds
second, seconds :: Seconds -> Microseconds
seconds = (*1000000)
minutes = (*60) . seconds
second  = seconds
minute  = minutes

sleep_ :: Microseconds -> IO ()
sleep_ = void . threadDelay

countDown :: Int -> (Int -> IO ()) -> IO ()
countDown i = forM_ (reverse [1..i])

(<|) :: a -> (a -> b) -> b
(<|) x f = f x

timerDisplay :: String -> IO ()
timerDisplay s = do setupTitle $ "Timer: " ++ s
                    redrawLn $ s

showTime :: Minutes -> Seconds -> String
showTime min sec = f min "minutes" `and` f sec "seconds" where
  f x s | x == 0     = ""
        | otherwise  = show x ++ " " ++ s
  "" `and` x   = x
  x  `and` ""  = x
  x  `and` y   = x ++ " and " ++ y

remainingTime :: Minutes -> Seconds -> IO ()
remainingTime min sec
  = timerDisplay $ "Remaining time: "++showTime min sec++"..."

timer :: Int -> Int -> IO ()
timer min sec = do
  countDown sec     $ \i ->
    remainingTime min i >> sleep_ (1<|second)

  countDown (min-1) $ \i ->
    remainingTime (i+1) 0 >> sleep_ (1<|minute)

  when (min>=1) $
    countDown 60 $ \i ->
      remainingTime 0 i >> sleep_ (1<|second)

  timerDisplay "Time done!\07"

  forM_ [1 :: Int ..] $ \i -> do
    sleep_ (1<|minute)
    timerDisplay $ "Time passed since " ++ showTime i 0 ++ "!\07"

main :: IO ()
main = do
  args <- getArgs
  case args of
    [dur] | (min,sec') <- break (==':') dur,
            sec <- drop 1 sec',
            all isDigit min,
            all isDigit sec ->
         timer (read min) (if null sec then 0 else read sec)
    _ -> error "Duration in minutes (or minutes:seconds) expected as argument"