Obtain better information for case split

Language/Haskell/GhcMod/Convert.hs

@@ -80,6 +80,16 @@ instance ToString ((Int,Int,Int,Int),String) where
     toLisp  opt x = ('(' :) . tupToString opt x . (')' :)
     toPlain opt x = tupToString opt x
 
+instance ToString ((Int,Int,Int,Int),[String]) where
+    toLisp  opt (x,y) = toSexp2 $ [('(' :) . fourIntsToString opt x . (')' :), toLisp opt y]
+    toPlain opt (x,y) = inter '\n' [fourIntsToString opt x, toPlain opt y]
+
+instance ToString [(Int,Int,Int,Int)] where
+    toLisp  opt = toSexp2 . map toS
+      where
+        toS x = ('(' :) . fourIntsToString opt x . (')' :)
+    toPlain opt = inter '\n' . map (fourIntsToString opt)
+
 instance (ToString a, ToString b) => ToString (a,b) where
     toLisp  opt (x,y) = toSexp2 $ [toLisp opt x, toLisp opt y]
     toPlain opt (x,y) = inter '\n' [toPlain opt x, toPlain opt y]
@@ -88,12 +98,22 @@ instance (ToString a, ToString b, ToString c) => ToString (a,b,c) where
     toLisp  opt (x,y,z) = toSexp2 $ [toLisp opt x, toLisp opt y, toLisp opt z]
     toPlain opt (x,y,z) = inter '\n' [toPlain opt x, toPlain opt y, toPlain opt z]
 
+instance (ToString a, ToString b, ToString c, ToString d) => ToString (a,b,c,d) where
+    toLisp  opt (x,y,z,t) = toSexp2 $ [toLisp opt x, toLisp opt y, toLisp opt z, toLisp opt t]
+    toPlain opt (x,y,z,t) = inter '\n' [toPlain opt x, toPlain opt y, toPlain opt z, toPlain opt t]
+
 toSexp1 :: Options -> [String] -> Builder
 toSexp1 opt ss = ('(' :) . inter ' ' (map (quote opt) ss) . (')' :)
 
 toSexp2 :: [Builder] -> Builder
 toSexp2 ss = ('(' :) . (inter ' ' ss) . (')' :)
 
+fourIntsToString :: Options -> (Int,Int,Int,Int) -> Builder
+fourIntsToString _ (a,b,c,d) = (show a ++) . (' ' :)
+                             . (show b ++) . (' ' :)
+                             . (show c ++) . (' ' :)
+                             . (show d ++)
+
 tupToString :: Options -> ((Int,Int,Int,Int),String) -> Builder
 tupToString opt ((a,b,c,d),s) = (show a ++) . (' ' :)
                               . (show b ++) . (' ' :)

Language/Haskell/GhcMod/Info.hs

@@ -160,7 +160,7 @@ inModuleContext file action =
 
 ----------------------------------------------------------------
 
-data SplitInfo = SplitInfo G.Name (SrcSpan, Type) (SrcSpan, Type)
+data SplitInfo = SplitInfo G.Name (SrcSpan,Type) (SrcSpan, Type) [SrcSpan]
 
 -- | Splitting a variable in a equation.
 splitVar :: Options
@@ -186,25 +186,30 @@ splits opt file lineNo colNo = ghandle handler body
         splitInfo <- getSrcSpanTypeForSplit modSum lineNo colNo
         case splitInfo of
           Nothing -> return ""
-          Just (SplitInfo varName var@(_,varT) eq) -> do
+          Just (SplitInfo varName binding var@(_,varT) matches) -> do
-            return $ convert opt $ ( toTup dflag style var
+            return $ convert opt $ ( toTup dflag style binding
-                                   , toTup dflag style eq
+                                   , toTup dflag style var
+                                   , (map fourInts matches)
                                    , getTyCons dflag style varName varT)
     handler (SomeException _) = return []
 
 getSrcSpanTypeForSplit :: G.ModSummary -> Int -> Int -> Ghc (Maybe SplitInfo)
 getSrcSpanTypeForSplit modSum lineNo colNo = do
-    p <- G.parseModule modSum
+    p@ParsedModule{pm_parsed_source = pms} <- G.parseModule modSum
     tcm@TypecheckedModule{tm_typechecked_source = tcs} <- G.typecheckModule p
     let bs:_ = listifySpans tcs (lineNo, colNo) :: [LHsBind Id]
-        ps = find isPatternVar $ listifySpans tcs (lineNo, colNo) :: Maybe (LPat Id)
+        varPat  = find isPatternVar $ listifySpans tcs (lineNo, colNo) :: Maybe (LPat Id)
-    case ps of
+        match:_ = listifyParsedSpans pms (lineNo, colNo) :: [G.LMatch G.RdrName (LHsExpr G.RdrName)]
+    case varPat of
       Nothing  -> return Nothing
-      Just ps' -> do bts <- getType tcm bs
+      Just varPat' -> do
-                     pts <- getType tcm ps'
+        varT <- getType tcm varPat'  -- Finally we get the type of the var
-                     case (bts, pts) of
+        bsT  <- getType tcm bs
-                       (Just bI, Just pI) -> return $ Just (SplitInfo (getPatternVarName ps') pI bI)
+        case (varT, bsT) of
-                       _                  -> return Nothing
+          (Just varT', Just (_,bsT')) ->
+            let (L matchL (G.Match _ _ (G.GRHSs rhsLs _))) = match
+            in return $ Just (SplitInfo (getPatternVarName varPat') (matchL,bsT') varT' (map G.getLoc rhsLs) )
+          _ -> return Nothing
 
 isPatternVar :: LPat Id -> Bool
 isPatternVar (L _ (G.VarPat _)) = True
@@ -326,13 +331,11 @@ sig opt file lineNo colNo = ghandle handler body
           Nothing -> return ""
           Just (Signature loc names ty) -> do
             return $ convert opt $ ( fourInts loc
-                                   , intercalate "\n"
+                                   , map (initialFnBody dflag style ty) names
-                                       (map (initialFnBody dflag style ty) names)
                                    )
           Just (InstanceDecl loc cls) -> do
             return $ convert opt $ ( fourInts loc
-                                   , intercalate "\n"
+                                   , map (initialInstBody dflag style) (Ty.classMethods cls)
-                                       (map (initialInstBody dflag style) (Ty.classMethods cls))
                                    )
             
     handler (SomeException _) = return ""