hasufell/ghc-mod
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Complete parenthesis on refinement

Browse Source
This commit is contained in:
Alejandro Serrano 2014-07-20 13:33:36 +02:00
parent 54d10684b9
commit eb5ec73ae1
2 changed files with 28 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
Language/Haskell/GhcMod/CaseSplit.hs
View File

@ -5,7 +5,8 @@ module Language.Haskell.GhcMod.CaseSplit (
) where ) where
import CoreMonad (liftIO) import CoreMonad (liftIO)
import Data.List (find, intercalate) import Data.Function (on)
import Data.List (find, intercalate, sortBy)
import qualified Data.Text as T import qualified Data.Text as T
import qualified Data.Text.IO as T (readFile) import qualified Data.Text.IO as T (readFile)
import qualified DataCon as Ty import qualified DataCon as Ty
@ -57,7 +58,7 @@ getSrcSpanTypeForSplit :: GhcMonad m => G.ModSummary -> Int -> Int -> m (Maybe S
getSrcSpanTypeForSplit modSum lineNo colNo = do getSrcSpanTypeForSplit modSum lineNo colNo = do
p@ParsedModule{pm_parsed_source = pms} <- G.parseModule modSum p@ParsedModule{pm_parsed_source = pms} <- G.parseModule modSum
tcm@TypecheckedModule{tm_typechecked_source = tcs} <- G.typecheckModule p tcm@TypecheckedModule{tm_typechecked_source = tcs} <- G.typecheckModule p
let bs:_ = listifySpans tcs (lineNo, colNo) :: [LHsBind Id] let bs:_ = sortBy (cmp `on` G.getLoc) $ listifySpans tcs (lineNo, colNo) :: [LHsBind Id]
varPat = find isPatternVar $ listifySpans tcs (lineNo, colNo) :: Maybe (LPat Id) varPat = find isPatternVar $ listifySpans tcs (lineNo, colNo) :: Maybe (LPat Id)
match:_ = listifyParsedSpans pms (lineNo, colNo) :: [Gap.GLMatch] match:_ = listifyParsedSpans pms (lineNo, colNo) :: [Gap.GLMatch]
case varPat of case varPat of

33
Language/Haskell/GhcMod/FillSig.hs
View File

@ -6,7 +6,8 @@ module Language.Haskell.GhcMod.FillSig (
) where ) where
import Data.Char (isSymbol) import Data.Char (isSymbol)
import Data.List (find) import Data.Function (on)
import Data.List (find, sortBy)
import Data.Maybe (isJust) import Data.Maybe (isJust)
import Exception (ghandle, SomeException(..)) import Exception (ghandle, SomeException(..))
import GHC (GhcMonad, Id, ParsedModule(..), TypecheckedModule(..), DynFlags, SrcSpan, Type, GenLocated(L)) import GHC (GhcMonad, Id, ParsedModule(..), TypecheckedModule(..), DynFlags, SrcSpan, Type, GenLocated(L))
@ -211,30 +212,46 @@ refine file lineNo colNo expr = ghandle handler body
p <- G.parseModule modSum p <- G.parseModule modSum
tcm@TypecheckedModule{tm_typechecked_source = tcs} <- G.typecheckModule p tcm@TypecheckedModule{tm_typechecked_source = tcs} <- G.typecheckModule p
ety <- G.exprType expr ety <- G.exprType expr
whenFound opt (findVar dflag style tcm tcs lineNo colNo) $ \(loc, name, rty) -> whenFound opt (findVar dflag style tcm tcs lineNo colNo) $ \(loc, name, rty, paren) ->
let eArgs = getFnArgs ety let eArgs = getFnArgs ety
rArgs = getFnArgs rty rArgs = getFnArgs rty
diffArgs' = length eArgs - length rArgs diffArgs' = length eArgs - length rArgs
diffArgs = if diffArgs' < 0 then 0 else diffArgs' diffArgs = if diffArgs' < 0 then 0 else diffArgs'
iArgs = take diffArgs eArgs iArgs = take diffArgs eArgs
in (fourInts loc, initialHead1 expr iArgs (infinitePrefixSupply name)) text = initialHead1 expr iArgs (infinitePrefixSupply name)
in (fourInts loc, doParen paren text)
handler (SomeException _) = emptyResult =<< options handler (SomeException _) = emptyResult =<< options
-- Look for the variable in the specified position -- Look for the variable in the specified position
findVar :: GhcMonad m => DynFlags -> PprStyle findVar :: GhcMonad m => DynFlags -> PprStyle
-> G.TypecheckedModule -> G.TypecheckedSource -> G.TypecheckedModule -> G.TypecheckedSource
-> Int -> Int -> m (Maybe (SrcSpan, String, Type)) -> Int -> Int -> m (Maybe (SrcSpan, String, Type, Bool))
findVar dflag style tcm tcs lineNo colNo = findVar dflag style tcm tcs lineNo colNo =
case listifySpans tcs (lineNo, colNo) :: [G.LHsExpr Id] of let lst = sortBy (cmp `on` G.getLoc) $ listifySpans tcs (lineNo, colNo) :: [G.LHsExpr Id]
e@(L _ (G.HsVar i)):_ -> in case lst of
e@(L _ (G.HsVar i)):others ->
do tyInfo <- Gap.getType tcm e do tyInfo <- Gap.getType tcm e
let name = getFnName dflag style i let name = getFnName dflag style i
if isJust tyInfo && (name == "undefined" || head name == '_') if (name == "undefined" || head name == '_') && isJust tyInfo
then let Just (s,t) = tyInfo in return $ Just (s, name, t) then let Just (s,t) = tyInfo
b = case others of -- If inside an App, we need parenthesis
[] -> False
(L _ (G.HsApp (L _ a1) (L _ a2))):_ ->
isSearchedVar i a1 || isSearchedVar i a2
_ -> False
in return $ Just (s, name, t, b)
else return Nothing else return Nothing
_ -> return Nothing _ -> return Nothing
infinitePrefixSupply :: String -> [String] infinitePrefixSupply :: String -> [String]
infinitePrefixSupply "undefined" = repeat "undefined" infinitePrefixSupply "undefined" = repeat "undefined"
infinitePrefixSupply p = map (\n -> p ++ "_" ++ show n) ([1 ..] :: [Integer]) infinitePrefixSupply p = map (\n -> p ++ "_" ++ show n) ([1 ..] :: [Integer])
doParen :: Bool -> String -> String
doParen False s = s
doParen True s = if ' ' `elem` s then '(':s ++ ")" else s
isSearchedVar :: Id -> G.HsExpr Id -> Bool
isSearchedVar i (G.HsVar i2) = i == i2
isSearchedVar _ _ = False