diff --git a/Language/Haskell/GhcMod/Convert.hs b/Language/Haskell/GhcMod/Convert.hs index 6683e88..118981f 100644 --- a/Language/Haskell/GhcMod/Convert.hs +++ b/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 ++) . (' ' :) diff --git a/Language/Haskell/GhcMod/Info.hs b/Language/Haskell/GhcMod/Info.hs index 353b3ae..9ca6616 100644 --- a/Language/Haskell/GhcMod/Info.hs +++ 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 - return $ convert opt $ ( toTup dflag style var - , toTup dflag style eq + Just (SplitInfo varName binding var@(_,varT) matches) -> do + return $ convert opt $ ( toTup dflag style binding + , 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) - case ps of + varPat = find isPatternVar $ listifySpans tcs (lineNo, colNo) :: Maybe (LPat Id) + 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 - pts <- getType tcm ps' - case (bts, pts) of - (Just bI, Just pI) -> return $ Just (SplitInfo (getPatternVarName ps') pI bI) - _ -> return Nothing + Just varPat' -> do + varT <- getType tcm varPat' -- Finally we get the type of the var + bsT <- getType tcm bs + case (varT, bsT) of + (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 ""