등 I는 <code>foo</code>, <code>bar</code> 및 <code>baz</code> 올바르게 구현</p> <pre><code>module Foo where foo :: Moo -> Goo bar :: Car -> Far baz :: Can -> Haz </code></pre> <p>임의의 모듈이

Question

한다고 가정 레코드에 모듈을 구체화

I은 ​​자동으로이 모듈을 구체화하려는 생성 된 데이터 형식 및 해당 개체 :

import Foo (Moo, Goo, Car, Far, Can, Haz) 
import qualified Foo 

data FooModule = Foo 
    { foo :: Moo -> Goo 
    , bar :: Car -> Far 
    , baz :: Can -> Haz 
    } 

_Foo_ = Foo 
    { foo = Foo.foo 
    , bar = Foo.bar 
    , baz = Foo.baz 
    } 

이름은 원래 모듈과 정확하게 동일해야합니다.

저는이 작업을 직접 수행 할 수 있지만 매우 지루한 작업이므로이 작업을 수행 할 코드를 작성하고 싶습니다.

나는 그런 작업에 어떻게 접근해야하는지 잘 모르겠습니다. Template Haskell은 모듈 검사 방법을 제공합니까? 일부 GHC API에 연결해야합니까? 아니면 방목막 페이지를 긁어내는 것과 같은 임시 방편으로 접근하고 있습니까?

Answer 1

(GHC-7.4.2 용이며, Outputable의 변경으로 인해 HEAD 또는 7.6으로 컴파일되지 않을 수 있음). 나는 TH에서 모듈을 검사 할 어떤 것도 찾지 못했습니다.

{-# LANGUAGE NoMonomorphismRestriction #-} 
{-# OPTIONS -Wall #-} 
import GHC 
import GHC.Paths -- ghc-paths package 
import Outputable 
import GhcMonad 

main :: IO() 
main = runGhc (Just libdir) $ goModule "Data.Map" 

goModule :: GhcMonad m => String -> m() 
goModule modStr = do 
    df <- getSessionDynFlags 
    _ <- setSessionDynFlags df 
    --^Don't know if this is the correct way, but it works for this purpose 

    setContext [IIDecl (simpleImportDecl (mkModuleName modStr))] 
    infos <- mapM getInfo =<< getNamesInScope 
    let ids = onlyIDs infos 
    liftIO . putStrLn . showSDoc . render $ ids 

onlyIDs :: [Maybe (TyThing, Fixity, [Instance])] -> [Id] 
onlyIDs infos = [ i | Just (AnId i, _, _) <- infos ] 

render :: [Id] -> SDoc 
render ids = mkFields ids $$ text "------------" $$ mkInits ids 

mkFields :: [Id] -> SDoc 
mkFields = vcat . map (\i -> 
    text "," <+> pprUnqual i <+> text "::" <+> ppr (idType i)) 

mkInits :: [Id] -> SDoc 
mkInits = vcat . map (\i -> 
    text "," <+> pprUnqual i <+> text "=" <+> ppr i) 


-- * Helpers 

withUnqual :: SDoc -> SDoc 
withUnqual = withPprStyle (mkUserStyle neverQualify AllTheWay) 

pprUnqual :: Outputable a => a -> SDoc 
pprUnqual = withUnqual . ppr