use putStrLn instead of Haskeline's outputStrLn

[ghc-hetmet.git] / ghc / InteractiveUI.hs

diff --git a/ghc/InteractiveUI.hs b/ghc/InteractiveUI.hs
index 24079bb..2e4f80b 100644 (file)
--- a/ghc/InteractiveUI.hs
+++ b/ghc/InteractiveUI.hs
@@ -140,7 +140,7 @@ builtin_commands = [
   ("kind",      keepGoing' kindOfType,          completeIdentifier),
   ("load",      keepGoingPaths loadModule_,     completeHomeModuleOrFile),
   ("list",      keepGoing' listCmd,             noCompletion),
-  ("module",    keepGoing setContext,           completeModule),
+  ("module",    keepGoing setContext,           completeSetModule),
   ("main",      keepGoing runMain,              completeFilename),
   ("print",     keepGoing printCmd,             completeExpression),
   ("quit",      quit,                           noCompletion),
@@ -827,7 +827,7 @@ info s  = handleSourceError GHC.printExceptionAndWarnings $
        mb_stuffs <- mapM GHC.getInfo names
        let filtered = filterOutChildren (\(t,_f,_i) -> t) (catMaybes mb_stuffs)
        unqual <- GHC.getPrintUnqual
-       outputStrLn $ showSDocForUser unqual $
+       liftIO $ putStrLn $ showSDocForUser unqual $
                     vcat (intersperse (text "") $
                           map (pprInfo pefas) filtered)
 
@@ -1049,7 +1049,7 @@ checkModule m = do
   prev_context <- GHC.getContext
   ok <- handleSourceError (\e -> GHC.printExceptionAndWarnings e >> return False) $ do
           r <- GHC.typecheckModule =<< GHC.parseModule =<< GHC.getModSummary modl
-          outputStrLn (showSDoc (
+          liftIO $ putStrLn $ showSDoc $
           case GHC.moduleInfo r of
             cm | Just scope <- GHC.modInfoTopLevelScope cm ->
                let
@@ -1058,7 +1058,7 @@ checkModule m = do
                in
                        (text "global names: " <+> ppr global) $$
                        (text "local  names: " <+> ppr local)
-            _ -> empty))
+            _ -> empty
           return True
   afterLoad (successIf ok) False prev_context
 
@@ -1161,9 +1161,9 @@ modulesLoadedMsg ok mods = do
            punctuate comma (map ppr mods)) <> text "."
    case ok of
     Failed ->
-       outputStrLn (showSDoc (text "Failed, modules loaded: " <> mod_commas))
+       liftIO $ putStrLn $ showSDoc (text "Failed, modules loaded: " <> mod_commas)
     Succeeded  ->
-       outputStrLn (showSDoc (text "Ok, modules loaded: " <> mod_commas))
+       liftIO $ putStrLn $ showSDoc (text "Ok, modules loaded: " <> mod_commas)
 
 
 typeOfExpr :: String -> InputT GHCi ()
@@ -1300,7 +1300,7 @@ browseModule bang modl exports_only = withFlattenedDynflags $ do
         let prettyThings = map (pretty pefas) things
             prettyThings' | bang      = annotate $ zip modNames prettyThings
                           | otherwise = prettyThings
-        outputStrLn $ showSDocForUser unqual (vcat prettyThings')
+        liftIO $ putStrLn $ showSDocForUser unqual (vcat prettyThings')
         -- ToDo: modInfoInstances currently throws an exception for
         -- package modules.  When it works, we can do this:
         --        $$ vcat (map GHC.pprInstance (GHC.modInfoInstances mod_info))
@@ -1660,12 +1660,13 @@ showLanguages = do
    dflags <- getDynFlags
    io $ putStrLn $ showSDoc $ vcat $
       text "active language flags:" :
-      [text ("  -X" ++ str) | (str, f, _) <- DynFlags.xFlags, dopt f dflags]
+      [text ("  -X" ++ str) | (str, f, _) <- DynFlags.xFlags, xopt f dflags]
 
 -- -----------------------------------------------------------------------------
 -- Completion
 
 completeCmd, completeMacro, completeIdentifier, completeModule,
+    completeSetModule,
     completeHomeModule, completeSetOptions, completeShowOptions,
     completeHomeModuleOrFile, completeExpression
     :: CompletionFunc GHCi
@@ -1711,6 +1712,18 @@ completeModule = wrapIdentCompleter $ \w -> do
   return $ filter (w `isPrefixOf`)
         $ map (showSDoc.ppr) $ loaded_mods ++ pkg_mods
 
+completeSetModule = wrapIdentCompleterWithModifier "+-" $ \m w -> do
+  modules <- case m of
+    Just '-' -> do
+      (toplevs, exports) <- GHC.getContext
+      return $ map GHC.moduleName (nub (map fst exports) ++ toplevs)
+    _ -> do
+      dflags <- GHC.getSessionDynFlags
+      let pkg_mods = allExposedModules dflags
+      loaded_mods <- liftM (map GHC.ms_mod_name) getLoadedModules
+      return $ loaded_mods ++ pkg_mods
+  return $ filter (w `isPrefixOf`) $ map (showSDoc.ppr) modules
+
 completeHomeModule = wrapIdentCompleter listHomeModules
 
 listHomeModules :: String -> GHCi [String]
@@ -1748,6 +1761,12 @@ wrapCompleter breakChars fun = completeWord Nothing breakChars
 wrapIdentCompleter :: (String -> GHCi [String]) -> CompletionFunc GHCi
 wrapIdentCompleter = wrapCompleter word_break_chars
 
+wrapIdentCompleterWithModifier :: String -> (Maybe Char -> String -> GHCi [String]) -> CompletionFunc GHCi
+wrapIdentCompleterWithModifier modifChars fun = completeWordWithPrev Nothing word_break_chars
+    $ \rest -> fmap (map simpleCompletion) . fmap sort . fun (getModifier rest)
+ where
+  getModifier = find (`elem` modifChars)
+
 allExposedModules :: DynFlags -> [ModuleName]
 allExposedModules dflags 
  = concat (map exposedModules (filter exposed (eltsUFM pkg_db)))
@@ -2158,7 +2177,7 @@ list2 :: [String] -> InputT GHCi ()
 list2 [arg] | all isDigit arg = do
     (toplevel, _) <- GHC.getContext
     case toplevel of
-        [] -> outputStrLn "No module to list"
+        [] -> liftIO $ putStrLn "No module to list"
         (mod : _) -> listModuleLine mod (read arg)
 list2 [arg1,arg2] | looksLikeModuleName arg1, all isDigit arg2 = do
         mod <- wantInterpretedModule arg1
@@ -2183,7 +2202,7 @@ list2 [arg] = do
         noCanDo n why = printForUser $
             text "cannot list source code for " <> ppr n <> text ": " <> why
 list2  _other = 
-        outputStrLn "syntax:  :list [<line> | <module> <line> | <identifier>]"
+        liftIO $ putStrLn "syntax:  :list [<line> | <module> <line> | <identifier>]"
 
 listModuleLine :: Module -> Int -> InputT GHCi ()
 listModuleLine modl line = do
@@ -2224,7 +2243,7 @@ listAround span do_highlight = do
       let output = BS.intercalate (BS.pack "\n") prefixed
       utf8Decoded <- liftIO $ BS.useAsCStringLen output
                         $ \(p,n) -> utf8DecodeString (castPtr p) n
-      outputStrLn utf8Decoded
+      liftIO $ putStrLn utf8Decoded
   where
         file  = GHC.srcSpanFile span
         line1 = GHC.srcSpanStartLine span