Ticket #1886: API_Layout.hs

File API_Layout.hs, 1.6 KB (added by claus, 6 years ago)

a module parsing and pretty-printing itself via the GHC API

Line 
1{-# OPTIONS_GHC -package ghc -w #-}
2module API where
3
4import DynFlags
5import GHC
6import PprTyThing
7import System.Process
8import System.IO
9import Outputable
10import Data.Maybe
11
12-- 0. '-package' is ignored in source pragmas, without even a warning
13-- 1. comments, including pragmas, will be lost in output
14-- 2. there'll be a syntax error here due to extra lists in output
15instance Num () where fromInteger = undefined
16
17mode = CompManager
18compileToCoreFlag = False
19
20-- shouldn't something like this be in System.Process?
21writer >| cmd = runInteractiveCommand cmd >>= \(i,o,e,p)->writer i
22cmd |> reader = runInteractiveCommand cmd >>= \(i,o,e,p)->reader o
23
24-- shouldn't GHC export a hostSession,
25-- so that we could ask for things like topDir there?
26ghcDir = "c:/fptools/ghc/compiler/stage2/ghc-inplace --print-libdir" 
27          |> (fmap dropLineEnds . hGetContents)
28  where dropLineEnds = filter (not . (`elem` "\r\n"))
29
30main = defaultErrorHandler defaultDynFlags $ do
31  s          <- newSession . Just =<< ghcDir
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 "API_Layout.hs" Nothing
37    load s LoadAllTargets
38    prelude <- findModule s (mkModuleName "Prelude") Nothing
39    usermod <- findModule s (mkModuleName "API") Nothing 
40    setContext s [usermod] [prelude]
41    Just cm <- checkModule s (mkModuleName "API") compileToCoreFlag
42    unqual  <- getPrintUnqual s
43    printForUser stdout unqual $ ppr $ parsedSource cm