定義ファイルで元号名、元号が使用開始された西暦年月日、最終西暦年月日を定義ファイルから読み込みます。
代数的データ型のアクセサを使うと可読性が悪くなるので、パターンマッチにより取り出す方法を使うようになりました。
module Main where import Data.List import Data.Time.Calendar import System.IO.Unsafe import qualified System.IO.UTF8 as U import Test.HUnit newtype GName = GName String deriving (Eq,Read,Show) newtype Gfirst = Gfirst String deriving (Eq,Read,Show) newtype GfstDay = GfstDay Day deriving (Eq,Show) newtype Glast = Glast String deriving (Eq,Read,Show) newtype GlstDay = GlstDay Day deriving (Eq,Show) -- Day型はreadで読み込めないのでString型で読み込み、readDayで変換しています。 readDay :: String -> Day readDay [y1,y2,y3,y4,_,m1,m2,_,d1,d2] = fromGregorian (read [y1,y2,y3,y4]) (read [m1,m2]) (read [d1,d2]) readDay _ = error "Wareki readDay: " data GengoS = GengoS GName Gfirst Glast deriving (Eq,Read,Show) data Gengo = Gengo GName GfstDay GlstDay deriving (Eq,Show) gengoSToGengo :: GengoS -> Gengo gengoSToGengo (GengoS gName (Gfirst firstSTR) (Glast lastSTR))= Gengo gName (GfstDay $ readDay firstSTR) (GlstDay $ readDay lastSTR) data Wareki = Wareki GName Integer Int Int deriving (Eq,Show) instance Ord Wareki where compare w1 w2 = compare (fromWarekiToDay w1) (fromWarekiToDay w2) -- (read :: String -> [GengoS])はread関数の型を限定。文字列を引数とし、 -- [GengoS]型を返す。 warekiDefRead :: IO [GengoS] warekiDefRead = return.(read :: String -> [GengoS]) =<< U.readFile "wareki.ini" gengoList :: [Gengo] gengoList = map gengoSToGengo $ unsafePerformIO warekiDefRead -- ============================================================================= -- 西暦から和暦への変換 -- ============================================================================ fromDayToWareki :: Day -> Maybe Wareki fromDayToWareki day = case find betweenFirstAndLast gengoList of Just (Gengo gName (GfstDay firstDay) _) -> let (gfirstYear,_,_) = toGregorian firstDay in Just (Wareki gName (adYear - gfirstYear + 1) adMonth adDay) Nothing -> Nothing where betweenFirstAndLast (Gengo _ (GfstDay first) (GlstDay lst)) = (first <= day) && (day <= lst) (adYear,adMonth,adDay) = toGregorian day -- =========================================================================== -- 和暦から西暦への変換 -- ============================================================================= fromWarekiToDay :: Wareki -> Maybe Day fromWarekiToDay (Wareki _ 0 _ _ ) = Nothing fromWarekiToDay (Wareki wName wYear wMonth wDay) = case find eqGengo gengoList of Just (Gengo _ (GfstDay firstDay) (GlstDay lastDy)) -> let (gfirstYear,_,_) = toGregorian firstDay in case fromGregorianValid (gfirstYear + wYear - 1) wMonth wDay of Just newDay -> if newDay <= lastDy then (Just newDay) else Nothing Nothing -> Nothing Nothing -> Nothing where eqGengo (Gengo gName _ _) = wName == gName warekiTest :: Test warekiTest = "Wareki" ~: test [ fromDayToWareki (fromGregorian 1912 7 29) ~?= Just (Wareki (GName "明治") 45 7 29), fromDayToWareki (fromGregorian 1912 7 30) ~?= Just (Wareki (GName "大正") 1 7 30), fromDayToWareki (fromGregorian 1926 12 24) ~?= Just (Wareki (GName "大正") 15 12 24), fromDayToWareki (fromGregorian 1926 12 25) ~?= Just (Wareki (GName "昭和") 1 12 25), fromDayToWareki (fromGregorian 1989 1 7) ~?= Just (Wareki (GName "昭和") 64 1 7), fromDayToWareki (fromGregorian 1989 1 8) ~?= Just (Wareki (GName "平成") 1 1 8), (fromDayToWareki (fromGregorian 1926 12 24) >>= fromWarekiToDay) ~?= Just (fromGregorian 1926 12 24), ((Wareki (GName "昭和") 1 12 25) == (Wareki (GName "昭和") 1 12 25)) ~?= True, ((Wareki (GName "平成") 1 1 10) > (Wareki (GName "昭和") 56 12 25)) ~?= True ] toDayTest :: Test toDayTest = "toDay" ~: test [ fromWarekiToDay (Wareki (GName "明治") 45 7 29) ~?= Just (fromGregorian 1912 7 29), fromWarekiToDay (Wareki (GName "大正") 1 7 30) ~?= Just (fromGregorian 1912 7 30), fromWarekiToDay (Wareki (GName "大正") 15 12 24) ~?= Just (fromGregorian 1926 12 24), fromWarekiToDay (Wareki (GName "昭和") 1 12 25) ~?= Just (fromGregorian 1926 12 25), fromWarekiToDay (Wareki (GName "平成") 1 1 8) ~?= Just (fromGregorian 1989 1 8), -- 大正16年は存在しない。 fromWarekiToDay (Wareki (GName "大正") 16 12 24) ~?= Nothing , -- 大正15年12月25日は昭和なので存在しない。 fromWarekiToDay (Wareki (GName "大正") 15 12 25) ~?= Nothing , -- 年号の範囲内の異常な値は存在しない。 fromWarekiToDay (Wareki (GName "大正") 1 13 25) ~?= Nothing, fromWarekiToDay (Wareki (GName "大正") 1 13 33) ~?= Nothing, (fromWarekiToDay (Wareki (GName "明治") 45 7 29) >>= fromDayToWareki) ~?= Just (Wareki (GName "明治") 45 7 29) ] doTest :: IO Counts doTest = do runTestTT warekiTest runTestTT toDayTest main :: IO() main = print =<< doTest
- wareki.ini (UTF-8)
年号定義を追加すれば良い。
[ GengoS (GName "明治") (Gfirst "1868-10-23") (Glast "1912-07-29"), GengoS (GName "大正") (Gfirst "1912-07-30") (Glast "1926-12-24"), GengoS (GName "昭和") (Gfirst "1926-12-25") (Glast "1989-01-07"), GengoS (GName "平成") (Gfirst "1989-01-08") (Glast "2100-12-31") ]
