Haskell で外部WebAPIを利用する(Google Calendar API) #Haskell

祝日情報を取得する

平日という概念が必要な、カレンダー情報を扱うアプリを作る際に「日本の祝日」をどのように取得するか悩んだ。
ローカルのデータベースに、あらかじめ祝日情報を取り込み活用する方法も検討したものの、今回はGoogle Calendar APIを用いてリクエストのたびに必要な分だけ外部から持ってくる方式を選んだ。

平日を取得するという関数は、機能を次のように分解することができる。

ある日付型の要素が、月曜日〜金曜日かどうかを判定する(isWeekDay)
任意の期間内の日本の祝日を取得する(theNationalHolidays)
与えられた要素が、指定された別のリストの要素に含まれていないかどうかを判定する(notContained)

すると、今回作る関数theWeekdayは、次のようになる（擬似的なコード）。通信するので、返り値はIOで包んでいる。

theWeekDay :: Day -> Day -> IO Day
theWeekDay start end = filter $ notContained theNationalHolidays $ filter isWeekDay [start .. end]

なお２番目の関数以外は Haskell 内部で純粋に定義できる。

import           Data.Time.Calendar
import           Data.Time.Calendar.WeekDate (toWeekDate)

-- ある日付型の要素が、月曜日〜金曜日かどうかを判定し選別する
isWeekDay :: Day -> Bool
isWeekDay d
    | w == 6 = False
    | w == 7 = False
    | otherwise = True
  where
      (_, _, w) = toWeekDate d

-- | ある要素とリストをとって、その要素が含まれていなければ`True`を返す
notContained :: Eq a => a -> [a] -> Bool
notContained word xs = word `notElem` xs

Google Calendar API

Quickstarts ということでメジャーな言語はサポートを受けられるが、残念ながらHaskellは対象外だった。

利用には認証が必要なので、Google Developers ConsoleでAPIキーを取得する。
このページを参照する。

今回利用したAPIは指定したカレンダーのイベントを返すもので、引数に渡すパラメータは幾つかあるもののほとんどが任意項目なので、目的に沿って、対象期間を指定するものだけ使う（timeMin, timeMax)。

