Reify a module into a record

Question

Suppose I have an arbitrary module

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

where foo, bar, and baz are correctly implemented, etc.

I'd like to reify this module into an automatically-generated data type and corresponding object:

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
  }

Names must be precisely the same as the original module.

I could do this by hand, but that is very tedious, so I'd like to write some code to perform this task for me.

I'm not really sure how to approach such a task. Does Template Haskell provide a way to inspect modules? Should I hook into some GHC api? Or am I just as well off with a more ad-hoc approach such as scraping haddock pages?

Hexateuch

Could you use haskell-src-exts to parse the module source, then create your datatype from that and output a new source file? – Prognathous

haskell-src-exts is a great idea, but parsing the source wouldn't necessarily suffice. For example, the source for Data.Map simply re-exports Data.Map.Lazy with a few extra things. I need the transitive closure of all exports that a given module actually exports. It would also be nice to be able to extract the module data without having to inspect the source. – Hexateuch

Answer 1

(This is for GHC-7.4.2; it probably won't compile with HEAD or 7.6 because of some changes in Outputable). I didn't find anything to inspect modules in 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

Chandless