TL;DR : 「コードの概要」の下にあるモジュールを使用して、コードを生成します。
ボイラープレート コードをすべて書くのは耐えられません。とても共感できます。他にも方法はありますが、Template Haskell を使用して必要なコードを生成できます。
Template Haskell を初めて使用する場合は、haskellwiki ページを参照してください。
まず、Template Haskell 拡張機能を有効にして、Control.Applicative をインポートしてコードを少し整理しましょう。
{-# LANGUAGE TemplateHaskell #-}
import Language.Haskell.TH
import Control.Applicative
どのテンプレート Haskell コードを生成する必要がありますか?
そして、ghci に適切な式を変換してもらいましょう。getn
(便宜上、スタンドアロン コードで使用できるように関数を偽造しました。)
*Main> :set -XTemplateHaskell
*Main> runQ [| Test <$> getn "field1" <*> getn "field2" <*> getn "field3" |]
InfixE (Just (InfixE (Just (InfixE (Just (ConE Main.Test)) (VarE Data.Functor.<$>) (Just (AppE (VarE Main.getn) (LitE (StringL "field1")))))) (VarE Control.Applicative.<*>) (Just (AppE (VarE Main.getn) (LitE (StringL "field2")))))) (VarE Control.Applicative.<*>) (Just (AppE (VarE Main.getn) (LitE (StringL "field3"))))
うわー!それを少し整理して、有効な Haskell コードにしましょう。Data.Functor.<$>
まず、 のような式は実際には 型であることに注意してくださいName
。それを取得するためにできることはありますが、文字列マングリングはソース コード操作の中で最も醜いものなので、関数から (完全修飾された) 名前を生成する代わりにmkName "<$>"
実行しましょう。'(<$>)
whatWeWant = InfixE
(Just (InfixE
(Just (InfixE
(Just (ConE 'Test))
(VarE '(<$>))
(Just (AppE (VarE 'getn) (LitE (StringL "field1"))))))
(VarE '(<*>))
(Just (AppE (VarE 'getn) (LitE (StringL "field2"))))))
(VarE '(<*>))
(Just (AppE (VarE 'getn) (LitE (StringL "field3"))))
これの (隠れた) 美しさは、非常によく似た表現をまとめてまとめることができるということです。
必要な式を生成する
fieldExpressions :: Name -> [String] -> [Exp]
fieldExpressions getter = map $ \field -> AppE (VarE getter) (LitE (StringL field))
式を と一緒に接着するため<<*>>
のリフトのようなものとして使用しましょう:<*>
<*>
(<<*>>) :: Exp -> Exp -> Exp
a <<*>> b = InfixE (Just a) (VarE '(<*>)) (Just b)
フィールドを取得したら、<$>
まず最初のフィールドにコンストラクタを介して適用し、それを他のフィールドの折り畳みのベースとして使用できます。
getFields :: Name -> [Exp] -> Exp
getFields _ [] = error "getFields: empty field list"
getFields constructor (f:fs) = foldl (<<*>>)
( InfixE (Just $ ConE constructor) (VarE '(<$>)) (Just f) )
fs
簡単なチェック:
*Main> whatWeWant == (getFields 'Test $ fieldExpressions 'getn ["field1","field2","field3"])
True
ステージ制限が刺さる
同じソースファイルでそれをテスト/使用できます
domything = do
optionsRecord <- $(return $ getFields 'Test $ fieldExpressions 'getn ["field1","field2","field3"])
print optionsRecord
かなり不便なステージ制限に遭遇することを除いて:
GHC stage restriction: `getFields'
is used in a top-level splice or annotation,
and must be imported, not defined locally
つまりgetFields
、別のモジュールで etc を定義し、それをスプライスできるメイン ファイルにインポートする必要があります。
コードのまとめ
GetFields.hs:
{-# LANGUAGE TemplateHaskell #-}
import Language.Haskell.TH
import Control.Applicative
module GetFields where
fieldExpressions :: Name -> [String] -> [Exp]
fieldExpressions getter = map $ \field -> AppE (VarE getter) (LitE (StringL field))
(<<*>>) :: Exp -> Exp -> Exp
a <<*>> b = InfixE (Just a) (VarE '(<*>)) (Just b)
getFields :: Name -> [Exp] -> Exp
getFields _ [] = error "getFields: empty field list"
getFields constructor (f:fs) = foldl (<<*>>)
( InfixE (Just $ ConE constructor) (VarE '(<$>)) (Just f) )
fs
Main.hs:
import GetFields
import Data.ConfigFile
...defs...
readConfigFile = do
rv <- runErrorT $ do
cp <- join . liftIO $ readfile emptyCP "theconfig.cfg"
let printn = liftIO . putStrLn
getn = get x "DEFAULT"
x = cp
printn "Loading configuration file..."
someoptions <- $(getFields 'Test $ fieldExpressions 'getn ["field" ++ show n| n<-[1..30]])