zreifikować moduł do rekordu

Question

Załóżmy, że mam dowolny moduł

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

gdzie foo, bar i baz są prawidłowo wykonywane, itp

Chciałbym zreifikować tego modułu w produkt automatycznie -produkowany typ danych i odpowiedni obiekt:

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 
    } 

Nazwy muszą być dokładnie takie same jak oryginalny moduł.

Mogłem to zrobić ręcznie, ale to bardzo żmudne, więc chciałbym napisać kod, aby wykonać to zadanie dla mnie.

Nie jestem pewien, jak podejść do takiego zadania. Czy szablon Haskell umożliwia sprawdzanie modułów? Czy powinienem podłączyć się do jakiegoś api GHC? Czy mam się dobrze z bardziej ad-hoc podejście, takie jak skrobanie stron plamiaka?

Answer 1

(To jest dla GHC-7.4.2, prawdopodobnie nie będzie się kompilować z HEAD lub 7.6 z powodu pewnych zmian w Outputable). Nie znalazłem nic do sprawdzenia modułów w 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