Initial work on refining variable

This commit is contained in:
Alejandro Serrano 2014-07-16 18:20:52 +02:00
parent 72679c619c
commit 49437d82d9
5 changed files with 67 additions and 0 deletions

View File

@ -21,6 +21,7 @@ module Language.Haskell.GhcMod (
, infoExpr , infoExpr
, typeExpr , typeExpr
, fillSig , fillSig
, refineVar
, listModules , listModules
, listLanguages , listLanguages
, listFlags , listFlags

View File

@ -3,6 +3,8 @@
module Language.Haskell.GhcMod.FillSig ( module Language.Haskell.GhcMod.FillSig (
fillSig fillSig
, sig , sig
, refineVar
, refine
) where ) where
import Data.Char (isSymbol) import Data.Char (isSymbol)
@ -221,3 +223,53 @@ infiniteSupply initialSupply = initialSupply ++ concatMap (\n -> map (\v -> v ++
isSymbolName :: String -> Bool isSymbolName :: String -> Bool
isSymbolName (c:_) = c `elem` "!#$%&*+./<=>?@\\^|-~" || isSymbol c isSymbolName (c:_) = c `elem` "!#$%&*+./<=>?@\\^|-~" || isSymbol c
isSymbolName [] = error "This should never happen" isSymbolName [] = error "This should never happen"
----------------------------------------------------------------
-- REWRITE A HOLE / UNDEFINED VIA A FUNCTION
----------------------------------------------------------------
-- | Create a initial body from a signature.
refineVar :: Options
-> Cradle
-> FilePath -- ^ A target file.
-> Int -- ^ Line number.
-> Int -- ^ Column number.
-> Expression -- ^ A Haskell expression.
-> IO String
refineVar opt cradle file lineNo colNo e = runGhcMod opt $ do
initializeFlagsWithCradle opt cradle
refine file lineNo colNo e
refine :: FilePath -- ^ A target file.
-> Int -- ^ Line number.
-> Int -- ^ Column number.
-> Expression -- ^ A Haskell expression.
-> GhcMod String
refine file lineNo colNo expr = ghandle handler body
where
body = inModuleContext file $ \dflag style -> do
opt <- options
modSum <- Gap.fileModSummary file
ty <- G.exprType expr
whenFound opt (findVar modSum lineNo colNo) $ \s -> case s of
loc -> "a"
handler (SomeException _) = emptyResult =<< options
-- Look for the variable in the specified
findVar :: GhcMonad m => G.ModSummary -> Int -> Int -> m (SrcSpan, Type)
findVar modSum lineNo colNo = do
p <- G.parseModule modSum
tcm@TypecheckedModule{tm_typechecked_source = tcs} <- G.typecheckModule p
let es = listifySpans tcs (lineNo, colNo) :: [LHsExpr Id]
ets <- mapM (getType tcm) es
return $ catMaybes $ concat [ets, bts, pts]
findVar :: GhcMonad m => G.ModSummary -> Int -> Int -> m (Maybe SrcSpan)
findVar modSum lineNo colNo = do
ParsedModule{pm_parsed_source = ps} <- G.parseModule modSum
-- Inspect the parse tree to find the variable
case listifyParsedSpans ps (lineNo, colNo) :: [G.LHsExpr G.RdrName] of
(L loc (G.HsVar _)):_ -> return $ Just loc
_ -> return Nothing

View File

@ -10,6 +10,7 @@ module Language.Haskell.GhcMod.Ghc (
, types , types
, splits , splits
, sig , sig
, refine
, modules , modules
-- * 'SymMdlDb' -- * 'SymMdlDb'
, Symbol , Symbol

View File

@ -40,6 +40,7 @@ usage = progVersion
++ "\t ghc-mod type" ++ ghcOptHelp ++ "<HaskellFile> <module> <line-no> <column-no>\n" ++ "\t ghc-mod type" ++ ghcOptHelp ++ "<HaskellFile> <module> <line-no> <column-no>\n"
++ "\t ghc-mod split" ++ ghcOptHelp ++ "<HaskellFile> <module> <line-no> <column-no>\n" ++ "\t ghc-mod split" ++ ghcOptHelp ++ "<HaskellFile> <module> <line-no> <column-no>\n"
++ "\t ghc-mod sig" ++ ghcOptHelp ++ "<HaskellFile> <module> <line-no> <column-no>\n" ++ "\t ghc-mod sig" ++ ghcOptHelp ++ "<HaskellFile> <module> <line-no> <column-no>\n"
++ "\t ghc-mod refine" ++ ghcOptHelp ++ "<HaskellFile> <module> <line-no> <column-no> <expression>\n"
++ "\t ghc-mod find <symbol>\n" ++ "\t ghc-mod find <symbol>\n"
++ "\t ghc-mod lint [-h opt] <HaskellFile>\n" ++ "\t ghc-mod lint [-h opt] <HaskellFile>\n"
++ "\t ghc-mod root\n" ++ "\t ghc-mod root\n"
@ -107,6 +108,7 @@ main = flip E.catches handlers $ do
cmdArg1 = cmdArg !. 1 cmdArg1 = cmdArg !. 1
cmdArg3 = cmdArg !. 3 cmdArg3 = cmdArg !. 3
cmdArg4 = cmdArg !. 4 cmdArg4 = cmdArg !. 4
cmdArg5 = cmdArg !. 5
remainingArgs = tail cmdArg remainingArgs = tail cmdArg
nArgs n f = if length remainingArgs == n nArgs n f = if length remainingArgs == n
then f then f
@ -123,6 +125,7 @@ main = flip E.catches handlers $ do
"type" -> nArgs 4 $ typeExpr opt cradle cmdArg1 (read cmdArg3) (read cmdArg4) "type" -> nArgs 4 $ typeExpr opt cradle cmdArg1 (read cmdArg3) (read cmdArg4)
"split" -> nArgs 4 $ splitVar opt cradle cmdArg1 (read cmdArg3) (read cmdArg4) "split" -> nArgs 4 $ splitVar opt cradle cmdArg1 (read cmdArg3) (read cmdArg4)
"sig" -> nArgs 4 $ fillSig opt cradle cmdArg1 (read cmdArg3) (read cmdArg4) "sig" -> nArgs 4 $ fillSig opt cradle cmdArg1 (read cmdArg3) (read cmdArg4)
"refine" -> nArgs 5 $ refineVar opt cradle cmdArg1 (read cmdArg3) (read cmdArg4) cmdArg5
"find" -> runGhcMod opt $ nArgs 1 $ findSymbol cmdArg1 "find" -> runGhcMod opt $ nArgs 1 $ findSymbol cmdArg1
"lint" -> nArgs 1 withFile (lintSyntax opt) cmdArg1 "lint" -> nArgs 1 withFile (lintSyntax opt) cmdArg1
"root" -> rootInfo opt cradle "root" -> rootInfo opt cradle

View File

@ -146,6 +146,7 @@ loop opt set mvar = do
"type" -> showType set arg "type" -> showType set arg
"split" -> doSplit set arg "split" -> doSplit set arg
"sig" -> doSig set arg "sig" -> doSig set arg
"refine" -> doRefine set arg
"boot" -> bootIt set "boot" -> bootIt set
"browse" -> browseIt set arg "browse" -> browseIt set arg
"quit" -> return ("quit", False, set) "quit" -> return ("quit", False, set)
@ -273,6 +274,15 @@ doSig set fileArg = do
ret <- sig file (read line) (read column) ret <- sig file (read line) (read column)
return (ret, True, set') return (ret, True, set')
doRefine :: Set FilePath
-> FilePath
-> GhcMod (String, Bool, Set FilePath)
doRefine set fileArg = do
let [file, line, column, expr] = words fileArg
set' <- newFileSet set file
ret <- rewrite file (read line) (read column) expr
return (ret, True, set')
---------------------------------------------------------------- ----------------------------------------------------------------
bootIt :: Set FilePath bootIt :: Set FilePath