ghc/compiler/ghci/InteractiveUI.hs

   1 -----------------------------------------------------------------------------
   2 -- $Id: InteractiveUI.hs,v 1.1 2000/11/16 10:48:22 simonmar Exp $
   3 --
   4 -- GHC Interactive User Interface
   5 --
   6 -- (c) The GHC Team 2000
   7 --
   8 -----------------------------------------------------------------------------
   9
  10 module InteractiveUI where
  11
  12 import CompManager
  13 import Module
  14 import Panic
  15 import Util
  16
  17 import Readline
  18
  19 import System
  20 import Directory
  21 import IO
  22 import Char
  23
  24 -----------------------------------------------------------------------------
  25
  26 ghciWelcomeMsg = "\
  27 \ _____  __   __  ____         _________________________________________________\n\
  28 \(|      ||   || (|  |)        GHC Interactive, version 5.00                    \n\
  29 \||  __  ||___|| ||     ()     For Haskell 98.                                  \n\
  30 \||   |) ||---|| ||     ||     http://www.haskell.org/ghc                       \n\
  31 \||   || ||   || ||     (|     Bug reports to: glasgow-haskell-bugs@haskell.org \n\
  32 \(|___|| ||   || (|__|) \\\\______________________________________________________\n"
  33
  34 commands :: [(String, String -> GHCi ())]
  35 commands = [
  36   ("cd",        changeDirectory),
  37   ("help",      help),
  38   ("?",         help),
  39   ("load",      loadModule),
  40   ("reload",    reloadModule),
  41   ("set",       setOptions),
  42   ("type",      typeOfExpr),
  43   ("quit",      quit),
  44   ("!",         shellEscape)
  45   ]
  46
  47 shortHelpText = "use :? for help.\n"
  48
  49 helpText = "\
  50 \   <expr>              evaluate <expr>\n\
  51 \   :cd <dir>           change directory to <dir>\n\
  52 \   :help               display this list of commands\n\
  53 \   :?                  display this list of commands\n\
  54 \   :load <filename>    load a module (and it dependents)\n\
  55 \   :reload             reload the current program\n\
  56 \   :set <opetion> ...  set options\n\
  57 \   :type <expr>        show the type of <expr>\n\
  58 \   :quit               exit GHCi\n\
  59 \   :!<command>         run the shell command <command>\n\
  60 \"
  61
  62 interactiveUI :: CmState -> IO ()
  63 interactiveUI st = do
  64    hPutStr stdout ghciWelcomeMsg
  65    hFlush stdout
  66    hSetBuffering stdout NoBuffering
  67 #ifndef NO_READLINE
  68    Readline.initialize
  69 #endif
  70    _ <- (unGHCi uiLoop) GHCiState{ current_module = mkModuleName "Prelude",
  71                                    target = Nothing,
  72                                    cmstate = st }
  73    return ()
  74
  75 uiLoop :: GHCi ()
  76 uiLoop = do
  77   st <- getGHCiState
  78 #ifndef NO_READLINE
  79   l <- io (readline (moduleNameUserString (current_module st)  ++ ">"))
  80 #else
  81   l <- io (hGetLine stdin)
  82 #endif
  83   case l of
  84     Nothing -> return ()
  85     Just "" -> uiLoop
  86     Just l  -> do
  87 #ifndef NO_READLINE
  88           io (addHistory l)
  89 #endif
  90           runCommand l
  91           uiLoop
  92
  93 runCommand c = myCatch (doCommand c)
  94                         (\e -> io (hPutStr stdout ("Error: " ++ show e)))
  95
  96 doCommand (':' : command) = specialCommand command
  97 doCommand expr = do
  98   io (hPutStrLn stdout ("Run expression: " ++ expr))
  99   return ()
 100
 101 specialCommand str = do
 102   let (cmd,rest) = break isSpace str
 103   case [ (s,f) | (s,f) <- commands, prefixMatch cmd s ] of
 104      []      -> io $ hPutStr stdout ("uknown command `:" ++ cmd ++ "'\n"
 105                                     ++ shortHelpText)
 106      [(_,f)] -> f rest
 107      cs      -> io $ hPutStrLn stdout ("prefix " ++ cmd ++
 108                                        " matches multiple commands (" ++
 109                                        foldr1 (\a b -> a ++ ',':b) (map fst cs) ++ ")")
 110
 111 noArgs c = io (hPutStr stdout ("command `:" ++ c ++ "' takes no arguments"))
 112
 113 -----------------------------------------------------------------------------
 114 -- Commands
 115
 116 -- ToDo: don't forget to catch errors
 117
 118 help :: String -> GHCi ()
 119 help _ = io (putStr helpText)
 120
 121 changeDirectory :: String -> GHCi ()
 122 changeDirectory = io . setCurrentDirectory
 123
 124 loadModule :: String -> GHCi ()
 125 loadModule path = do
 126   state <- getGHCiState
 127   (new_cmstate, mod) <- io (cmLoadModule (cmstate state) ({-ToDo!!-}mkModuleName path))
 128   setGHCiState state{cmstate=new_cmstate, target=Just path}
 129
 130 reloadModule :: String -> GHCi ()
 131 reloadModule "" = do
 132   state <- getGHCiState
 133   case target state of
 134         Nothing -> io (hPutStr stdout "no current target")
 135         Just path -> do (new_cmstate, mod) <- io (cmLoadModule (cmstate state) (mkModuleName path))
 136                         setGHCiState state{cmstate=new_cmstate}
 137 reloadModule _ = noArgs ":reload"
 138
 139 setOptions :: String -> GHCi ()
 140 setOptions = panic "setOptions"
 141
 142 typeOfExpr :: String -> GHCi ()
 143 typeOfExpr = panic "typeOfExpr"
 144
 145 quit :: String -> GHCi ()
 146 quit _ = return ()
 147
 148 shellEscape :: String -> GHCi ()
 149 shellEscape str = io (system str >> return ())
 150
 151 -----------------------------------------------------------------------------
 152 -- GHCi monad
 153
 154 data GHCiState = GHCiState
 155      {
 156         current_module :: ModuleName,
 157         target         :: Maybe FilePath,
 158         cmstate        :: CmState
 159      }
 160
 161 newtype GHCi a = GHCi { unGHCi :: GHCiState -> IO (GHCiState, a) }
 162
 163 instance Monad GHCi where
 164   (GHCi m) >>= k  =  GHCi $ \s -> m s >>= \(s,a) -> unGHCi (k a) s
 165   return a  = GHCi $ \s -> return (s,a)
 166
 167 getGHCiState   = GHCi $ \s -> return (s,s)
 168 setGHCiState s = GHCi $ \_ -> return (s,())
 169
 170 io m = GHCi $ \s -> m >>= \a -> return (s,a)
 171
 172 myCatch (GHCi m) h = GHCi $ \s -> catch (m s) (\e -> unGHCi (h e) s)