だいたいの時刻を表示するコマンド

30分プログラム、その641。だいたいの時刻を表示するコマンドを作ってみました。
http://kodawari2007.blog108.fc2.com/blog-entry-533.htmlというオシャレアイテムは、時刻を"20 minutes past 22"(22時から20分が過ぎた)みたいに表示してくれるらしい。
キュンと来たので、そういうコマンドを作ってみた。

使い方

*Main> main
20 minutes past 22

ソースコード

import Data.Time.LocalTime
import Data.Time.Clock
import Text.Printf

data Min = About | Half | Past Int | To Int
newtype AboutTime = AboutTime (Int,Min)

instance Show AboutTime where
    show (AboutTime (hour,About)) = printf "It's about %d"  hour
    show (AboutTime (hour,Half))  = printf "a half past %d" hour
    show (AboutTime (hour,Past min)) = printf "%d minutes past %d" min hour
    show (AboutTime (hour,To   min)) = printf "%d minutes to %d" min hour

roundMin :: Int -> Int
roundMin n = let m = n `mod` 10
             in n + (if m >= 5 then (10-m) else -m)

toAbout day = let min  = roundMin $ todMin day
                  hour = todHour day
              in
                if min == 0       then AboutTime (hour    , About)
                else if min == 30 then AboutTime (hour    , Half)
                else if min < 30  then AboutTime (hour    , Past min)
                else                   AboutTime (hour + 1, To (60-min))

getCurrentTimeOfDay :: IO TimeOfDay
getCurrentTimeOfDay = do time <- getCurrentTime
                         tz   <- getCurrentTimeZone
                         return $ localTimeOfDay $ utcToLocalTime tz time


main = do tod <- getCurrentTimeOfDay
          print $ toAbout tod