GhcApiAstTraversals: APISybTesting.hs

File APISybTesting.hs, 2.3 KB (added by claus, 7 years ago)

some example uses of SYB traversals, using derived instances and Data-based Utils over TestModule

Line 
1{-# LANGUAGE RankNTypes #-}
2
3{-# OPTIONS_GHC -package ghc #-}
4module APISybTesting where
5
6import System.IO
7import Data.Maybe
8import Data.Generics
9
10-- import qualified GHC.Paths
11import DynFlags
12import GHC
13import Outputable
14
15import Instances
16import Utils
17import Data.List
18
19compileToCoreFlag = False
20
21libdir  = "c:/fptools/ghc" -- GHC.Paths.libdir
22source  = "TestModule.hs"
23modName = "TestModule"
24
25getTyClDs :: Data a => a -> [TyClDecl RdrName]
26getTyClDs = everythingStaged Parser (++) [] ((const []) `extQ` getTyClD)
27  where getTyClD d = [ x | x@(ClassDecl{}) <- [d] ]
28                  ++ [ x | x@(TyFamily{}) <- [d] ] 
29
30main = defaultErrorHandler defaultDynFlags $ do
31  s           <- newSession (Just libdir)
32  flags       <- getSessionDynFlags s
33  (flags,_,_) <- parseDynamicFlags flags ["-package ghc"]
34  GHC.defaultCleanupHandler flags $ do
35    setSessionDynFlags s flags{ hscTarget=HscInterpreted }
36    addTarget s =<< guessTarget source Nothing
37    load s LoadAllTargets
38    unqual  <- getPrintUnqual s
39    mcm <- checkModule s (mkModuleName modName) compileToCoreFlag
40    maybe
41      (putStrLn $ "checkModule "++modName++" failed")
42      (doSomething unqual)
43      mcm
44  where doSomething unqual cm = do
45          let parsed      = parsedSource cm
46              renamed     = renamedSource cm
47              typechecked = typecheckedSource cm
48              transformed = everywhere id parsed
49              shown stage what  = (text . showData stage 0) what
50              prettied          = ppr transformed
51              queried           = getTyClDs parsed
52          putStrLn "------------------------- pretty-printed transformed"
53          printForUser stdout unqual prettied
54          putStrLn "------------------------- queried parsed"
55          mapM_ (printDump . ppr) queried
56          putStrLn "------------------------- shown transformed"
57          printForUser stdout unqual (shown Parser transformed)
58          putStrLn "------------------------- shown renamed"
59          maybe (putStrLn "no renamed source") 
60                (printForUser stdout unqual . shown Renamer) renamed
61          putStrLn "------------------------- shown type-checked"
62          maybe (putStrLn "no typechecked source")
63                (printForUser stdout unqual . shown TypeChecker) typechecked