From 9161757f959ad55ab0480cbeedff400c6723bfb2 Mon Sep 17 00:00:00 2001 From: Alejandro Serrano Date: Fri, 1 Aug 2014 17:08:23 +0200 Subject: [PATCH 1/9] 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 From 3aa83e14dd55c7a22470d8369aaddae6d79a308e Mon Sep 17 00:00:00 2001 From: Alejandro Serrano Date: Sat, 2 Aug 2014 09:52:36 +0200 Subject: [PATCH 2/9] Show more than one Djinn completion --- Language/Haskell/GhcMod/Convert.hs | 5 ++++ Language/Haskell/GhcMod/FillSig.hs | 6 ++-- elisp/ghc-func.el | 20 +++++++++++++- elisp/ghc-rewrite.el | 44 ++++++++++++++++++++++++++++++ elisp/ghc.el | 2 ++ 5 files changed, 73 insertions(+), 4 deletions(-) diff --git a/Language/Haskell/GhcMod/Convert.hs b/Language/Haskell/GhcMod/Convert.hs index a386e7e..0b53f3b 100644 --- a/Language/Haskell/GhcMod/Convert.hs +++ b/Language/Haskell/GhcMod/Convert.hs @@ -81,6 +81,11 @@ instance ToString ((Int,Int,Int,Int),String) where toLisp opt x = ('(' :) . tupToString opt x . (')' :) toPlain opt x = tupToString opt x +instance ToString ((Int,Int,Int,Int),[String]) where + toLisp opt (x,s) = ('(' :) . fourIntsToString opt x . + (' ' :) . toLisp opt s . (')' :) + toPlain opt (x,s) = fourIntsToString opt x . ('\n' :) . toPlain opt s + instance ToString (String, (Int,Int,Int,Int),[String]) where toLisp opt (s,x,y) = toSexp2 [toLisp opt s, ('(' :) . fourIntsToString opt x . (')' :), toLisp opt y] toPlain opt (s,x,y) = inter '\n' [toPlain opt s, fourIntsToString opt x, toPlain opt y] diff --git a/Language/Haskell/GhcMod/FillSig.hs b/Language/Haskell/GhcMod/FillSig.hs index e5d197a..eb10b1f 100644 --- a/Language/Haskell/GhcMod/FillSig.hs +++ b/Language/Haskell/GhcMod/FillSig.hs @@ -8,7 +8,7 @@ module Language.Haskell.GhcMod.FillSig ( import Data.Char (isSymbol) import Data.Function (on) -import Data.List (find, sortBy) +import Data.List (find, nub, sortBy) import Data.Maybe (isJust) import Exception (ghandle, SomeException(..)) import GHC (GhcMonad, Id, ParsedModule(..), TypecheckedModule(..), DynFlags, SrcSpan, Type, GenLocated(L)) @@ -332,7 +332,7 @@ auto file lineNo colNo = ghandle handler body 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) + djinns <- djinn True rty + return (fourInts loc, map (doParen paren) (nub djinns)) handler (SomeException _) = emptyResult =<< options diff --git a/elisp/ghc-func.el b/elisp/ghc-func.el index 5d73c60..e17fb33 100644 --- a/elisp/ghc-func.el +++ b/elisp/ghc-func.el @@ -146,7 +146,25 @@ (defconst ghc-error-buffer-name "*GHC Info*") (defun ghc-display (fontify ins-func) - (let ((buf ghc-error-buffer-name)) + (ghc-display-with-name fontify ins-func ghc-error-buffer-name)) + +;; (defun ghc-display (fontify ins-func) +;; (let ((buf ghc-error-buffer-name)) +;; (with-output-to-temp-buffer buf +;; (with-current-buffer buf +;; (erase-buffer) +;; (funcall ins-func) +;; (goto-char (point-min)) +;; (if (not fontify) +;; (turn-off-haskell-font-lock) +;; (haskell-font-lock-defaults-create) +;; (turn-on-haskell-font-lock))) +;; (display-buffer buf +;; '((display-buffer-reuse-window +;; display-buffer-pop-up-window)))))) + +(defun ghc-display-with-name (fontify ins-func name) + (let ((buf name)) (with-output-to-temp-buffer buf (with-current-buffer buf (erase-buffer) diff --git a/elisp/ghc-rewrite.el b/elisp/ghc-rewrite.el index 764129e..a392567 100644 --- a/elisp/ghc-rewrite.el +++ b/elisp/ghc-rewrite.el @@ -70,6 +70,50 @@ (cmd (format "refine %s %s %s %s\n" file ln cn expr))) (ghc-sync-process cmd))) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; +;;; Auto +;;; + +(defun ghc-perform-rewriting-auto (info) + "Replace code with new string obtained from ghc-mod from auto mode" + (let* ((current-line (line-number-at-pos)) + (begin-line (ghc-sinfo-get-beg-line info)) + (begin-line-diff (+ 1 (- begin-line current-line))) + (begin-line-pos (line-beginning-position begin-line-diff)) + (begin-pos (- (+ begin-line-pos (ghc-sinfo-get-beg-column info)) 1)) + (end-line (ghc-sinfo-get-end-line info)) + (end-line-diff (+ 1 (- end-line current-line))) + (end-line-pos (line-beginning-position end-line-diff)) + (end-pos (- (+ end-line-pos (ghc-sinfo-get-end-column info)) 1)) ) + (delete-region begin-pos end-pos) + (insert (first (ghc-sinfo-get-info info))) ) + ) + +(defun ghc-show-auto-messages (msgs) + (ghc-display-with-name nil + (lambda () + (insert "Possible completions:\n") + (mapc (lambda (x) (insert "- " x "\n")) msgs)) + "*Djinn completions*")) + +(defun ghc-auto () + "Try to automatically fill the contents of a hole" + (interactive) + (let ((info (ghc-obtain-auto))) + (if (null info) + (message "No automatic completions found") + (if (= (length (ghc-sinfo-get-info info)) 1) + (ghc-perform-rewriting-auto info) + (ghc-show-auto-messages (ghc-sinfo-get-info info)))))) + +(defun ghc-obtain-auto () + (let* ((ln (int-to-string (line-number-at-pos))) + (cn (int-to-string (1+ (current-column)))) + (file (buffer-file-name)) + (cmd (format "auto %s %s %s\n" file ln cn))) + (ghc-sync-process cmd))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; Initial code from signature diff --git a/elisp/ghc.el b/elisp/ghc.el index 3440b70..9260181 100644 --- a/elisp/ghc.el +++ b/elisp/ghc.el @@ -76,6 +76,7 @@ (defvar ghc-case-split-key "\C-c\C-s") (defvar ghc-initial-sig-key "\C-c\C-g") (defvar ghc-refine-key "\C-c\C-r") +(defvar ghc-auto-key "\C-c\C-a") (defvar ghc-prev-hole-key "\C-c\ep") (defvar ghc-next-hole-key "\C-c\en") @@ -113,6 +114,7 @@ (define-key haskell-mode-map ghc-case-split-key 'ghc-case-split) (define-key haskell-mode-map ghc-initial-sig-key 'ghc-initial-code-from-signature) (define-key haskell-mode-map ghc-refine-key 'ghc-refine) + (define-key haskell-mode-map ghc-auto-key 'ghc-auto) (define-key haskell-mode-map ghc-prev-hole-key 'ghc-goto-prev-hole) (define-key haskell-mode-map ghc-next-hole-key 'ghc-goto-next-hole) (ghc-comp-init) From 5623c622006427eda9e971c49e1755ba62f10a1d Mon Sep 17 00:00:00 2001 From: Alejandro Serrano Date: Sat, 2 Aug 2014 10:27:40 +0200 Subject: [PATCH 3/9] Support for multiple completions in Emacs --- elisp/ghc-check.el | 1 + elisp/ghc-rewrite.el | 41 ++++++++++++++++++++++++++++++----------- 2 files changed, 31 insertions(+), 11 deletions(-) diff --git a/elisp/ghc-check.el b/elisp/ghc-check.el index 68b42a3..72b770e 100644 --- a/elisp/ghc-check.el +++ b/elisp/ghc-check.el @@ -256,6 +256,7 @@ nil does not display errors/warnings. (define-button-type 'find-file-button 'follow-link t + 'help-echo "mouse-2, RET: Go to definition" 'action #'find-file-button) (defun buttonize-buffer () diff --git a/elisp/ghc-rewrite.el b/elisp/ghc-rewrite.el index a392567..98f765b 100644 --- a/elisp/ghc-rewrite.el +++ b/elisp/ghc-rewrite.el @@ -75,7 +75,7 @@ ;;; Auto ;;; -(defun ghc-perform-rewriting-auto (info) +(defun ghc-perform-rewriting-auto (info msg) "Replace code with new string obtained from ghc-mod from auto mode" (let* ((current-line (line-number-at-pos)) (begin-line (ghc-sinfo-get-beg-line info)) @@ -87,15 +87,34 @@ (end-line-pos (line-beginning-position end-line-diff)) (end-pos (- (+ end-line-pos (ghc-sinfo-get-end-column info)) 1)) ) (delete-region begin-pos end-pos) - (insert (first (ghc-sinfo-get-info info))) ) - ) + (insert msg))) -(defun ghc-show-auto-messages (msgs) - (ghc-display-with-name nil - (lambda () - (insert "Possible completions:\n") - (mapc (lambda (x) (insert "- " x "\n")) msgs)) - "*Djinn completions*")) +(defun auto-button (button) + (let ((text (buffer-substring (button-start button) (button-end button)))) + (with-current-buffer ghc-auto-buffer + (ghc-perform-rewriting-auto ghc-auto-info text)))) + +(define-button-type 'auto-button + 'follow-link t + 'help-echo "mouse-2, RET: Insert this completion" + 'action #'auto-button) + +(defun ghc-show-auto-messages (info) + (let ((buf (current-buffer))) + (setq ghc-auto-info info) + (setq ghc-auto-buffer buf) + (ghc-display nil + (lambda () + (insert "Possible completions:\n") + (mapc + (lambda (x) + (let* ((ins1 (insert "- ")) + (pos-begin (point)) + (ins (insert x)) + (pos-end (point)) + (ins3 (insert "\n"))) + (make-button pos-begin pos-end :type 'auto-button))) + (ghc-sinfo-get-info info)))))) (defun ghc-auto () "Try to automatically fill the contents of a hole" @@ -104,8 +123,8 @@ (if (null info) (message "No automatic completions found") (if (= (length (ghc-sinfo-get-info info)) 1) - (ghc-perform-rewriting-auto info) - (ghc-show-auto-messages (ghc-sinfo-get-info info)))))) + (ghc-perform-rewriting-auto info (first (ghc-sinfo-get-info info))) + (ghc-show-auto-messages info))))) (defun ghc-obtain-auto () (let* ((ln (int-to-string (line-number-at-pos))) From 9cc6476df19a9758ea68e14c606318ebd42d1670 Mon Sep 17 00:00:00 2001 From: Alejandro Serrano Date: Sun, 3 Aug 2014 19:14:42 +0200 Subject: [PATCH 4/9] Add better support for auto, with several options searched --- Language/Haskell/GhcMod/FillSig.hs | 94 ++++++++++++++++++++++++++++-- ghc-mod.cabal | 4 +- 2 files changed, 91 insertions(+), 7 deletions(-) diff --git a/Language/Haskell/GhcMod/FillSig.hs b/Language/Haskell/GhcMod/FillSig.hs index eb10b1f..cfdbd19 100644 --- a/Language/Haskell/GhcMod/FillSig.hs +++ b/Language/Haskell/GhcMod/FillSig.hs @@ -9,20 +9,26 @@ module Language.Haskell.GhcMod.FillSig ( import Data.Char (isSymbol) import Data.Function (on) import Data.List (find, nub, sortBy) -import Data.Maybe (isJust) +import qualified Data.Map.Strict as M +import Data.Maybe (isJust, catMaybes) import Exception (ghandle, SomeException(..)) import GHC (GhcMonad, Id, ParsedModule(..), TypecheckedModule(..), DynFlags, SrcSpan, Type, GenLocated(L)) import qualified GHC as G +import qualified ConLike as G +import qualified Name as G import qualified Language.Haskell.GhcMod.Gap as Gap import Language.Haskell.GhcMod.Convert import Language.Haskell.GhcMod.Monad import Language.Haskell.GhcMod.SrcUtils import Language.Haskell.GhcMod.Types import CoreMonad (liftIO) -import Outputable (PprStyle) +import Outputable (PprStyle, ppr) import qualified Type as Ty import qualified HsBinds as Ty import qualified Class as Ty +import qualified Var as Ty +import qualified DataCon as Ty +import qualified HsPat as Ty import qualified Language.Haskell.Exts.Annotated as HE import Djinn.GHC @@ -330,9 +336,87 @@ auto file lineNo colNo = ghandle handler body opt <- options modSum <- Gap.fileModSummary file p <- G.parseModule modSum - tcm@TypecheckedModule{tm_typechecked_source = tcs} <- G.typecheckModule p + tcm@TypecheckedModule{tm_typechecked_source = tcs + ,tm_checked_module_info = minfo} <- G.typecheckModule p whenFound' opt (findVar dflag style tcm tcs lineNo colNo) $ \(loc, _name, rty, paren) -> do - djinns <- djinn True rty - return (fourInts loc, map (doParen paren) (nub djinns)) + topLevel <- getEverythingInTopLevel minfo + let (f,pats) = getPatsForVariable tcs (lineNo,colNo) + -- Remove self function to prevent recursion, and id to trim cases + filterFn = (\(n,_) -> let funName = G.getOccString n + recName = G.getOccString (G.getName f) + in not $ funName `elem` recName:notWantedFuns) + -- Find without using other functions in top-level + localBnds = M.unions $ map (\(L _ pat) -> getBindingsForPat pat) pats + lbn = filter filterFn (M.toList localBnds) + djinnsEmpty <- djinn True (Just minfo) lbn rty (Max 10) 100000 + let -- Find with the entire top-level + almostEnv = M.toList $ M.union localBnds topLevel + env = filter filterFn almostEnv + djinns <- djinn True (Just minfo) env rty (Max 10) 100000 + return (fourInts loc, map (doParen paren) $ nub (djinnsEmpty ++ djinns)) handler (SomeException _) = emptyResult =<< options + +-- Functions we do not want in completions +notWantedFuns :: [String] +notWantedFuns = ["id", "asTypeOf", "const"] + +-- Get all things defined in top-level +getEverythingInTopLevel :: GhcMonad m => G.ModuleInfo -> m (M.Map G.Name Type) +getEverythingInTopLevel m = do + let modInfo = tyThingsToInfo (G.modInfoTyThings m) + topNames = G.modInfoTopLevelScope m + case topNames of + Just topNames' -> do topThings <- mapM G.lookupGlobalName topNames' + let topThings' = catMaybes topThings + topInfo = tyThingsToInfo topThings' + return $ M.union modInfo topInfo + Nothing -> return modInfo + +tyThingsToInfo :: [Ty.TyThing] -> M.Map G.Name Type +tyThingsToInfo [] = M.empty +tyThingsToInfo (G.AnId i : xs) = M.insert (G.getName i) (Ty.varType i) (tyThingsToInfo xs) +-- Getting information about constructors is not needed +-- because they will be added by djinn-ghc when traversing types +-- #if __GLASGOW_HASKELL__ >= 708 +-- tyThingToInfo (G.AConLike (G.RealDataCon con)) = return [(Ty.dataConName con, Ty.dataConUserType con)] +-- #else +-- tyThingToInfo (G.AConLike con) = return [(Ty.dataConName con, Ty.dataConUserType con)] +-- #endif +tyThingsToInfo (_:xs) = tyThingsToInfo xs + +-- Find the Id of the function and the pattern where the hole is located +getPatsForVariable :: G.TypecheckedSource -> (Int,Int) -> (Id, [Ty.LPat Id]) +getPatsForVariable tcs (lineNo, colNo) = + let (L _ bnd:_) = sortBy (cmp `on` G.getLoc) $ listifySpans tcs (lineNo, colNo) :: [G.LHsBind Id] + in case bnd of + G.PatBind { Ty.pat_lhs = L ploc pat } -> case pat of + Ty.ConPatIn (L _ i) _ -> (i, [L ploc pat]) + G.FunBind { Ty.fun_id = L _ funId } -> + let m = sortBy (cmp `on` G.getLoc) $ listifySpans tcs (lineNo, colNo) :: [G.LMatch Id (G.LHsExpr Id)] + (L _ (G.Match pats _ _):_) = m + in (funId, pats) + _ -> (error "This should never happen", []) + +getBindingsForPat :: Ty.Pat Id -> M.Map G.Name Type +getBindingsForPat (Ty.VarPat i) = M.singleton (G.getName i) (Ty.varType i) +getBindingsForPat (Ty.LazyPat (L _ l)) = getBindingsForPat l +getBindingsForPat (Ty.BangPat (L _ b)) = getBindingsForPat b +getBindingsForPat (Ty.AsPat (L _ a) (L _ i)) = M.insert (G.getName a) (Ty.varType a) (getBindingsForPat i) +getBindingsForPat (Ty.ListPat l _ _) = M.unions $ map (\(L _ i) -> getBindingsForPat i) l +getBindingsForPat (Ty.TuplePat l _ _) = M.unions $ map (\(L _ i) -> getBindingsForPat i) l +getBindingsForPat (Ty.PArrPat l _) = M.unions $ map (\(L _ i) -> getBindingsForPat i) l +getBindingsForPat (Ty.ViewPat _ (L _ i) _) = getBindingsForPat i +getBindingsForPat (Ty.SigPatIn (L _ i) _) = getBindingsForPat i +getBindingsForPat (Ty.SigPatOut (L _ i) _) = getBindingsForPat i +getBindingsForPat (Ty.ConPatIn (L _ i) d) = M.insert (G.getName i) (Ty.varType i) (getBindingsForRecPat d) +getBindingsForPat (Ty.ConPatOut { Ty.pat_args = d }) = getBindingsForRecPat d +getBindingsForPat _ = M.empty + +getBindingsForRecPat :: Ty.HsConPatDetails Id -> M.Map G.Name Type +getBindingsForRecPat (Ty.PrefixCon args) = M.unions $ map (\(L _ i) -> getBindingsForPat i) args +getBindingsForRecPat (Ty.InfixCon (L _ a1) (L _ a2)) = M.union (getBindingsForPat a1) (getBindingsForPat a2) +getBindingsForRecPat (Ty.RecCon (Ty.HsRecFields { Ty.rec_flds = fields })) = getBindingsForRecFields fields + where getBindingsForRecFields [] = M.empty + getBindingsForRecFields (Ty.HsRecField { Ty.hsRecFieldArg = (L _ a) } : fs) = + M.union (getBindingsForPat a) (getBindingsForRecFields fs) diff --git a/ghc-mod.cabal b/ghc-mod.cabal index f5c655b..2afeac4 100644 --- a/ghc-mod.cabal +++ b/ghc-mod.cabal @@ -107,7 +107,7 @@ Library , split , haskell-src-exts , text - , djinn-ghc + , djinn-ghc >= 0.0.2 if impl(ghc >= 7.8) Build-Depends: Cabal >= 1.18 else @@ -192,7 +192,7 @@ Test-Suite spec , split , haskell-src-exts , text - , djinn-ghc + , djinn-ghc >= 0.0.2 if impl(ghc >= 7.8) Build-Depends: Cabal >= 1.18 else From 7beea2608252e128b5455b9170739181092af617 Mon Sep 17 00:00:00 2001 From: Alejandro Serrano Date: Sun, 3 Aug 2014 19:34:47 +0200 Subject: [PATCH 5/9] Bump djinn-ghc version --- ghc-mod.cabal | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/ghc-mod.cabal b/ghc-mod.cabal index 2afeac4..602025b 100644 --- a/ghc-mod.cabal +++ b/ghc-mod.cabal @@ -107,7 +107,7 @@ Library , split , haskell-src-exts , text - , djinn-ghc >= 0.0.2 + , djinn-ghc >= 0.0.2.1 if impl(ghc >= 7.8) Build-Depends: Cabal >= 1.18 else @@ -192,7 +192,7 @@ Test-Suite spec , split , haskell-src-exts , text - , djinn-ghc >= 0.0.2 + , djinn-ghc >= 0.0.2.1 if impl(ghc >= 7.8) Build-Depends: Cabal >= 1.18 else From d22e50d9e4c20a134215cccd4398f68facc2acaf Mon Sep 17 00:00:00 2001 From: Alejandro Serrano Date: Sun, 3 Aug 2014 19:57:01 +0200 Subject: [PATCH 6/9] Small fix to compile in GHC < 7.8 --- Language/Haskell/GhcMod/FillSig.hs | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/Language/Haskell/GhcMod/FillSig.hs b/Language/Haskell/GhcMod/FillSig.hs index cfdbd19..a809d46 100644 --- a/Language/Haskell/GhcMod/FillSig.hs +++ b/Language/Haskell/GhcMod/FillSig.hs @@ -14,7 +14,6 @@ import Data.Maybe (isJust, catMaybes) import Exception (ghandle, SomeException(..)) import GHC (GhcMonad, Id, ParsedModule(..), TypecheckedModule(..), DynFlags, SrcSpan, Type, GenLocated(L)) import qualified GHC as G -import qualified ConLike as G import qualified Name as G import qualified Language.Haskell.GhcMod.Gap as Gap import Language.Haskell.GhcMod.Convert @@ -22,7 +21,7 @@ import Language.Haskell.GhcMod.Monad import Language.Haskell.GhcMod.SrcUtils import Language.Haskell.GhcMod.Types import CoreMonad (liftIO) -import Outputable (PprStyle, ppr) +import Outputable (PprStyle) import qualified Type as Ty import qualified HsBinds as Ty import qualified Class as Ty From d1a6618329f61ac5110b0691f9b0521f36ff87c9 Mon Sep 17 00:00:00 2001 From: Alejandro Serrano Date: Sun, 3 Aug 2014 20:38:54 +0200 Subject: [PATCH 7/9] More package fixes for GHC < 7.8 --- Language/Haskell/GhcMod/FillSig.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Language/Haskell/GhcMod/FillSig.hs b/Language/Haskell/GhcMod/FillSig.hs index a809d46..77104ca 100644 --- a/Language/Haskell/GhcMod/FillSig.hs +++ b/Language/Haskell/GhcMod/FillSig.hs @@ -9,7 +9,7 @@ module Language.Haskell.GhcMod.FillSig ( import Data.Char (isSymbol) import Data.Function (on) import Data.List (find, nub, sortBy) -import qualified Data.Map.Strict as M +import qualified Data.Map as M import Data.Maybe (isJust, catMaybes) import Exception (ghandle, SomeException(..)) import GHC (GhcMonad, Id, ParsedModule(..), TypecheckedModule(..), DynFlags, SrcSpan, Type, GenLocated(L)) From 43ac9036f9cad9dca703c9f4e345b8d2e7615041 Mon Sep 17 00:00:00 2001 From: Alejandro Serrano Date: Mon, 4 Aug 2014 17:25:18 +0200 Subject: [PATCH 8/9] Fixes on GHC < 7.8 --- Language/Haskell/GhcMod/FillSig.hs | 13 +++++++++++-- 1 file changed, 11 insertions(+), 2 deletions(-) diff --git a/Language/Haskell/GhcMod/FillSig.hs b/Language/Haskell/GhcMod/FillSig.hs index 77104ca..4c7783c 100644 --- a/Language/Haskell/GhcMod/FillSig.hs +++ b/Language/Haskell/GhcMod/FillSig.hs @@ -26,7 +26,6 @@ import qualified Type as Ty import qualified HsBinds as Ty import qualified Class as Ty import qualified Var as Ty -import qualified DataCon as Ty import qualified HsPat as Ty import qualified Language.Haskell.Exts.Annotated as HE import Djinn.GHC @@ -391,8 +390,14 @@ getPatsForVariable tcs (lineNo, colNo) = in case bnd of G.PatBind { Ty.pat_lhs = L ploc pat } -> case pat of Ty.ConPatIn (L _ i) _ -> (i, [L ploc pat]) + _ -> (error "This should never happen", []) G.FunBind { Ty.fun_id = L _ funId } -> - let m = sortBy (cmp `on` G.getLoc) $ listifySpans tcs (lineNo, colNo) :: [G.LMatch Id (G.LHsExpr Id)] + let m = sortBy (cmp `on` G.getLoc) $ listifySpans tcs (lineNo, colNo) +#if __GLASGOW_HASKELL__ >= 708 + :: [G.LMatch Id (G.LHsExpr Id)] +#else + :: [G.LMatch Id] +#endif (L _ (G.Match pats _ _):_) = m in (funId, pats) _ -> (error "This should never happen", []) @@ -402,7 +407,11 @@ getBindingsForPat (Ty.VarPat i) = M.singleton (G.getName i) (Ty.varType i) getBindingsForPat (Ty.LazyPat (L _ l)) = getBindingsForPat l getBindingsForPat (Ty.BangPat (L _ b)) = getBindingsForPat b getBindingsForPat (Ty.AsPat (L _ a) (L _ i)) = M.insert (G.getName a) (Ty.varType a) (getBindingsForPat i) +#if __GLASGOW_HASKELL__ >= 708 getBindingsForPat (Ty.ListPat l _ _) = M.unions $ map (\(L _ i) -> getBindingsForPat i) l +#else +getBindingsForPat (Ty.ListPat l _) = M.unions $ map (\(L _ i) -> getBindingsForPat i) l +#endif getBindingsForPat (Ty.TuplePat l _ _) = M.unions $ map (\(L _ i) -> getBindingsForPat i) l getBindingsForPat (Ty.PArrPat l _) = M.unions $ map (\(L _ i) -> getBindingsForPat i) l getBindingsForPat (Ty.ViewPat _ (L _ i) _) = getBindingsForPat i From b626d4f236f7ab2ded56903f80a608f98dc03d8a Mon Sep 17 00:00:00 2001 From: Alejandro Serrano Date: Tue, 5 Aug 2014 09:05:19 +0200 Subject: [PATCH 9/9] Move refine to C-c C-f. Fixes #300 --- elisp/ghc.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/elisp/ghc.el b/elisp/ghc.el index 9260181..4b21304 100644 --- a/elisp/ghc.el +++ b/elisp/ghc.el @@ -75,7 +75,7 @@ (defvar ghc-deeper-key "\C-c>") (defvar ghc-case-split-key "\C-c\C-s") (defvar ghc-initial-sig-key "\C-c\C-g") -(defvar ghc-refine-key "\C-c\C-r") +(defvar ghc-refine-key "\C-c\C-f") (defvar ghc-auto-key "\C-c\C-a") (defvar ghc-prev-hole-key "\C-c\ep") (defvar ghc-next-hole-key "\C-c\en")