From 49437d82d9bfff62f0f9ea878dbc8aed69282411 Mon Sep 17 00:00:00 2001 From: Alejandro Serrano Date: Wed, 16 Jul 2014 18:20:52 +0200 Subject: [PATCH] Initial work on refining variable --- Language/Haskell/GhcMod.hs | 1 + Language/Haskell/GhcMod/FillSig.hs | 52 ++++++++++++++++++++++++++++++ Language/Haskell/GhcMod/Ghc.hs | 1 + src/GHCMod.hs | 3 ++ src/GHCModi.hs | 10 ++++++ 5 files changed, 67 insertions(+) diff --git a/Language/Haskell/GhcMod.hs b/Language/Haskell/GhcMod.hs index 4f081db..1f68ddf 100644 --- a/Language/Haskell/GhcMod.hs +++ b/Language/Haskell/GhcMod.hs @@ -21,6 +21,7 @@ module Language.Haskell.GhcMod ( , infoExpr , typeExpr , fillSig + , refineVar , listModules , listLanguages , listFlags diff --git a/Language/Haskell/GhcMod/FillSig.hs b/Language/Haskell/GhcMod/FillSig.hs index 8e3566f..52c6430 100644 --- a/Language/Haskell/GhcMod/FillSig.hs +++ b/Language/Haskell/GhcMod/FillSig.hs @@ -3,6 +3,8 @@ module Language.Haskell.GhcMod.FillSig ( fillSig , sig + , refineVar + , refine ) where import Data.Char (isSymbol) @@ -221,3 +223,53 @@ infiniteSupply initialSupply = initialSupply ++ concatMap (\n -> map (\v -> v ++ isSymbolName :: String -> Bool isSymbolName (c:_) = c `elem` "!#$%&*+./<=>?@\\^|-~" || isSymbol c 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 diff --git a/Language/Haskell/GhcMod/Ghc.hs b/Language/Haskell/GhcMod/Ghc.hs index 112dfd1..1c70e1e 100644 --- a/Language/Haskell/GhcMod/Ghc.hs +++ b/Language/Haskell/GhcMod/Ghc.hs @@ -10,6 +10,7 @@ module Language.Haskell.GhcMod.Ghc ( , types , splits , sig + , refine , modules -- * 'SymMdlDb' , Symbol diff --git a/src/GHCMod.hs b/src/GHCMod.hs index a2958e6..af0be01 100644 --- a/src/GHCMod.hs +++ b/src/GHCMod.hs @@ -40,6 +40,7 @@ usage = progVersion ++ "\t ghc-mod type" ++ ghcOptHelp ++ " \n" ++ "\t ghc-mod split" ++ ghcOptHelp ++ " \n" ++ "\t ghc-mod sig" ++ ghcOptHelp ++ " \n" + ++ "\t ghc-mod refine" ++ ghcOptHelp ++ " \n" ++ "\t ghc-mod find \n" ++ "\t ghc-mod lint [-h opt] \n" ++ "\t ghc-mod root\n" @@ -107,6 +108,7 @@ main = flip E.catches handlers $ do cmdArg1 = cmdArg !. 1 cmdArg3 = cmdArg !. 3 cmdArg4 = cmdArg !. 4 + cmdArg5 = cmdArg !. 5 remainingArgs = tail cmdArg nArgs n f = if length remainingArgs == n then f @@ -123,6 +125,7 @@ main = flip E.catches handlers $ do "type" -> nArgs 4 $ typeExpr 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) + "refine" -> nArgs 5 $ refineVar opt cradle cmdArg1 (read cmdArg3) (read cmdArg4) cmdArg5 "find" -> runGhcMod opt $ nArgs 1 $ findSymbol cmdArg1 "lint" -> nArgs 1 withFile (lintSyntax opt) cmdArg1 "root" -> rootInfo opt cradle diff --git a/src/GHCModi.hs b/src/GHCModi.hs index 0baf43c..ce615b8 100644 --- a/src/GHCModi.hs +++ b/src/GHCModi.hs @@ -146,6 +146,7 @@ loop opt set mvar = do "type" -> showType set arg "split" -> doSplit set arg "sig" -> doSig set arg + "refine" -> doRefine set arg "boot" -> bootIt set "browse" -> browseIt set arg "quit" -> return ("quit", False, set) @@ -273,6 +274,15 @@ doSig set fileArg = do ret <- sig file (read line) (read column) 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