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