2012-07-20 68 views
10

假设我有一个任意模块具体化模块插入记录

module Foo where 
foo :: Moo -> Goo 
bar :: Car -> Far 
baz :: Can -> Haz 

其中foobarbaz得到正确实施,等等

我想这个模块具体化到自动 - 生成数据类型和相应的对象:

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 
    } 

名称必须是精确地相同的原始模块。

我可以手工做,但是这是非常繁琐的,所以我想编写一些代码来为我执行此任务。

我真的不知道如何处理这样的任务。模板Haskell提供了一种检查模块的方法吗?我应该钩入一些GHC API吗?还是我只是作为小康与一个更特别的方法如刮黑线鳕的网页?

+3

您可以使用'haskell-src-exts'解析模块源,然后从中创建数据类型并输出新的源文件? – 2012-07-20 02:07:32

+0

哈斯克尔-SRC-EXTS是一个伟大的想法,但解析源不一定足够了。例如,[Data.Map](http://hackage.haskell.org/packages/archive/containers/0.5.0.0/doc/html/src/Data-Map.html)的源代码只是重新导出数据。 Map.Lazy还有一些额外的东西。我需要一个给定的模块实际上出口全部出口的传递闭包。能够提取模块数据而不必检查源代码也是很好的。 – 2012-07-20 03:10:38

回答

3

(这是为GHC-7.4.2;它可能不会与HEAD编译或7.6,因为在一些Outputable的变化)。我没有发现任何东西来检查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