バイナリクロック

http://gauc.no-ip.org/awk-users-jp/blis.cgi/DoukakuAWK_179 のお題。時刻の扱いかたを把握するのに時間がかかった。

import Data.Bits (testBit, shiftR)
import Data.Time (localTimeOfDay, utcToLocalTime, getCurrentTime,
                  todHour, todMin, getCurrentTimeZone)

-- | 2 進数を表現するための型
data Binary
    = Zero
    | One

-- | 10 進数を 2 進数表現に変換する.
--
-- 戻り値のリストは, 先頭が最上位桁で, 末尾が最下位桁となる.
dec2Bin :: Int      -- ^ 10 進数
        -> [Binary] -- ^ 2 進数表現
dec2Bin n = iter n []
  where iter 0 bs = bs
        -- 0 番目のビットが立っている場合は 1, そうでなければ 0
        iter n bs | testBit n 0 = iter (next n) (One:bs)
                  | otherwise   = iter (next n) (Zero:bs)
        -- 次のビットを調べるため, 数値を右シフトする.
        next n = shiftR n 1

instance Show Binary where
    show Zero = "_"
    show One = "#"

-- | 時間と分の組.
data HourMin = HourMin { hour :: Int
                       , minute :: Int
                       }

-- | 現在時刻の時間と分を返す.
currentHM :: IO HourMin
currentHM = do utc <- getCurrentTime
               zone <- getCurrentTimeZone
               return $ toHourMin
                      $ localTimeOfDay
                      $ utcToLocalTime zone utc
  where toHourMin tod = HourMin (todHour tod) (todMin tod)

-- | 改行を入れずに print する.
print' :: (Show a) => a -> IO ()
print' = putStr . show

main = do ct <- currentHM
          let hourBin = dec2Bin (hour ct)
              minBin = dec2Bin (minute ct)
          mapM_ print' hourBin >> eol
          mapM_ print' minBin >> eol
  where
        eol = putStrLn ""