haskell - reificación - reificar etimologia

Reificar un módulo en un registro

Question

Supongamos que tengo un módulo arbitrario

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

donde foo , bar y baz se implementan correctamente, etc.

Me gustaría reificar este módulo en un tipo de datos generado automáticamente y un objeto correspondiente:

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
  }

Los nombres deben ser exactamente los mismos que el módulo original.

Podría hacerlo a mano, pero eso es muy tedioso, así que me gustaría escribir algún código para realizar esta tarea para mí.

No estoy muy seguro de cómo abordar esa tarea. ¿Proporciona Template Haskell una forma de inspeccionar los módulos? ¿Debo conectarme a alguna api de GHC? ¿O estoy tan bien con un enfoque más ad hoc como raspar páginas de eglefino?

Answer 1

(Esto es para GHC-7.4.2; probablemente no compilará con HEAD o 7.6 debido a algunos cambios en Outputable ). No encontré nada para inspeccionar los módulos en 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