■ [Haskell] 設定ファイルのパースをTemplate Haskellで

キーと値からなる設定ファイルをパースするとします。設定ファイルはこんな感じです。

name=Test
value=5

マップなどで値を持つという方法もありますが、ちゃんと型付けするために専用の型を用意することにします。そうするとパースするコードはこんな感じでしょうか。

import Control.Monad
import Data.Maybe

data Config = Config {
  name  :: !String,
  value :: !Int
} deriving Show

parse :: String -> Config
parse s = let values = catMaybes $ map parseLine $ lines s
          in Config (fromMaybe "" $ lookup "name" values)
                    (fromMaybe 0 $ lookup "value" values >>= maybeRead)

parseLine :: String -> Maybe (String, String)
parseLine s = case break (== '=') s of
                ("", _) -> Nothing
                (n, v)  -> Just (n, tail v)

maybeRead :: Read a => String -> Maybe a
maybeRead s = case reads s of
                [(v, [])] -> Just v
                _         -> Nothing

設定項目が増えたら、コンストラクタの引数を増やして、parse関数を書き換えます。しかし、この二つが離れていると分かりにくいし、名前や順番を間違っていても気づかなそうです。そこで、Template Haskellを使って、設定をまとめられるようにしてみます。

{-# LANGUAGE TemplateHaskell #-}

module Key where

import Data.List.Split
import Data.Maybe
import Language.Haskell.TH

keys :: [(String, TypeQ, ExpQ, ExpQ)]
keys = [("name",  [t|String|],        [|Just . id|],         [|""|]     ),
        ("value", [t|Int|],           [|maybeRead|],         [|0|]      ),
        ("list",  [t|[String]|],      [|Just . sepBy "," |], [|[]|]     ),
        ("tuple", [t|(String, Int)|], [|maybeRead|],         [|("", 0)|])]

maybeRead :: Read a => String -> Maybe a
maybeRead s = case reads s of
                [(v, [])] -> Just v
                _         -> Nothing

keysは、設定項目のリストで、名前、型、パースするための関数、デフォルトの値を指定します。設定項目を二つほど増やしてみました。ここから、Config型とパースするための関数を生成するのが以下のコードです。

{-# LANGUAGE TemplateHaskell #-}

import Control.Monad
import Data.Maybe
import Language.Haskell.TH

import Key

$(sequence [dataD (cxt [])
                  (mkName "Config")
                  []
                  [recC (mkName "Config") (map (\(n, t, _, _) -> varStrictType (mkName n) (strictType isStrict t)) keys)]
                  [''Show]])

parse :: String -> Config
parse s = let values = catMaybes $ map parseLine $ lines s
          in $(foldl appE (conE (mkName "Config")) (map (\(n, _, f, d) -> [|fromMaybe $d $ lookup n values >>= $f|]) keys))

parseLine :: String -> Maybe (String, String)
parseLine s = case break (== '=') s of
                ("", _) -> Nothing
                (n, v)  -> Just (n, tail v)

設定項目が変わるときのメンテナンス性は上がりましたが、コード自体が複雑になって面倒くさくなったような気もします。微妙。