Fwd: Generating valid Haskell code using the GHC API pretty printer

Forgot to include the list.
---------- Forwarded message ----------
From: Thomas Schilling
Hello everyone,
we are trying to use the GHC API for a source-to-source transformation on Haskell programs. The result of parsing and typechecking a module enables us to apply the transformation, but writing the transformed module back using the pretty printer (Outputable) generates invalid Haskell code.
For one thing, since even the names defined in the current module are fully qualified, the resulting code is not valid anymore.
This can be worked around, but there is another issue: Simply reading the following program and then writing it out using the pretty printer renders the resulting code invalid.
module Main where main = do if True then putStrLn "longlonglonglonglonglongline" else return () longlonglonglonglonglonglonglonglonglonglonglongname $ "test" longlonglonglonglonglonglonglonglonglonglonglongname = putStrLn
The result looks like this:
Main.main = do if GHC.Bool.True then System.IO.putStrLn "longlonglonglonglonglongline" else GHC.Base.return () Main.longlonglonglonglonglonglonglonglonglonglonglongname GHC.Base.$ "test" Main.longlonglonglonglonglonglonglonglonglonglonglongname = System.IO.putStrLn
There are two different problems in this output:
1) the indentation of "if ... then ... else" violates the "do"-block layout rule 2) the indentation of the long function call is invalid
It looks like those problems could be avoided if the pretty printer could be configured to consistently use "do { ... ; ... }" notation, but we have been unable to figure out how. Is there a canonical way to use the GHC API to pretty print to valid Haskell code?
Kind regards, Jan
Appended is our current code to execute the transformation above (the module to be read is expected in a file "dummy.hs" for simplicity). Please excuse if this might not be a minimal example.
module Main where
import GHC import GHC.Paths import Outputable
main = do x <- runGhc (Just libdir) $ do dflags <- getSessionDynFlags setSessionDynFlags (dflags { hscTarget = HscNothing, ghcLink = NoLink })
target <- guessTarget "dummy.hs" Nothing setTargets [target] load LoadAllTargets
graph <- getModuleGraph let unparsedmod = head graph
parsedmod <- parseModule unparsedmod typecheckedmod <- typecheckModule parsedmod let Just renamedsource = renamedSource typecheckedmod (group,_,_,_,_) = renamedsource moduledings = (ms_mod unparsedmod)
return (showSDoc (ppr group)) putStr $ x ++ "\n"
-- If you're happy and you know it, syntax error!
_______________________________________________ Glasgow-haskell-users mailing list Glasgow-haskell-users@haskell.org http://www.haskell.org/mailman/listinfo/glasgow-haskell-users
-- Push the envelope. Watch it bend. -- Push the envelope. Watch it bend.

Thomas Schilling wrote:
Forgot to include the list.
---------- Forwarded message ---------- From: Thomas Schilling
Date: 2009/7/22 Subject: Re: Generating valid Haskell code using the GHC API pretty printer To: Jan Schaumlöffel The pretty printer never prints { .. } for a do expression. You can control which things are printed unqualified by setting the "PrintUnqualified" part properly. The most straightforward way is to use GHC.mkPrintUnqualifiedForModule which only prints things qualified that are not imported in the given module. See 'withPprStyle' and 'mkUserStyle' in Outputable.
That said, if you're trying to do source-to-source transformations you probably want to keep the original layout as much as possible. GHC's pretty-printer isn't designed for that. GHC's syntax tree has very accurate source locations, so you could start from there and build your own pretty printer.
I believe, Language.Haskell.Pretty can properly output haskell code (and the GHC API should be able to do so, too. Does the GHC API output tabs?) Below is a snippet for parsing and printing only. Cheers Christian import Language.Haskell.Pretty as HP import Language.Haskell.Syntax import Language.Haskell.Parser import System.Environment processFile :: String -> IO () processFile file = do src <- readFile file case parseModuleWithMode (ParseMode file) src of ParseOk hsMod -> putStrLn $ HP.prettyPrint hsMod ParseFailed loc err -> fail $ err ++ " in '" ++ file ++ "' line " ++ show (srcLine loc) main :: IO () main = do args <- getArgs mapM_ processFile args

I believe, Language.Haskell.Pretty can properly output haskell code (and the GHC API should be able to do so, too. Does the GHC API output tabs?)
Surely you mean Language.Haskell.Exts.Pretty, right? ;-) The haskell-src-exts library does not (yet) support full round-tripping source-to-source, so the generated output will be different from what was read. But it will at least produce valid output. Hopefully in a few months' time it will do the full round-tripping as well, at least that's the plan. In general, unless you actually want to use any other components of the GHC API, e.g. evaluate your code, then I see no reason to use the GHC API for source manipulation. haskell-src-exts simply does that better (and definitely better than haskell-src). But I couldn't tell if that's enough for the original poster's needs. :-) [/shameless plug] Cheers, /Niklas

Niklas Broberg wrote:
I believe, Language.Haskell.Pretty can properly output haskell code (and the GHC API should be able to do so, too. Does the GHC API output tabs?)
Surely you mean Language.Haskell.Exts.Pretty, right? ;-)
The haskell-src-exts library does not (yet) support full round-tripping source-to-source, so the generated output will be different from what was read. But it will at least produce valid output. Hopefully in a few months' time it will do the full round-tripping as well, at least that's the plan.
In general, unless you actually want to use any other components of the GHC API, e.g. evaluate your code,
The original post did mention the need for typechecking. Cheers, Ganesh =============================================================================== Please access the attached hyperlink for an important electronic communications disclaimer: http://www.credit-suisse.com/legal/en/disclaimer_email_ib.html ===============================================================================
participants (4)
-
Christian Maeder
-
Niklas Broberg
-
Sittampalam, Ganesh
-
Thomas Schilling