intero 0.1.26 → 0.1.27
raw patch · 6 files changed
+651/−16 lines, 6 filesdep +mtl
Dependencies added: mtl
Files
- CHANGELOG +3/−0
- elisp/intero.el +58/−12
- intero.cabal +4/−2
- src/Completion.hs +536/−0
- src/GhciFind.hs +2/−2
- src/InteractiveUI.hs +48/−0
CHANGELOG view
@@ -1,3 +1,6 @@+0.1.27:+ * Add experimental :fill command.+ 0.1.23: * :cd handles quoted filepaths properly
elisp/intero.el view
@@ -70,7 +70,7 @@ :group 'haskell) (defcustom intero-package-version- "0.1.25"+ "0.1.27" "Package version to auto-install. This version does not necessarily have to be the latest version@@ -888,19 +888,29 @@ (interactive (company-begin-backend 'intero-company)) (prefix (unless (intero-gave-up 'backend)- (let ((prefix-info (intero-completions-grab-prefix)))- (when prefix-info- (cl-destructuring-bind- (beg end prefix _type) prefix-info- prefix)))))+ (or (let ((hole (intero-grab-hole)))+ (when hole+ (goto-char (cdr hole))+ (buffer-substring (car hole) (cdr hole))))+ (let ((prefix-info (intero-completions-grab-prefix)))+ (when prefix-info+ (cl-destructuring-bind+ (beg end prefix _type) prefix-info+ prefix)))))) (candidates (unless (intero-gave-up 'backend)- (let ((prefix-info (intero-completions-grab-prefix)))- (when prefix-info- (cons :async- (-partial 'intero-company-callback- (current-buffer)- prefix-info))))))))+ (let ((beg-end (intero-grab-hole)))+ (if beg-end+ (cons :async+ (-partial 'intero-async-fill-at+ (current-buffer)+ (car beg-end)))+ (let ((prefix-info (intero-completions-grab-prefix)))+ (when prefix-info+ (cons :async+ (-partial 'intero-company-callback+ (current-buffer)+ prefix-info)))))))))) (define-obsolete-function-alias 'company-intero 'intero-company) @@ -1081,6 +1091,42 @@ ))))))))))))) (when prefix-value (list prefix-start prefix-end prefix-value prefix-type)))))++;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;+;; Hole filling++(defun intero-async-fill-at (buffer beg cont)+ "Make the blocking call to the process."+ (with-current-buffer buffer+ (intero-async-call+ 'backend+ (format+ ":fill %S %d %d"+ (intero-localize-path (intero-temp-file-name))+ (save-excursion (goto-char beg)+ (line-number-at-pos))+ (save-excursion (goto-char beg)+ (1+ (current-column))))+ (list :buffer (current-buffer) :cont cont)+ (lambda (state reply)+ (unless (or (string-match "^Couldn't guess" reply)+ (string-match "^Unable to " reply))+ (with-current-buffer (plist-get state :buffer)+ (let ((candidates (split-string+ (replace-regexp-in-string+ "\n$" ""+ reply)+ "[\r\n]")))+ (funcall (plist-get state :cont) candidates))))))))++(defun intero-grab-hole ()+ "When user is at a hole _ or _foo, return the starting point of+that hole."+ (let ((beg-end (intero-ident-pos-at-point)))+ (when beg-end+ (let ((string (buffer-substring-no-properties (car beg-end) (cdr beg-end))))+ (when (string-match "^_" string)+ beg-end))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ELDoc integration
intero.cabal view
@@ -1,7 +1,7 @@ name: intero version:- 0.1.26+ 0.1.27 synopsis: Complete interactive development program for Haskell license:@@ -65,6 +65,7 @@ GhciTypes GhciInfo GhciFind+ Completion Paths_intero build-depends: base < 5,@@ -82,7 +83,8 @@ containers, time, network,- random+ random,+ mtl if impl(ghc>=8.0.1) build-depends:
+ src/Completion.hs view
@@ -0,0 +1,536 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE LambdaCase #-}++-- | A GHC code completion module.++module Completion+ ( getCompletableModule+ , declarationByLine+ , declarationHoles+ , holeSubstitutions+ , Declaration(..)+ , Hole(..)+ , Substitution(..)+ , LineNumber(..)+ ) where++import Bag+import Control.Monad+import Control.Monad.IO.Class+import Control.Monad.State+import Data.Generics+import Data.List+import qualified Data.Map.Strict as M+import Data.Maybe+import Data.Ord+import DynFlags+import FastString+import GHC+import HscTypes+import Name+import OccName+import Outputable+import RdrName+import TcRnDriver+import TcRnTypes (tcg_rdr_env)+import TyCoRep+import TyCon+import TysWiredIn+import Unify+import Unique+import Var++--------------------------------------------------------------------------------+-- Types++-- | A module which can be completed. Cannot contain type errors,+-- including deferred ones.+data CompletableModule =+ CompletableModule TypecheckedModule++-- | All the context we need to generate completions for a declaration+-- in a module.+data Declaration = Declaration+ { declarationBind :: !(HsBindLR Name Name)+ -- ^ The actual declaration, which we use to find holes and+ -- substitute them with candidate replacements.+ -- ^ A sample source, which we use merely for debugging.+ , declarationRealSrcSpan :: !RealSrcSpan+ -- ^ A source span which we can provide to the client IDE.+ , declarationParsedModule :: !ParsedModule+ -- ^ The declaration belongs to a parsed module which we'll use to+ -- try out alterations to the tree and see if they type-check.+ , declarationRenamedModule :: !RenamedSource+ -- ^ The renamed module contains 'UnboundedVar', which marks a hole.+ , declarationModuleInfo :: !ModuleInfo+ , declarationTypecheckedModule :: !TypecheckedSource+ -- ^ Used to get type of holes.+ , declarationGlobalRdrEnv :: !GlobalRdrEnv+ }++instance Show Declaration where+ showsPrec p (Declaration b real _parsedModule _renamedSource _ _ _) =+ showString "Declaration {declarationBind = " .+ gshows b .+ showString ", declarationRealSrcSpan = " .+ showsPrec (p + 1) real . showString "}"++-- | An identifier for a declaration in the module.+newtype DeclarationId = DeclarationId String+ deriving (Show)++-- | Line number from the module.+newtype LineNumber = LineNumber Int+ deriving (Show)++-- | A hole written `_` or `_foo` in the user-inputed source, which we+-- can fill in with candidates.+data Hole = Hole+ { holeRealSrcSpan :: !RealSrcSpan+ , holeName :: !OccName+ , holeType :: !Type+ , holeDf :: !DynFlags+ , holeDeclaration :: !Declaration+ }++instance Show Hole where+ showsPrec p (Hole realSrcSpan name ty df _) =+ showString "Hole {holeRealSrcSpan = " .+ showsPrec (p + 1) realSrcSpan .+ showString ", holeName = " . gshows name . showString ", holeType = " .+ showString (showPpr df ty) . showString "}"++-- | Substition of a source span in the source code with a new string.+data Substitution = Substitution+ { substitutionReplacement :: !Name+ , substitutionString :: !String+ , substitutionType :: !Type+ }++instance Show Substitution where+ showsPrec _p (Substitution name _q _ty) =+ showString "Substitution {substitutionReplacement = " .+ gshows name . showString "}"++--------------------------------------------------------------------------------+-- Top-level API++-- | Get a module which can be completed. Cannot contain type errors,+-- including deferred ones.+getCompletableModule :: GhcMonad m => ModSummary -> m CompletableModule+getCompletableModule ms =+ fmap CompletableModule (parseModule ms >>= typecheckModuleNoDeferring)++-- | Find a declaration by line number. If the line is within a+-- declaration in the module, return that declaration.+declarationByLine :: CompletableModule -> LineNumber -> Maybe Declaration+declarationByLine (CompletableModule typecheckedModule) (LineNumber line) = do+ renamedModule <- tm_renamed_source typecheckedModule+ let binds = renamedSourceToBag renamedModule+ located <- find ((`realSpans` (line, 1)) . getLoc) (bagToList binds)+ realSrcSpan <- getRealSrcSpan (getLoc located)+ pure+ (Declaration+ { declarationBind = unLoc located+ , declarationRealSrcSpan = realSrcSpan+ , declarationRenamedModule = renamedModule+ , declarationParsedModule = tm_parsed_module typecheckedModule+ , declarationTypecheckedModule = tm_typechecked_source typecheckedModule+ , declarationModuleInfo = tm_checked_module_info typecheckedModule+ , declarationGlobalRdrEnv = tcg_rdr_env (fst (tm_internals_ typecheckedModule))+ })++-- | Get all the holes in the given declaration.+declarationHoles :: DynFlags -> Declaration -> [Hole]+declarationHoles df declaration = go declaration+ where+ go =+ mapMaybe+ (\h -> do+ (name, src) <- getHoleName h+ case listToMaybe+ (listify+ (isJust . typeAt src)+ (declarationTypecheckedModule declaration)) >>=+ typeAt src of+ Nothing -> Nothing+ Just typ ->+ pure+ (Hole+ { holeRealSrcSpan = src+ , holeName = name+ , holeType = typ+ , holeDf = df+ , holeDeclaration = declaration+ })) .+ listify (isJust . getHoleName) . declarationBind+ typeAt :: RealSrcSpan -> LHsExpr Id -> Maybe Type+ typeAt rs expr =+ if getLoc expr == RealSrcSpan rs+ then case expr of+ L _ (HsVar (L _ i)) -> pure (idType i)+ _ -> Nothing+ else Nothing+ getHoleName :: LHsExpr Name -> Maybe (OccName, RealSrcSpan)+ getHoleName =+ \case+ L someSpan (HsUnboundVar (TrueExprHole name)) -> do+ rs <- getRealSrcSpan someSpan+ pure (name, rs)+ _ -> Nothing++-- | Get completions for a declaration.+holeSubstitutions :: GhcMonad m => Hole -> m [Substitution]+holeSubstitutions hole =+ do let names =+ filter+ isValName+ (fromMaybe+ []+ (modInfoTopLevelScope (declarationModuleInfo declaration)))+ hscEnv <- getSession+ typedNames <-+ liftIO+ (foldM+ (\(!names') rdrName -> do+ (_, ty) <-+ tcRnExpr+ hscEnv+ TM_Inst+ (rdrNameToLHsExpr (nameRdrName rdrName))+ pure (maybe names' (: names') (fmap (rdrName, ) ty)))+ []+ names)+ subs <-+ getWellTypedFills+ (declarationParsedModule declaration)+ hole+ typedNames+ pure+ (sortBy+ (flip (comparing (typeSpecificity . substitutionType)))+ (map+ (\(name, ty, _) ->+ Substitution+ { substitutionReplacement = name+ , substitutionType = ty+ , substitutionString =+ makeReplacementString+ (declarationGlobalRdrEnv declaration)+ name+ })+ subs))+ where+ declaration = holeDeclaration hole++-- | A vague weighting for relevance of types. We assume that more+-- specific types are more appropriate.+typeSpecificity :: Type -> Int+typeSpecificity t = sum (map rate (listify ((> 0) . rate) t))+ where+ rate =+ \case+ TyConApp {} -> 10+ LitTy {} -> 5+ FunTy {} -> 1+ _ -> 0++-- | Make a string, qualified if necessary.+makeReplacementString :: GlobalRdrEnv -> Name -> String+makeReplacementString gre name =+ case lookupGRE_Name gre name of+ Nothing -> unqualified+ Just grelt ->+ if greltUnqualified grelt && unambiguous grelt+ then unqualified+ else maybe unqualified qualified (greltQualification grelt)+ where+ unqualified = occNameString (nameOccName name)+ qualified m = moduleNameString m ++ "." ++ unqualified+ unambiguous grelt = null conflicts+ where+ conflicts =+ filter+ greltUnqualified+ (filter+ (/= grelt)+ (lookupGlobalRdrEnv gre (nameOccName (gre_name grelt))))++-- | First the first available qualification for a name.+greltQualification :: GlobalRdrElt -> Maybe ModuleName+greltQualification grelt =+ case gre_imp grelt of+ (ImpSpec (ImpDeclSpec {is_as = m}) _:_) -> Just m+ _ -> Nothing++-- | The element is not qualified.+greltUnqualified :: GlobalRdrElt -> Bool+greltUnqualified grelt = local || importedUnqualified+ where+ local = gre_lcl grelt+ importedUnqualified = any unQualSpecOK (gre_imp grelt)++--------------------------------------------------------------------------------+-- Testing out completions++data StringEquality = StringEquality+ { _stringEqualityDf :: DynFlags+ , _stringEqualityType :: Type+ }+instance Show StringEquality where+ show (StringEquality df x) = showPpr df x+instance Eq StringEquality where+ StringEquality df t1 == StringEquality df' t2 =+ showPpr df t1 == showPpr df' t2+instance Ord StringEquality where+ compare (StringEquality df t1) (StringEquality df' t2) =+ compare (showPpr df t1) (showPpr df' t2)++-- | Get a set of well-typed fills for the given hole.+--+-- Candidates with the same type are cached, to avoid recompiling the+-- module more than neccessary.+getWellTypedFills ::+ GhcMonad m+ => ParsedModule+ -> Hole+ -> [(Name, Type)]+ -> m [(Name, Type, ParsedModule)]+getWellTypedFills pm hole names = do+ df <- getSessionDynFlags+ let hty = normalize df (holeType hole)+ fmap+ snd+ (foldM+ (\(!cache, !candidates) (!rdrname, !typ) ->+ (do mparsedModule <-+ case M.lookup (StringEquality df typ) cache of+ Just mparsedModule -> pure mparsedModule+ Nothing ->+ tryWellTypedFill pm hole (rdrNameToHsExpr (nameRdrName rdrname))+ let !cache' = M.insert (StringEquality df typ) mparsedModule cache+ !candidates' =+ case mparsedModule of+ Nothing -> candidates+ Just parsedModule -> (rdrname, typ, parsedModule) : candidates+ pure (cache', candidates')))+ (mempty, [])+ (filter (\(name, ty) -> unifies' df hty (normalize df ty) name) names))++unifies' :: DynFlags -> Type -> Type -> Name -> Bool+unifies' df x y _name =+ -- trace+ -- ("Unifies? " +++ -- showPpr df name +++ -- " :: " +++ -- showPpr df y +++ -- "\n " +++ -- show (T df x) +++ -- "\n against\n " ++ show (T df y) ++ "\n => " ++ show (unifies df x y))+ (unifies df x y)++-- | The purpose of this function is to eliminate types that should+-- not be tested with a full module type-check. This checker is+-- stricter than GHC's own unifier, much stricter than Hoogle; it+-- produces false negatives. But it should not produce false positives+-- ideally.+unifies :: DynFlags -> Type -> Type -> Bool+unifies _df t1 t2 = theirs t1 t2 && ours t1 t2+ where+ theirs x y =+ -- trace+ -- ("theirs(" +++ -- showPpr df x +++ -- "," ++ showPpr df y ++ ")=>" ++ show (isJust (tcUnifyTyKi x y)))+ (isJust (tcUnifyTyKi x y))+ -- Let them deal with lits:+ ours x@LitTy {} y@LitTy {} = theirs x y+ -- We assume a type variable unifies with anything, leave it to+ -- them:+ ours x@TyVarTy {} y = theirs x y+ ours x y@TyVarTy {} = theirs x y+ -- We ignore forall's:+ ours (ForAllTy _ x) y = ours x y+ ours x (ForAllTy _ y) = ours x y+ -- We ignore casts:+ ours (CastTy x _) y = ours x y+ ours x (CastTy y _) = ours x y+ -- We assume they know what to do with a coercion:+ ours x y@CoercionTy {} = theirs x y+ ours x@CoercionTy {} y = theirs x y+ -- We only let functions unify with functions, and apps unify with apps:+ ours (FunTy x y) (FunTy x' y') = ours x x' && ours y y'+ ours (AppTy f x) (AppTy f' x') = ours f f' && ours x x'+ -- We let them deal with this:+ ours x@TyConApp {} y@TyConApp {} = theirs x y+ -- These three should unify, so we let them deal with it:+ ours x@AppTy {} y@TyConApp {} = theirs x y+ ours y@TyConApp {} x@AppTy {} = theirs x y+ -- The rest SHOULD NOT be allowed to unify, because it's too+ -- general to produce DWIM results:+ ours FunTy {} _ = False+ ours _ FunTy {} = False+ ours AppTy {} _ = False+ ours _ AppTy {} = False+ ours TyConApp {} _ = False+ ours _ TyConApp {} = False++isAny :: DynFlags -> Type -> Bool+isAny df t = showPpr df t == "Any"++data T = T DynFlags Type+instance Show T where+ showsPrec p (T df ty0) =+ case ty0 of+ TyVarTy v ->+ showString "(TyVarTy " . showString (showPpr df v) . showString ")"+ AppTy t1 t2 ->+ showString "(AppTy " .+ showsPrec (p + 1) (T df t1) .+ showString " " . showsPrec (p + 1) (T df t2) . showString ")"+ TyConApp tyCon tys ->+ showString "(TyConApp " .+ showString (showPpr df tyCon) .+ showString " " . showsPrec (p + 1) (map (T df) tys) . showString ")"+ ForAllTy _tyvar ty ->+ showString "(ForAllTy _ " . showsPrec (p + 1) (T df ty) . showString ")"+ FunTy x y ->+ showString "(FunTy " .+ showsPrec p (T df x) .+ showString " " . showsPrec p (T df y) . showString ")"+ LitTy litTy ->+ showString "(LitTy " . showString (showPpr df litTy) . showString ")"+ CastTy ty _k ->+ showString "(CastTy " . showsPrec (p + 1) (T df ty) . showString " _)"+ CoercionTy _ -> showString "(Coercion _)"++-- | Strip out weird things from GHC's type system.+normalize :: DynFlags -> Type -> Type+normalize df t0 = evalState (go t0) 1+ where+ go =+ \case+ t@TyConApp {}+ | isAny df t -> do+ u <- get+ modify (+ 1)+ pure (makeTypeVariable u "was_Any")+ FunTy (TyConApp (tyConFlavour -> "class") _) x -> go x+ ForAllTy _ x -> go x+ CastTy x _ -> go x+ FunTy x y -> FunTy <$> (go x) <*> (go y)+ AppTy x y -> AppTy <$> (go x) <*> (go y)+ TyConApp tycon xs -> TyConApp <$> pure tycon <*> (mapM go xs)+ t@TyVarTy {} -> pure t+ t@LitTy {} -> pure t+ t@CoercionTy {} -> pure t++-- | Make a type variable. I have no idea how to create a truly unique+-- name. This is bothersome.+makeTypeVariable :: Int -> String -> Type+makeTypeVariable u n = TyVarTy (mkTyVar name liftedTypeKind)+ where+ name =+ mkInternalName (mkUnique 'Z' u) (mkOccName OccName.varName n) noSrcSpan++-- | Try to fill a hole with the given expression; if it type-checks,+-- we return the newly updated parse tree. Otherwise, we return Nothing.+tryWellTypedFill ::+ GhcMonad m+ => ParsedModule+ -> Hole+ -> HsExpr RdrName+ -> m (Maybe ParsedModule)+tryWellTypedFill pm hole expr =+ handleSourceError+ (const (pure Nothing))+ (fmap+ (Just . tm_parsed_module)+ (typecheckModuleNoDeferring (fillHole pm hole expr)))++--------------------------------------------------------------------------------+-- Filling holes in the AST++-- | Fill the given hole in the module with the given expression.+fillHole :: ParsedModule -> Hole -> HsExpr RdrName -> ParsedModule+fillHole pm hole expr =+ pm {pm_parsed_source = everywhere (mkT replace) (pm_parsed_source pm)}+ where+ replace :: LHsExpr RdrName -> LHsExpr RdrName+ replace =+ (\case+ L someSpan _+ | Just realSrcSpan <- getRealSrcSpan someSpan+ , realSrcSpan == holeRealSrcSpan hole -> L someSpan expr+ e -> e)++--------------------------------------------------------------------------------+-- Helpers++rdrNameToLHsExpr :: id -> GenLocated SrcSpan (HsExpr id)+rdrNameToLHsExpr rdrname =+ L (UnhelpfulSpan (mkFastString "Generated by rdrNameToLHsExpr"))+ (HsVar+ (L (UnhelpfulSpan (mkFastString "Generated by getWellTypedFills"))+ rdrname))++rdrNameToHsExpr :: id -> HsExpr id+rdrNameToHsExpr rdrname =+ HsVar+ (L (UnhelpfulSpan (mkFastString "Generated by rdrNameToHsExpr")) rdrname)++-- | Type-check the module without deferring type errors, and without+-- logging messages.+typecheckModuleNoDeferring :: GhcMonad m => ParsedModule -> m TypecheckedModule+typecheckModuleNoDeferring parsed = do+ typecheckModule+ parsed+ { GHC.pm_mod_summary =+ (GHC.pm_mod_summary parsed)+ { HscTypes.ms_hspp_opts =+ unSetGeneralFlag'+ Opt_DeferTypeErrors+ (HscTypes.ms_hspp_opts (GHC.pm_mod_summary parsed))+ {log_action = nullLogAction}+ }+ }+ where+ nullLogAction _df _reason _sev _span _style _msgdoc = pure ()++-- | Convert parsed source groups into one bag of binds.+_parsedModuleToBag :: ParsedModule -> Bag (LHsBindLR RdrName RdrName)+_parsedModuleToBag =+ listToBag . mapMaybe valD . hsmodDecls . unLoc . pm_parsed_source+ where+ valD =+ \case+ L l (ValD hsBind) -> pure (L l hsBind)+ _ -> Nothing++-- | Convert renamed source groups into one bag of binds.+renamedSourceToBag :: RenamedSource -> Bag (LHsBindLR Name Name)+renamedSourceToBag (hsGroup, _, _, _) = unHsValBindsLR (hs_valds hsGroup)+ where+ unHsValBindsLR =+ \case+ ValBindsIn binds _ -> binds+ ValBindsOut pairs _ -> unionManyBags (map snd pairs)++-- | Does X span over the point Y?+realSpans :: SrcSpan -> (Int, Int) -> Bool+realSpans x y =+ fromMaybe+ False+ (do _ <- getRealSrcSpan x+ pure (spans x y))++-- | Try to get a real span.+getRealSrcSpan :: SrcSpan -> Maybe RealSrcSpan+getRealSrcSpan =+ \case+ RealSrcSpan r -> pure r+ _ -> Nothing
src/GhciFind.hs view
@@ -6,7 +6,7 @@ -- | Find type/location information. module GhciFind- (findType,FindType(..),findLoc,findNameUses,findCompletions)+ (findType,FindType(..),findLoc,findNameUses,findCompletions,guessModule) where #if __GLASGOW_HASKELL__ >= 800@@ -385,7 +385,7 @@ #if __GLASGOW_HASKELL__ >= 802 (exprType TM_Inst string) #else- (exprType string) + (exprType string) #endif -- | Try to resolve the type display from the given span.
src/InteractiveUI.hs view
@@ -51,6 +51,7 @@ import GhciMonad hiding ( args, runStmt ) import GhciTags import Debugger+import qualified Completion -- The GHC interface import Data.IORef@@ -94,6 +95,7 @@ #endif -- Other random utilities+ import BasicTypes hiding ( isTopLevel ) import Config import Digraph@@ -268,6 +270,7 @@ ("kind", keepGoing' (kindOfType False), completeIdentifier), ("kind!", keepGoing' (kindOfType True), completeIdentifier), ("load", keepGoingPaths loadModule_, completeHomeModuleOrFile),+ ("fill", keepGoing' (lifted fillCmd), noCompletion), ("list", keepGoing' listCmd, noCompletion), ("module", keepGoing moduleCmd, completeSetModule), ("move", keepGoing' moveCommand, completeFilename),@@ -297,7 +300,51 @@ ] where lifted m = \str -> lift (m stdout str) +fillCmd :: Handle -> String -> GHCi ()+fillCmd h =+ withFillInput+ (\fp line col -> do+ infos <- fmap mod_infos getGHCiState+ mname <- guessModule infos fp+ case mname of+ Nothing ->+ liftIO (hPutStrLn h "Couldn't guess that module name. Does it exist?")+ Just name -> do+ case M.lookup name infos of+ Nothing ->+ liftIO+ (hPutStrLn h+ "Couldn't guess the module name. Is this module loaded?")+ Just module' -> do+ completable <-+ Completion.getCompletableModule (modinfoSummary module')+ case Completion.declarationByLine+ completable+ (Completion.LineNumber line) of+ Nothing -> liftIO (hPutStrLn h "Couldn't guess the declaration.")+ Just declaration -> do+ df <- GHC.getSessionDynFlags+ case find+ ((\rs ->+ srcSpanStartLine rs == line &&+ srcSpanStartCol rs == col) .+ Completion.holeRealSrcSpan)+ (Completion.declarationHoles df declaration) of+ Nothing -> pure ()+ Just hole -> do+ subs <- Completion.holeSubstitutions hole+ mapM_+ (\sub ->+ liftIO+ (hPutStrLn h (Completion.substitutionString sub)))+ subs) +withFillInput :: (FilePath -> Int -> Int -> GHCi ()) -> String -> GHCi ()+withFillInput cont input =+ case words input of+ [read -> name, read -> line, read -> col] -> (cont name line col)+ _ -> liftIO (putStrLn "Invalid :fill call. Should be :fill <filename> <line number> <column number>")+ readOnlyCommands :: [(String, Handle -> String -> GHCi ())] readOnlyCommands = [ ("type-at", typeAt)@@ -305,6 +352,7 @@ , ("uses", findAllUses) , ("loc-at", locationAt) , ("complete-at", completeAt)+ , ("fill",fillCmd) ] -- We initialize readline (in the interactiveUI function) to use