また、指定したカレンダーは「日本の祝日(ja.japanese#holiday@group.v.calendar.google.com)」とした。

実装方針

上記のサイトを参考にして、次のような流れで実装した。ちなみにストレートにプログラムを作るのではなく、WebAPIを利用する、という意味で一部を抽象化している。

エンドポイント型クラスを作成する
GoogleCalendarEndpoint型を宣言し、エンドポイント型のインスタンスを与える
GoogleCalendarResponse型を作成し、Data.Aesonを利用して、FromJSON型クラスのインスタンスを与える
それぞれの関数を組み合わせる

エンドポイント型クラスは、エンドポイントとなるURIを構築するメソッドをもつインタフェースであり、このインスタンスになるということは、有効なURIを型安全に作成できるということを意味している。
また、受け取ったJSONデータは、GoogleCalendarResponse型を宣言してこれをFromJSON型クラスのインスタンスにすることでパースする。

実装

import           Data.Aeson
import qualified Data.List                   as List
import           Prelude
import           qualified Data.Text as T
import           Data.Text                   (split, unpack)
import           Network.HTTP                (urlEncode)
import           Network.HTTP.Conduit
import           Control.Applicative         ((<$>))
import           Control.Monad               (mzero)
import           Data.Maybe                  (catMaybes)
import           Data.Time.Calendar
import           Data.Time.Calendar.WeekDate (toWeekDate)

callJsonEndpoint :: (FromJSON j, Endpoint e) => e -> IO j
callJsonEndpoint e = do
    responseBody <- simpleHttp (buildURI e)
    case eitherDecode responseBody of
        Left err -> fail err
        Right res -> return res

toJSONDatetime :: Day -> String
toJSONDatetime d = showGregorian d ++ "T00:00:00Z"

-- このアプリのgoogle calendar key
appkey = <YOUR_API_KEY>

-- | aはクエリパラメータを包んだデータ型であり、必要に応じでURIをそれらのパラメータで構築するための型クラス
class Endpoint a where
    buildURI :: a -> String

data GoogleCalendarEndpoint =
    GoogleCalendarEndpoint { timeMin :: !String, timeMax :: !String, key :: !String }

instance Endpoint GoogleCalendarEndpoint where
    buildURI GoogleCalendarEndpoint
        { timeMin = timeMin
        , timeMax = timeMax
        , key = key } =
            let params = [ ("timeMin", Just $ timeMin)
                         , ("timeMax", Just $ timeMax)
                         , ("key", Just $ key)
                         ]
            in
            -- 日本の祝日 カレンダー "https://www.googleapis.com/calendar/v3/calendars/ja.japanese%23holiday@group.v.calendar.google.com/events"
                ++ renderQuery' True params

renderQuery' :: Bool -> [(String, Maybe String)] -> String
renderQuery' b params = (if b then "?" else "") ++ List.intercalate "&" serializedParams
  where serializedParams = catMaybes $ map renderParam params
        renderParam (key, Just val) = Just $ key ++ "=" ++ urlEncode val
        renderParam (_, Nothing) = Nothing

data NationalHoliday = NationalHoliday { date :: Day } deriving Show
newtype GoogleCalendarResponse =
        GoogleCalendarResponse { response :: [NationalHoliday] } deriving Show

-- | JSONをパースして、祝日リストを作る
instance FromJSON GoogleCalendarResponse where
    parseJSON (Object obj) =
        GoogleCalendarResponse <$> obj .: "items"
    parseJSON _ = mzero

instance FromJSON NationalHoliday where
    parseJSON (Object obj) = do
        (Object start) <- obj .: "start"
        (String date)  <- start .: "date"
        let [y, m, d] = split (== '-') date
        let holiday = fromGregorian (read (T.unpack y) :: Integer) (read (T.unpack m) :: Int) (read (T.unpack d) :: Int)
        return $ NationalHoliday holiday
    parseJSON _ = mzero

theNationalHolidays:: GoogleCalendarResponse -> IO [Day]
theNationalHolidays res = return $ map date $ response res

最終的に、次の関数を定義した。

theWeekday :: Day -> Day -> IO [Day]
theWeekday s e = do
    gr <- callJsonEndpoint $ GoogleCalendarEndpoint (toJSONDatetime s) (toJSONDatetime e) appkey
    nh <- theNationalHolidays gr
    return $ filter (flip notContained nh) $ filter isWeekDay [s..e]
    --この方がいいかもしれない
    --return $ filter (`notElem` nh) $ filter isWeekDay [s..e]

実行結果は次のようになる。

*Main> theWeekday (fromGregorian 2015 01 01) (fromGregorian 2015 01 31)
[2015-01-02,2015-01-05,2015-01-06,2015-01-07,2015-01-08,2015-01-09,2015-01-13,2015-01-14,2015-01-15,2015-01-16,2015-01-19,2015-01-20,2015-01-21,2015-01-22,2015-01-23,2015-01-26,2015-01-27,2015-01-28,2015-01-29,2015-01-30]
*Main>

終わりに

サポートのない言語、というだけで若干心が折れそうになったが、やってみると以外と簡単、しかも簡潔にまとめられたように思う。

ひとつトリッキーだったのが、FromJSON型クラスのインスタンスの与え方で、レスポンスがなんらかのリスト形式になる場合は、リストと要素を分けてインスタンス宣言するというやり方だ。ひとつのparseJSON内でリスト内の要素をパースする方法が見つからなかったのでこのような形となった。

エンドポイントの単位でデータ型を作る
レスポンスもデータ型を作ってFromJSON型クラスのインスタンスにすることでパースする
Haskell外部との関わる部分のコード量は抑える

ということを心がければ、ほかのAPI利用時にも転用できる。