First attempt to add auto

This commit is contained in:
Alejandro Serrano 2014-08-01 17:08:23 +02:00
parent e3853a49f1
commit 9161757f95
6 changed files with 44 additions and 3 deletions

View File

@ -36,6 +36,7 @@ module Language.Haskell.GhcMod (
, splits , splits
, sig , sig
, refine , refine
, auto
, modules , modules
, languages , languages
, flags , flags

View File

@ -5,8 +5,7 @@ module Language.Haskell.GhcMod.CaseSplit (
) where ) where
import CoreMonad (liftIO) import CoreMonad (liftIO)
import Data.Function (on) import Data.List (find, intercalate)
import Data.List (find, intercalate, sortBy)
import Data.Maybe (isJust) import Data.Maybe (isJust)
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)
@ -18,7 +17,7 @@ import Language.Haskell.GhcMod.Convert
import qualified Language.Haskell.GhcMod.Gap as Gap import qualified Language.Haskell.GhcMod.Gap as Gap
import Language.Haskell.GhcMod.Monad import Language.Haskell.GhcMod.Monad
import Language.Haskell.GhcMod.SrcUtils import Language.Haskell.GhcMod.SrcUtils
import Outputable (ppr, PprStyle) import Outputable (PprStyle)
import qualified TyCon as Ty import qualified TyCon as Ty
import qualified Type as Ty import qualified Type as Ty

View File

@ -3,6 +3,7 @@
module Language.Haskell.GhcMod.FillSig ( module Language.Haskell.GhcMod.FillSig (
sig sig
, refine , refine
, auto
) where ) where
import Data.Char (isSymbol) import Data.Char (isSymbol)
@ -23,6 +24,7 @@ import qualified Type as Ty
import qualified HsBinds as Ty import qualified HsBinds as Ty
import qualified Class as Ty import qualified Class as Ty
import qualified Language.Haskell.Exts.Annotated as HE import qualified Language.Haskell.Exts.Annotated as HE
import Djinn.GHC
---------------------------------------------------------------- ----------------------------------------------------------------
-- INTIAL CODE FROM FUNCTION OR INSTANCE SIGNATURE -- INTIAL CODE FROM FUNCTION OR INSTANCE SIGNATURE
@ -143,6 +145,7 @@ getSignatureFromHE file lineNo colNo = do
return $ HEFamSignature s Open name (map cleanTyVarBind tys) return $ HEFamSignature s Open name (map cleanTyVarBind tys)
HE.DataFamDecl (HE.SrcSpanInfo s _) _ (HE.DHead _ name tys) _ -> HE.DataFamDecl (HE.SrcSpanInfo s _) _ (HE.DHead _ name tys) _ ->
return $ HEFamSignature s Open name (map cleanTyVarBind tys) return $ HEFamSignature s Open name (map cleanTyVarBind tys)
_ -> fail ""
_ -> Nothing _ -> Nothing
where cleanTyVarBind (HE.KindedVar _ n _) = n where cleanTyVarBind (HE.KindedVar _ n _) = n
cleanTyVarBind (HE.UnkindedVar _ 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 :: Id -> G.HsExpr Id -> Bool
isSearchedVar i (G.HsVar i2) = i == i2 isSearchedVar i (G.HsVar i2) = i == i2
isSearchedVar _ _ = False 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

View File

@ -107,6 +107,7 @@ Library
, split , split
, haskell-src-exts , haskell-src-exts
, text , text
, djinn-ghc
if impl(ghc >= 7.8) if impl(ghc >= 7.8)
Build-Depends: Cabal >= 1.18 Build-Depends: Cabal >= 1.18
else else
@ -191,6 +192,7 @@ Test-Suite spec
, split , split
, haskell-src-exts , haskell-src-exts
, text , text
, djinn-ghc
if impl(ghc >= 7.8) if impl(ghc >= 7.8)
Build-Depends: Cabal >= 1.18 Build-Depends: Cabal >= 1.18
else else

View File

@ -41,6 +41,7 @@ usage = progVersion
++ "\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 refine" ++ ghcOptHelp ++ "<HaskellFile> <module> <line-no> <column-no> <expression>\n"
++ "\t ghc-mod auto" ++ ghcOptHelp ++ "<HaskellFile> <module> <line-no> <column-no>\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"
@ -125,6 +126,7 @@ main = flip E.catches handlers $ do
"split" -> nArgs 4 $ splits cmdArg1 (read cmdArg3) (read cmdArg4) "split" -> nArgs 4 $ splits cmdArg1 (read cmdArg3) (read cmdArg4)
"sig" -> nArgs 4 $ sig cmdArg1 (read cmdArg3) (read cmdArg4) "sig" -> nArgs 4 $ sig cmdArg1 (read cmdArg3) (read cmdArg4)
"refine" -> nArgs 5 $ refine cmdArg1 (read cmdArg3) (read cmdArg4) cmdArg5 "refine" -> nArgs 5 $ refine cmdArg1 (read cmdArg3) (read cmdArg4) cmdArg5
"auto" -> nArgs 4 $ auto cmdArg1 (read cmdArg3) (read cmdArg4)
"find" -> nArgs 1 $ findSymbol cmdArg1 "find" -> nArgs 1 $ findSymbol cmdArg1
"lint" -> nArgs 1 $ withFile lint cmdArg1 "lint" -> nArgs 1 $ withFile lint cmdArg1
"root" -> rootInfo "root" -> rootInfo

View File

@ -131,6 +131,7 @@ loop set mvar = do
"split" -> doSplit set arg "split" -> doSplit set arg
"sig" -> doSig set arg "sig" -> doSig set arg
"refine" -> doRefine set arg "refine" -> doRefine set arg
"auto" -> doAuto 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)
@ -271,6 +272,16 @@ doRefine set fileArg = do
ret <- refine file (read line) (read column) expr ret <- refine file (read line) (read column) expr
return (ret, True, set') 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 bootIt :: IOish m