cụ thể hóa một module vào một kỷ lục

Question

Giả sử tôi có một mô-đun tùy ý

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

nơi foo, bar, và baz được thực hiện một cách chính xác, vv

Tôi muốn cụ thể hóa mô-đun này vào một cách tự động loại dữ liệu tương ứng và đối tượng tương ứng:

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 
    } 

Tên phải giống hệt như mô-đun ban đầu.

Tôi có thể làm điều này bằng tay, nhưng điều đó rất tẻ nhạt, vì vậy tôi muốn viết một số mã để thực hiện nhiệm vụ này cho tôi.

Tôi không thực sự chắc chắn cách tiếp cận công việc như vậy. Mẫu Haskell có cung cấp cách kiểm tra mô-đun không? Tôi có nên móc vào một số api GHC không? Hoặc tôi chỉ là tốt với một cách tiếp cận ad-hoc hơn như cạo các trang hasdock?

Answer 1

(Điều này là dành cho GHC-7.4.2; nó có thể sẽ không biên dịch với HEAD hoặc 7.6 vì một số thay đổi trong Outputable). Tôi không tìm thấy bất cứ điều gì để kiểm tra các mô-đun trong 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