DouKaku?

module Main (main) where

import Control.Monad
import Data.Ix
import Data.List
import Data.Maybe
import Data.Time
import System.Environment
import qualified System.IO.UTF8 as U
import System.IO.Unsafe
import Text.Printf

instance Ix Day where
  range (x,y) = [x..y]
  index (x,y) a = fromJust $ findIndex (a ==) $ range (x,y)
  inRange (x,y) a = x <= a && a <= y

type Seireki = (Integer,Int,Int)

today :: Day
today = utctDay $ unsafePerformIO $ getCurrentTime

meizi   = (fromGregorian 1873 1 1,fromGregorian 1912 7 30)
taisyou = (fromGregorian 1912 7 30, fromGregorian 1926 12 25)
syouwa  = (fromGregorian 1926 12 25, fromGregorian 1989 1 7)
heisei  = (fromGregorian 1989 1 8,today)

conv :: Integer -> Int -> Int -> [String]
conv y m d 
 = if invalid y m d then ["範囲外"]
   else 
      if inRange meizi ymd
      then let mei = printf "明治%2d年%2d月%2日" (y+6-1873) m d
           in mei : if inRange taisyou ymd 
                    then ["大正 1年 7月30日"]
                    else []
      else 
        if inRange taisyou ymd 
        then let tai = printf "大正%2d年%2d月%2d日" (y+1-1912) m d
             in tai : if inRange syouwa ymd
                      then ["昭和 1年12月25日"]
                      else []
        else
          if inRange syouwa ymd
          then [printf "昭和%2d年%2d月%2d日" (y+1-1926) m d]
          else 
            if inRange heisei ymd
            then [printf "平成%2d年%2d月%2d日" (y+1-1989) m d]
            else ["範囲外"]
   where ymd = fromGregorian y m d

invalid :: Integer -> Int -> Int -> Bool
invalid y m d 
  = not (inRange (1,12) m) || not (inRange (1,gregorianMonthLength y m) d)

main :: IO ()
main = do { [y,m,d] <- getArgs
          ; U.putStrLn $ concat $ intersperse " " $ conv (read y) (read m) (read d)
          }