refactoring on convert.

Info.hs

@@ -7,6 +7,7 @@ import Control.Applicative hiding (empty)
 import Control.Exception
 import Control.Monad
 import CoreUtils
+import Data.Function
 import Data.Generics as G
 import Data.List
 import Data.Maybe
@@ -42,10 +43,7 @@ info opt fileName modstr expr = inModuleContext opt fileName modstr exprToInfo
 ----------------------------------------------------------------
 
 typeExpr :: Options -> ModuleString -> Int -> Int -> FilePath -> IO String
-typeExpr opt modstr lineNo colNo file = addNewline (outputStyle opt) <$> Info.typeOf opt file modstr lineNo colNo
+typeExpr opt modstr lineNo colNo file = Info.typeOf opt file modstr lineNo colNo
-  where
-    addNewline LispStyle = (++ "\n")
-    addNewline PlainStyle = id
 
 typeOf :: Options -> FilePath -> ModuleString -> Int -> Int -> IO String
 typeOf opt fileName modstr lineNo colNo = inModuleContext opt fileName modstr exprToType
@@ -56,30 +54,27 @@ typeOf opt fileName modstr lineNo colNo = inModuleContext opt fileName modstr ex
       tcm <- typecheckModule p
       es <- liftIO $ findExpr tcm lineNo colNo
       ts <- catMaybes <$> mapM (getType tcm) es
-      return $ format (outputStyle opt) $ sortBy (\a b -> fst a `cmp` fst b) ts
+      let sss = map toTup $ sortBy (cmp `on` fst) ts
+      return $ convert opt sss
 
-    format :: OutputStyle -> [(SrcSpan, Type)] -> String
+    toTup :: (SrcSpan, Type) -> ((Int,Int,Int,Int),String)
-    format LispStyle = tolisp . map (\(loc, e) -> "(" ++ l loc ++ " " ++ show (pretty e) ++ ")")
+    toTup (spn, typ) = (l spn, pretty typ)
-    format PlainStyle = unlines . map (\(loc, e) -> l loc ++ " " ++ pretty e)
 
-    l :: SrcSpan -> String
+    l :: SrcSpan -> (Int,Int,Int,Int)
 #if __GLASGOW_HASKELL__ >= 702
     l (RealSrcSpan spn)
 #else
     l spn | isGoodSrcSpan spn
 #endif
-      = unwords . map show $
+      = (srcSpanStartLine spn, srcSpanStartCol spn
-        [ srcSpanStartLine spn, srcSpanStartCol spn
+       , srcSpanEndLine spn, srcSpanEndCol spn)
-        , srcSpanEndLine spn, srcSpanEndCol spn ]
+    l _ = (0,0,0,0)
-    l _ = "0 0 0 0"
 
     cmp a b
       | a `isSubspanOf` b = O.LT
       | b `isSubspanOf` a = O.GT
       | otherwise = O.EQ
 
-    tolisp ls = "(" ++ unwords ls ++ ")"
-
 findExpr :: TypecheckedModule -> Int -> Int -> IO [LHsExpr Id]
 findExpr tcm line col = do
   let src = tm_typechecked_source tcm
@@ -139,9 +134,9 @@ pprInfo pefas (thing, fixity, insts)
    $$ show_fixity fixity
    $$ vcat (map pprInstance insts)
   where
-    show_fixity fix
+    show_fixity fx
-        | fix == defaultFixity = Outputable.empty
+        | fx == defaultFixity = Outputable.empty
-        | otherwise            = ppr fix <+> ppr (getName thing)
+        | otherwise           = ppr fx <+> ppr (getName thing)
 
 ----------------------------------------------------------------
 

Types.hs

@@ -1,3 +1,5 @@
+{-# LANGUAGE FlexibleInstances #-}
+
 module Types where
 
 import Control.Monad
@@ -19,12 +21,41 @@ data Options = Options {
   , operators   :: Bool
   }
 
-convert :: Options -> [String] -> String
+----------------------------------------------------------------
-convert Options{ outputStyle = LispStyle } ms = "(" ++ unwords quoted ++ ")\n"
+convert :: ToString a => Options -> a -> String
-    where
+convert Options{ outputStyle = LispStyle  } = toLisp
-      quote x = "\"" ++ x ++ "\""
+convert Options{ outputStyle = PlainStyle } = toPlain
-      quoted = map quote ms
+
-convert Options{ outputStyle = PlainStyle } ms = unlines ms
+class ToString a where
+    toLisp  :: a -> String
+    toPlain :: a -> String
+
+instance ToString [String] where
+    toLisp  = addNewLine . toSexp True
+    toPlain = unlines
+
+instance ToString [((Int,Int,Int,Int),String)] where
+    toLisp  = addNewLine . toSexp False . map toS
+      where
+        toS x = "(" ++ tupToString x ++ ")"
+    toPlain = unlines . map tupToString
+
+toSexp :: Bool -> [String] -> String
+toSexp False ss = "(" ++ unwords ss ++ ")"
+toSexp True ss  = "(" ++ unwords (map quote ss) ++ ")"
+
+tupToString :: ((Int,Int,Int,Int),String) -> String
+tupToString ((a,b,c,d),s) = show a ++ " "
+                         ++ show b ++ " "
+                         ++ show c ++ " "
+                         ++ show d ++ " "
+                         ++ quote s
+
+quote :: String -> String
+quote x = "\"" ++ x ++ "\""
+
+addNewLine :: String -> String
+addNewLine = (++ "\n")
 
 ----------------------------------------------------------------
 

elisp/ghc-info.el

@@ -125,7 +125,7 @@
      (lambda ()
        (cd cdir)
        (apply 'call-process ghc-module-command nil t nil
-	      `(,@(ghc-make-ghc-options) "type" ,file ,modname ,ln ,cn))
+	      `(,@(ghc-make-ghc-options) "-l" "type" ,file ,modname ,ln ,cn))
        (goto-char (point-min))
        (while (search-forward "[Char]" nil t)
 	 (replace-match "String"))))))