Initial work on refining variable

Language/Haskell/GhcMod.hs

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

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

Language/Haskell/GhcMod/Ghc.hs

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

src/GHCMod.hs

@@ -40,6 +40,7 @@ usage =    progVersion
         ++ "\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 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 lint [-h opt] <HaskellFile>\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

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