[commit: ghc] supercompiler: Add pprPreview2 for comparing certain SDocs within an editor (f50d849)

Repository : ssh://darcs.haskell.org//srv/darcs/ghc

On branch  : supercompiler

http://hackage.haskell.org/trac/ghc/changeset/f50d84977b57ba60de65b6340a6100bff705d494

>---------------------------------------------------------------

commit f50d84977b57ba60de65b6340a6100bff705d494
Author: Max Bolingbroke <[email protected]>
Date:   Thu Aug 4 19:35:38 2011 +0100

    Add pprPreview2 for comparing certain SDocs within an editor

>---------------------------------------------------------------

 compiler/supercompile/Supercompile/Utilities.hs |   23 +++++++++++++++++++++++
 1 files changed, 23 insertions(+), 0 deletions(-)

diff --git a/compiler/supercompile/Supercompile/Utilities.hs b/compiler/supercompile/Supercompile/Utilities.hs
index b853c6b..070b023 100644
--- a/compiler/supercompile/Supercompile/Utilities.hs
+++ b/compiler/supercompile/Supercompile/Utilities.hs
@@ -26,6 +26,7 @@ import State hiding (mapAccumLM)
 
 import Control.Arrow (first, second, (***), (&&&))
 import Control.Applicative (Applicative(..), (<$>))
+import Control.Exception (bracket)
 import Control.Monad hiding (join)
 
 import Data.Function (on)
@@ -41,7 +42,29 @@ import qualified Data.Map as M
 import qualified Data.Graph as G
 import qualified Data.Foldable as Foldable
 
+import System.Directory
+import System.Exit
+import System.IO
 import System.IO.Unsafe (unsafePerformIO)
+import System.Process
+
+
+{-# NOINLINE pprPreview2 #-}
+pprPreview2 :: String -> SDoc -> SDoc -> a -> a
+pprPreview2 fp_base doc1 doc2 x = unsafePerformIO $ do
+    withTempFile (fp_base ++ "-1") $ \fp1 h1 -> do
+        hPutStrLn h1 (showSDoc doc1) >> hFlush h1
+        withTempFile (fp_base ++ "-2") $ \fp2 h2 -> do
+            hPutStrLn h2 (showSDoc doc2) >> hFlush h2
+            ec <- system $ "$EDITOR " ++ fp1 ++ " " ++ fp2
+            case ec of ExitSuccess   -> return x
+                       ExitFailure c -> error $ "pprPreview2(" ++ fp_base ++ "): preview failed with exit code " ++ show c
+
+withTempFile :: String -> (FilePath -> Handle -> IO a) -> IO a
+withTempFile fp_base act = do
+    tmp_dir <- getTemporaryDirectory
+    bracket (openTempFile tmp_dir fp_base) (hClose . snd) (uncurry act)
+
 
 
 -- | Copointed functors. The defining property is: