cabal-dev-scripts/src/Capture.hs

   1 module Capture (capture) where
   2
   3 import Language.Haskell.TH
   4 import Language.Haskell.TH.Syntax (NameFlavour (..), Name (..))
   5 import Control.Monad.IO.Class
   6
   7 import Data.Generics as SYB
   8
   9 -- | Capture the source code of declarations in the variable
  10 capture
  11     :: String   -- ^ variable name
  12     -> Q [Dec]  -- ^ definitions
  13     -> Q [Dec]
  14 capture name decls = do
  15     decls1 <- decls
  16
  17     -- mangle all names to drop unique suffixes and module prefixes
  18     let decls2 = SYB.everywhere (SYB.mkT mangleName) decls1
  19     let declsStr = pprint decls2
  20     -- liftIO (putStrLn declsStr)
  21
  22     let nameTyDecl :: Dec
  23         nameTyDecl = SigD (mkName name) (ConT (mkName "String"))
  24
  25         nameDecl :: Dec
  26         nameDecl = ValD (VarP $ mkName name) (NormalB (LitE (StringL declsStr))) []
  27
  28     return $ nameTyDecl : nameDecl : decls1
  29   where
  30     mangleName :: Name -> Name
  31     mangleName (Name occ _) = Name occ NameS