part n [] = []
part n xs = [take n xs] ++ part n (drop n xs)

leap year
    | year `mod` 4 /= 0		= False
    | year `mod` 400 == 0	= True
    | year `mod` 100 == 0	= False
    | otherwise			= True

lastday year month
    | month `elem` [1, 3, 5, 7, 8, 10, 12]	= 31
    | month `elem` [4, 6, 9, 11]		= 30
    | leap year					= 29
    | otherwise					= 28

jd year month day
    = floor (365.25 * (fromIntegral y + 4716))
      + floor (30.6001 * (fromIntegral m + 1))
      + d + b - 1524
	where
	    m | month <= 2	= month + 12
	      | otherwise	= month
	    y | month <= 2	= year - 1
	      | otherwise	= year
	    a = floor (fromIntegral y / 100)
	    b = floor (2 - fromIntegral a + (fromIntegral a / 4))
	    d = day

dow year month day
    = (jd year month day + 1) `mod` 7

calstr year month
    = ["Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat"]
      ++ replicate (dow year month 1) "&nbsp;&nbsp;" 
      ++ map show [1..lastday year month] 
      ++ replicate (6 - (dow year month (lastday year month))) "&nbsp;&nbsp;"

calline list
    = foldl (\p x -> p ++ "<td align=\"right\">" ++ x ++ "</td>") "  <tr>" list ++ "</tr>\n"

cal year month
    = "<table>\n  <tr><th colspan=\"8\">"
      ++ show year ++ "/" ++ show month
      ++ "</th></tr>\n"
      ++ foldl (\p x -> p ++ x) "" (map calline (part 7 (calstr year month)))
      ++ "</table>"