calコマンドを実装してみました

UNIXでよく使われるカレンダーを表示するプログラムです。相変らずエラー処理がいまいちです(関数calenderのとことか)。うーん、うまくHaskellぽく書けてない気がします。
ファイル: cal.hs

import System
import System.Time
import Ix

main :: IO ()
main = do args <- getArgs
          now <- getClockTime >>= toCalendarTime
          let monthAndYear = getMonthAndYear args now
          calendar monthAndYear
       where
         getMonthAndYear :: [String] -> CalendarTime -> [Int]
         getMonthAndYear (s1:s2:ss) _ = [strToInt $ s1, strToInt $ s2]
         getMonthAndYear (s1:ss) now = [strToInt $ s1, ctYear now]
         getMonthAndYear _ now = [monthIndex now, ctYear now]

         strToInt :: String -> Int
         strToInt s = (read :: String -> Int) s

calendar :: [Int] -> IO ()
calendar monthAndYear = 
    do let month = head monthAndYear
           year = last monthAndYear
       if month < 1 || month > 12 
           then error $ "invalid month. " ++ (show month)
           else doNothing
       if year < 0 
           then error $ "invalid year. " ++ (show year)
           else doNothing
       printHeader month year
       printDays month year
    where
      doNothing :: IO ()
      doNothing = return ()

printHeader :: Int -> Int -> IO ()
printHeader month year =
    do let weekHeader = "Su Mo Tu We Th Fr Sa"
           monthHeader = (monthName month) ++ " " ++ (show year)
           nPadding = ((length weekHeader) - (length monthHeader)) `div` 2
       putStrLn $ (replicate nPadding ' ') ++ monthHeader
       putStrLn weekHeader

printDays :: Int -> Int -> IO ()
printDays month year = 
    do let nPadding = dayOfWeek 1 month year
           days = replicate nPadding "  " ++
                  map (\day -> (if day < 10 then " " else "") ++ (show day))
                      [1 .. (ndaysOfMonth month year)]
       printDays' 0 days
    where
      printDays' :: Int -> [String] -> IO ()
      printDays' i [] = putStr "\n"
      printDays' i (day:days) = 
          do putStr $ day ++ if i `mod` 7 == 6 then "\n" else " "
             printDays' (i + 1) days

isLeapYear :: Int -> Bool
isLeapYear year
    | year `mod` 400 == 0 = True
    | year `mod` 100 == 0 = False
    | year `mod`   4 == 0 = True
    | otherwise = False

-- ref. http://www.st.rim.or.jp/~phinloda/cqa/cqa15.html
dayOfWeek :: Int -> Int -> Int -> Int
dayOfWeek day month year =
    let t = [0, 3, 2, 5, 0, 3, 5, 1, 4, 6, 2, 4] !! (month - 1)
        y = if month < 3 then year - 1 else year
    in (y + (y `div` 4) - (y `div` 100) + (y `div` 400) + t + day) `mod` 7

ndaysOfMonth :: Int -> Int -> Int
ndaysOfMonth month year
    | month == 2 = if isLeapYear year then 29 else 28
    | month == 4 || month == 6 || month == 9 || month == 11 = 30
    | otherwise = 31

monthIndex :: CalendarTime -> Int
monthIndex now = (index (January, December) $ ctMonth now) + 1

monthName :: Int -> String
monthName month = show $ (range (January, December)) !! (month - 1)

以下、実行例です。

$ ./cal.exe
     July 2006
Su Mo Tu We Th Fr Sa
                   1
 2  3  4  5  6  7  8
 9 10 11 12 13 14 15
16 17 18 19 20 21 22
23 24 25 26 27 28 29
30 31
$ ./cal.exe 8 2006
    August 2006
Su Mo Tu We Th Fr Sa
       1  2  3  4  5
 6  7  8  9 10 11 12
13 14 15 16 17 18 19
20 21 22 23 24 25 26
27 28 29 30 31