3 
import Data.ConfigFile

data Test = Test 
  { field1 :: Int
  , field2 :: Bool
  , field3 :: String
  } deriving (Show)

whatMyConfigLooksLike = 
    [ ("field1", "5")
    , ("field2", "True")
    , ("field3", "I am a string")
    ]

options = fst . unzip $ whatMyConfigLooksLike

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..."
    -- I don't want to do the following
    one <- getn "field1"
    two <- getn "field2"
    three <- getn "field3"
    return $ Test one two three -- ...
    -- ... and so on because I have a data type with many fields

    -- I want to fold them onto the data constructor instead
    return $ foldl (\f s -> getn s >>= f) (Test) options
    -- but I think this doesn't type check because f's type is constantly changing?
  print rv

上記のコードでは、非常に多様なタイプのラムダを使用していfoldl (\f s -> getn s >>= f)ます。私が知る限り、これにより、次の再帰で型チェックが行われなくなります。

関数の部分的な適用を表すことができるポリモーフィックな再帰型を定義する目的で、RankNTypes 言語拡張を使用して、関数の型チェックを可能にできると思います。しかし、実験、多くの試行錯誤、および同量のエラーにより、コンパイルできるものを思いつくことができませんでした.

上記のコード例に基づいて、RankNTypes 拡張機能を実装する方法を誰かが教えてくれる (または代替案を提案する) ことができれば、非常にありがたいです。GHC 7.4.2 を使用しています。

4

2 に答える 2

5

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]])
于 2013-05-11T18:30:20.960 に答える