Haskell - モジュール(日付の操作(System.Timeモジュール)、ファイルの読み込み(System.IOモジュール))

すごいHaskellたのしく学ぼう!
(オーム社)
Miran Lipovača (著)
田中英行村主崇行 (翻訳)
[Kindle版]

開発環境

OS X Lion - Apple(OS)
Emacs、BBEdit - Bare Bones Software, Inc. (Text Editor)
Haskell (純粋関数型プログラミング言語)
GHC (The Glasgow Haskell Compiler) (処理系)

『初めてのプログラミング第2版』(Chris Pine 著、長尾高弘訳、オライリー・ジャパン、2010年、ISBN978-4-87311-469-9)の12章(新しいクラスのオブジェクト), 12.6(練習問題の続き)、バースデーヘルパーをHaskellで解いてみる。

その他参考書籍

バースデーヘルパー

コード(BBEdit)

sample.hs

{--
{-# OPTIONS -Wall -Werror #-}
--}

import qualified Data.Map as Map
import System.IO
import System.Time

main :: IO ()
main = do
    handle <- openFile "birth_day_helper.txt" ReadMode
    contents <- hGetContents handle
    let a = linesToNamesAndCalendarTimes $ lines contents
    ask a

ask :: Map.Map String CalendarTime -> IO ()
ask x = do
    putStrLn "名前を入力"
    line <- getLine
    if line == ""
    then putStrLn "終了"
    else do let b = Map.lookup line x
            if b == Nothing
            then do putStrLn "一覧に名前がありません。"
                    ask x
            else do let c =  f b
                    d <- getAge c
                    putStrLn $ "誕生日: " ++ (getBirthDate c) ++
                               " 年齢: " ++ (show d) ++ "歳"
                    ask x

getAge :: CalendarTime -> IO Int
getAge a = do
    let year = ctYear a
        month = getIntFromMonth $ ctMonth a
        day = ctDay a
    now <- getClockTime
    nowCal <- toCalendarTime now
    let nowYear = ctYear nowCal
        nowMonth = getIntFromMonth $ ctMonth nowCal
        nowDay = ctDay nowCal
        age = nowYear - year
    if nowMonth < month || (nowMonth == month && nowDay < day)
    then  return (age - 1)
    else  return age

getBirthDate :: CalendarTime -> String
getBirthDate a =
    let year = ctYear a
        month = getIntFromMonth $ ctMonth a
        day = ctDay a
    in show year ++ ('年':(show month)) ++ ('月':(show day)) ++ "日"

linesToNamesAndCalendarTimes :: [String] -> Map.Map String CalendarTime
linesToNamesAndCalendarTimes xs = Map.fromList $ map lineToNameAndCalendarTime xs

lineToNameAndCalendarTime :: String -> (String, CalendarTime)
lineToNameAndCalendarTime xs = (getName xs, getCalendarTime xs)

getName :: String -> String
getName s = head $ splitComma s

getCalendarTime :: String -> CalendarTime
getCalendarTime s =
    let a = map trim $ tail $ splitComma s
        b = head a
        c = last a
        year = read c :: Int
        d = splitSpace b
        e = head d
        g = last d
        day = read g :: Int
        month = f $ Map.lookup e monMonthMap
    in CalendarTime {ctYear = year, ctMonth = month, ctDay = day}

trim :: String -> String
trim = trimLeft . trimRight

trimLeft :: String -> String
trimLeft [] = []
trimLeft (x:xs) | x == ' ' = trimLeft xs
                | otherwise = x:xs

trimRight :: String -> String
trimRight [] = []
trimRight s = if last s == ' '
              then trimRight $ init s
              else s

splitComma :: String -> [String]
splitComma = splitDelimiter ','

splitSpace :: String -> [String]
splitSpace = splitDelimiter ' '

splitDelimiter :: Char -> String -> [String]
splitDelimiter a s =
    let inner :: [String] -> String -> [String]
        inner [] [] = []
        inner [] (x:[]) | x == a = []
                        | otherwise = [[x]]
        inner [] (x:xs) | x == a = inner [] xs
                        | otherwise = inner [[x]] xs
        inner acc [] | last acc == "" = init acc
                     | otherwise = acc
        inner acc (x:[]) | x == a = acc
                         | otherwise = let b = init acc
                                           c = last acc
                                       in b ++ [c ++ [x]] 
        inner acc (x:y:xs) | x == a = inner (acc ++ [[y]]) xs
                           | otherwise = let b = init acc
                                             c = last acc
                                         in inner (b ++ [c ++ [x]]) (y:xs)
    in inner [] s

getIntFromMonth :: Month -> Int
getIntFromMonth a = f $ Map.lookup a monthIntMap

f :: Maybe a -> a
f (Just a) = a
f Nothing = undefined

monMonthMap :: Map.Map String Month
monMonthMap = Map.fromList $
    [("Jan", January),
     ("Feb", February),
     ("Mar", March),
     ("Apr", April),
     ("May", May),
     ("Jun", June),
     ("Jul", July),
     ("Aug", August),
     ("Sep", September),
     ("Oct", October),
     ("Nov", November),
     ("Dec", December)]

monthIntMap :: Map.Map Month Int
monthIntMap = Map.fromList $
    [(January, 1),
     (February, 2),
     (March, 3),
     (April, 4),
     (May, 5),
     (June, 6),
     (July, 7),
     (August, 8),
     (September, 9),
     (October, 10),
     (November, 11),
     (December, 12)]

入出力結果(Terminal, runghc)

$ runghc sample.hs

sample.hs:74:8: Warning:
    Fields of `CalendarTime' not initialised: ctHour, ctMin, ctSec,
                                              ctPicosec, ctWDay, ctYDay, ctTZName, ctTZ, ctIsDST
    In the expression:
      CalendarTime {ctYear = year, ctMonth = month, ctDay = day}
    In the expression:
      let
        a = map trim $ tail $ splitComma s
        b = head a
        c = last a
        ....
      in CalendarTime {ctYear = year, ctMonth = month, ctDay = day}
    In an equation for `getCalendarTime':
        getCalendarTime s
          = let
              a = map trim $ tail $ splitComma s
              b = head a
              ....
            in CalendarTime {ctYear = year, ctMonth = month, ctDay = day}
名前を入力
Christopher Pine
誕生日: 2000年10月21日 年齢: 13歳
名前を入力
Christopher Plummer
誕生日: 2000年10月22日 年齢: 13歳
名前を入力
Christopher Lloyd
誕生日: 2000年10月23日 年齢: 12歳
名前を入力
haskell
一覧に名前がありません。
名前を入力

終了
$ cat birth_day_helper.txt
Christopher Alexander,  Oct  18, 1936
Christopher Lambert,    Mar 12, 2000
Christopher Lee,        Mar 13, 2000
Christopher Pine,       Oct 21, 2000
Christopher Plummer,    Oct 22, 2000
Christopher Lloyd,      Oct 23, 2000
The King of Spain,      Feb 6, 2000
$

Kamimura's blog

ほしい物リスト

2013年10月22日火曜日

Haskell - モジュール(日付の操作(System.Timeモジュール)、ファイルの読み込み(System.IOモジュール))

0 コメント:

コメントを投稿