From 9161757f959ad55ab0480cbeedff400c6723bfb2 Mon Sep 17 00:00:00 2001 From: Alejandro Serrano Date: Fri, 1 Aug 2014 17:08:23 +0200 Subject: [PATCH] First attempt to add auto --- Language/Haskell/GhcMod.hs | 1 + Language/Haskell/GhcMod/CaseSplit.hs | 5 ++--- Language/Haskell/GhcMod/FillSig.hs | 26 ++++++++++++++++++++++++++ ghc-mod.cabal | 2 ++ src/GHCMod.hs | 2 ++ src/GHCModi.hs | 11 +++++++++++ 6 files changed, 44 insertions(+), 3 deletions(-) diff --git a/Language/Haskell/GhcMod.hs b/Language/Haskell/GhcMod.hs index c0f3615..5362ea8 100644 --- a/Language/Haskell/GhcMod.hs +++ b/Language/Haskell/GhcMod.hs @@ -36,6 +36,7 @@ module Language.Haskell.GhcMod ( , splits , sig , refine + , auto , modules , languages , flags diff --git a/Language/Haskell/GhcMod/CaseSplit.hs b/Language/Haskell/GhcMod/CaseSplit.hs index a283d64..421d20d 100644 --- a/Language/Haskell/GhcMod/CaseSplit.hs +++ b/Language/Haskell/GhcMod/CaseSplit.hs @@ -5,8 +5,7 @@ module Language.Haskell.GhcMod.CaseSplit ( ) where import CoreMonad (liftIO) -import Data.Function (on) -import Data.List (find, intercalate, sortBy) +import Data.List (find, intercalate) import Data.Maybe (isJust) import qualified Data.Text as T import qualified Data.Text.IO as T (readFile) @@ -18,7 +17,7 @@ import Language.Haskell.GhcMod.Convert import qualified Language.Haskell.GhcMod.Gap as Gap import Language.Haskell.GhcMod.Monad import Language.Haskell.GhcMod.SrcUtils -import Outputable (ppr, PprStyle) +import Outputable (PprStyle) import qualified TyCon as Ty import qualified Type as Ty diff --git a/Language/Haskell/GhcMod/FillSig.hs b/Language/Haskell/GhcMod/FillSig.hs index b5cef74..e5d197a 100644 --- a/Language/Haskell/GhcMod/FillSig.hs +++ b/Language/Haskell/GhcMod/FillSig.hs @@ -3,6 +3,7 @@ module Language.Haskell.GhcMod.FillSig ( sig , refine + , auto ) where import Data.Char (isSymbol) @@ -23,6 +24,7 @@ import qualified Type as Ty import qualified HsBinds as Ty import qualified Class as Ty import qualified Language.Haskell.Exts.Annotated as HE +import Djinn.GHC ---------------------------------------------------------------- -- INTIAL CODE FROM FUNCTION OR INSTANCE SIGNATURE @@ -143,6 +145,7 @@ getSignatureFromHE file lineNo colNo = do return $ HEFamSignature s Open name (map cleanTyVarBind tys) HE.DataFamDecl (HE.SrcSpanInfo s _) _ (HE.DHead _ name tys) _ -> return $ HEFamSignature s Open name (map cleanTyVarBind tys) + _ -> fail "" _ -> Nothing where cleanTyVarBind (HE.KindedVar _ n _) = n cleanTyVarBind (HE.UnkindedVar _ n) = n @@ -310,3 +313,26 @@ 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 + + +---------------------------------------------------------------- +-- REFINE AUTOMATICALLY +---------------------------------------------------------------- + +auto :: IOish m + => FilePath -- ^ A target file. + -> Int -- ^ Line number. + -> Int -- ^ Column number. + -> GhcModT m String +auto file lineNo colNo = ghandle handler body + where + body = inModuleContext file $ \dflag style -> do + opt <- options + modSum <- Gap.fileModSummary file + p <- G.parseModule modSum + tcm@TypecheckedModule{tm_typechecked_source = tcs} <- G.typecheckModule p + whenFound' opt (findVar dflag style tcm tcs lineNo colNo) $ \(loc, _name, rty, paren) -> do + text:_ <- djinn False rty + return (fourInts loc, doParen paren text) + + handler (SomeException _) = emptyResult =<< options diff --git a/ghc-mod.cabal b/ghc-mod.cabal index 9c7accb..f5c655b 100644 --- a/ghc-mod.cabal +++ b/ghc-mod.cabal @@ -107,6 +107,7 @@ Library , split , haskell-src-exts , text + , djinn-ghc if impl(ghc >= 7.8) Build-Depends: Cabal >= 1.18 else @@ -191,6 +192,7 @@ Test-Suite spec , split , haskell-src-exts , text + , djinn-ghc if impl(ghc >= 7.8) Build-Depends: Cabal >= 1.18 else diff --git a/src/GHCMod.hs b/src/GHCMod.hs index f38f888..8903d17 100644 --- a/src/GHCMod.hs +++ b/src/GHCMod.hs @@ -41,6 +41,7 @@ usage = progVersion ++ "\t ghc-mod split" ++ ghcOptHelp ++ " \n" ++ "\t ghc-mod sig" ++ ghcOptHelp ++ " \n" ++ "\t ghc-mod refine" ++ ghcOptHelp ++ " \n" + ++ "\t ghc-mod auto" ++ ghcOptHelp ++ " \n" ++ "\t ghc-mod find \n" ++ "\t ghc-mod lint [-h opt] \n" ++ "\t ghc-mod root\n" @@ -125,6 +126,7 @@ main = flip E.catches handlers $ do "split" -> nArgs 4 $ splits cmdArg1 (read cmdArg3) (read cmdArg4) "sig" -> nArgs 4 $ sig cmdArg1 (read cmdArg3) (read cmdArg4) "refine" -> nArgs 5 $ refine cmdArg1 (read cmdArg3) (read cmdArg4) cmdArg5 + "auto" -> nArgs 4 $ auto cmdArg1 (read cmdArg3) (read cmdArg4) "find" -> nArgs 1 $ findSymbol cmdArg1 "lint" -> nArgs 1 $ withFile lint cmdArg1 "root" -> rootInfo diff --git a/src/GHCModi.hs b/src/GHCModi.hs index 745a03c..04f68f8 100644 --- a/src/GHCModi.hs +++ b/src/GHCModi.hs @@ -131,6 +131,7 @@ loop set mvar = do "split" -> doSplit set arg "sig" -> doSig set arg "refine" -> doRefine set arg + "auto" -> doAuto set arg "boot" -> bootIt set "browse" -> browseIt set arg "quit" -> return ("quit", False, set) @@ -271,6 +272,16 @@ doRefine set fileArg = do ret <- refine file (read line) (read column) expr return (ret, True, set') +doAuto :: IOish m + => Set FilePath + -> FilePath + -> GhcModT m (String, Bool, Set FilePath) +doAuto set fileArg = do + let [file, line, column] = words fileArg + set' <- newFileSet set file + ret <- auto file (read line) (read column) + return (ret, True, set') + ---------------------------------------------------------------- bootIt :: IOish m