always use Haskeline. drop Readline & Editline

GF.cabal

@@ -6,18 +6,6 @@ license: GPL
 license-file: LICENSE
 synopsis: Grammatical Framework
 
-flag haskeline
-  Description: Enable Haskeline in the shell
-  Default:     True
-
-flag readline
-  Description: Enable Readline in the shell
-  Default:     True
-
-flag editline
-  Description: Enable Editline in the shell
-  Default:     True
-
 flag interrupt
   Description: Enable Ctrl+Break in the shell
   Default:     True
@@ -74,7 +62,8 @@ executable gf
                  old-time,
                  process,
                  pretty,
-                 mtl
+                 mtl,
+                 haskeline
   build-tools: happy, alex
   if os(windows)
     build-depends: Win32
@@ -142,7 +131,6 @@ executable gf
     GF.Compile.PGFtoProlog
     GF.Compile.PGFtoJS
     GF.Compile
-    GF.System.Readline
     GF.Quiz
     PGF
     PGF.CId
@@ -161,23 +149,6 @@ executable gf
     GFC
     GFI
 
-  if flag(haskeline)
-    build-depends: haskeline
-    cpp-options: -DUSE_HASKELINE
-    other-modules: GF.System.UseHaskeline
-  else
-    if flag(readline)
-      build-depends: readline
-      cpp-options: -DUSE_READLINE
-      other-modules: GF.System.UseReadline
-    else
-      if flag(editline)
-        build-depends: editline
-        cpp-options: -DUSE_EDITLINE
-        other-modules: GF.System.UseEditline
-      else
-        other-modules: GF.System.NoReadline
-
   if flag(interrupt)
     cpp-options: -DUSE_INTERRUPT
     other-modules: GF.System.UseSignal

src/compiler/GF/System/NoReadline.hs

@@ -1,33 +0,0 @@
-----------------------------------------------------------------------
--- |
--- Module      : GF.System.NoReadline
--- Maintainer  : BB
--- Stability   : (stable)
--- Portability : (portable)
---
--- > CVS $Date: 2005/05/10 15:04:01 $ 
--- > CVS $Author: bringert $
--- > CVS $Revision: 1.1 $
---
--- Do not use readline.
------------------------------------------------------------------------------
-
-module GF.System.NoReadline (fetchCommand, setCompletionFunction, filenameCompletionFunction) where
-
-import System.IO.Error (try)
-import System.IO (stdout,hFlush)
-
-fetchCommand :: String -> IO (String)
-fetchCommand s = do
-  putStr s
-  hFlush stdout
-  res <- try getLine
-  case res of
-   Left e -> return "q"
-   Right l -> return l
-
-setCompletionFunction :: Maybe (String -> String -> Int -> IO [String]) -> IO ()
-setCompletionFunction _ = return ()
-
-filenameCompletionFunction :: String -> IO [String]
-filenameCompletionFunction _ = return []

src/compiler/GF/System/Readline.hs

@@ -1,35 +0,0 @@
-{-# OPTIONS -cpp #-}
-
-----------------------------------------------------------------------
--- |
--- Module      : GF.System.Readline
--- Maintainer  : BB
--- Stability   : (stable)
--- Portability : (portable)
---
--- > CVS $Date: 2005/05/10 15:04:01 $ 
--- > CVS $Author: bringert $
--- > CVS $Revision: 1.2 $
---
--- Uses the right readline library to read user input.
------------------------------------------------------------------------------
-
-module GF.System.Readline (fetchCommand, setCompletionFunction, filenameCompletionFunction) where
-
-#ifdef USE_HASKELINE
-
-import GF.System.UseHaskeline
-
-#elif USE_READLINE
-
-import GF.System.UseReadline
-
-#elif USE_EDITLINE
-
-import GF.System.UseEditline
-
-#else
-
-import GF.System.NoReadline
-
-#endif

src/compiler/GF/System/UseEditline.hs

@@ -1,36 +0,0 @@
-----------------------------------------------------------------------
--- |
--- Module      : GF.System.UseReadline
--- Maintainer  : BB
--- Stability   : (stable)
--- Portability : (portable)
---
--- > CVS $Date: 2005/05/10 15:04:01 $ 
--- > CVS $Author: bringert $
--- > CVS $Revision: 1.1 $
---
--- Use GNU readline
------------------------------------------------------------------------------
-
-module GF.System.UseEditline (fetchCommand, setCompletionFunction, filenameCompletionFunction) where
-
-import System.Console.Editline.Readline
-
-fetchCommand :: String -> IO (String)
-fetchCommand s = do
-  setCompletionAppendCharacter Nothing
-  --setBasicQuoteCharacters ""
-  res <- readline s
-  case res of
-   Nothing -> return "q"
-   Just s -> do addHistory s
-                return s
-
-setCompletionFunction :: Maybe (String -> String -> Int -> IO [String]) -> IO ()
-setCompletionFunction Nothing   = setCompletionEntryFunction Nothing
-setCompletionFunction (Just fn) = setCompletionEntryFunction (Just my_fn)
-  where
-    my_fn prefix = do
-      s <- getLineBuffer
-      p <- getPoint
-      fn s prefix p

src/compiler/GF/System/UseHaskeline.hs

@@ -1,43 +0,0 @@
-----------------------------------------------------------------------
--- |
--- Module      : GF.System.UseReadline
--- Maintainer  : BB
--- Stability   : (stable)
--- Portability : (portable)
---
--- > CVS $Date: 2005/05/10 15:04:01 $ 
--- > CVS $Author: bringert $
--- > CVS $Revision: 1.1 $
---
--- Use GNU readline
------------------------------------------------------------------------------
-
-module GF.System.UseHaskeline (fetchCommand, setCompletionFunction, filenameCompletionFunction) where
-
-import System.Console.Haskeline
-import System.Directory
-
-fetchCommand :: String -> IO (String)
-fetchCommand s = do
-  settings <- getGFSettings
-  res <- runInputT settings (getInputLine s)
-  case res of
-   Nothing -> return "q"
-   Just s  -> return s
-
-getGFSettings :: IO (Settings IO)
-getGFSettings = do
-  path <- getAppUserDataDirectory "gf_history"
-  return $
-    Settings {
-      complete = completeFilename,
-      historyFile = Just path,
-      autoAddHistory = True
-    }
-
-
-setCompletionFunction :: Maybe (String -> String -> Int -> IO [String]) -> IO ()
-setCompletionFunction _   = return ()
-
-filenameCompletionFunction :: String -> IO [String]
-filenameCompletionFunction _ = return []

src/compiler/GF/System/UseReadline.hs

@@ -1,36 +0,0 @@
-----------------------------------------------------------------------
--- |
--- Module      : GF.System.UseReadline
--- Maintainer  : BB
--- Stability   : (stable)
--- Portability : (portable)
---
--- > CVS $Date: 2005/05/10 15:04:01 $ 
--- > CVS $Author: bringert $
--- > CVS $Revision: 1.1 $
---
--- Use GNU readline
------------------------------------------------------------------------------
-
-module GF.System.UseReadline (fetchCommand, setCompletionFunction, filenameCompletionFunction) where
-
-import System.Console.Readline
-
-fetchCommand :: String -> IO (String)
-fetchCommand s = do
-  setCompletionAppendCharacter Nothing
-  setBasicQuoteCharacters ""
-  res <- readline s
-  case res of
-   Nothing -> return "q"
-   Just s -> do addHistory s
-                return s
-
-setCompletionFunction :: Maybe (String -> String -> Int -> IO [String]) -> IO ()
-setCompletionFunction Nothing   = setCompletionEntryFunction Nothing
-setCompletionFunction (Just fn) = setCompletionEntryFunction (Just my_fn)
-  where
-    my_fn prefix = do
-      s <- getLineBuffer
-      p <- getPoint
-      fn s prefix p

src/compiler/GFI.hs

@@ -19,7 +19,7 @@ import GF.Infra.CheckM
 import GF.Infra.UseIO
 import GF.Infra.Option
 import GF.Infra.Modules (greatestResource, modules, emptyModInfo)
-import GF.System.Readline
+import qualified System.Console.Haskeline as Haskeline
 
 import GF.Compile.Coding
 
@@ -79,11 +79,9 @@ loop opts gfenv0 = do
   let ifv act = if isv then act else return ()
   let env = commandenv gfenv0
   let sgr = sourcegrammar gfenv0
-  setCompletionFunction (Just (wordCompletion gfenv0))
+  s0 <- case flag optMode opts of
-  let fetch = case flag optMode opts of
+          ModeRun -> tryGetLine
-        ModeRun -> tryGetLine
+          _       -> fetchCommand gfenv0
-        _ -> fetchCommand (prompt env)
-  s0 <- fetch 
   let gfenv = gfenv0 {history = s0 : history gfenv0}
   let 
     pwords = case words s0 of
@@ -204,6 +202,20 @@ loop opts gfenv0 = do
         gfenv' <- either (\e -> (print e >> return gfenv)) return r
         loop opts gfenv'
 
+fetchCommand :: GFEnv -> IO String
+fetchCommand gfenv = do
+  path <- getAppUserDataDirectory "gf_history"
+  let settings =
+        Haskeline.Settings {
+          Haskeline.complete = wordCompletion gfenv,
+          Haskeline.historyFile = Just path,
+          Haskeline.autoAddHistory = True
+        }
+  res <- Haskeline.runInputT settings (Haskeline.getInputLine (prompt (commandenv gfenv)))
+  case res of
+    Nothing -> return "q"
+    Just s  -> return s
+
 importInEnv :: GFEnv -> Options -> [FilePath] -> IO GFEnv
 importInEnv gfenv opts files
     | flag optRetainResource opts =
@@ -262,34 +274,37 @@ emptyGFEnv = do
 
 decode _ = id -- decodeUnicode . coding
 
-wordCompletion gfenv line prefix p =
+wordCompletion gfenv (left,right) = do
-  case wc_type (take p line) of
+  case wc_type (reverse left) of
     CmplCmd pref
-      -> ret ' ' [name | name <- Map.keys (commands cmdEnv), isPrefixOf pref name]
+      -> ret (length pref) [Haskeline.simpleCompletion name | name <- Map.keys (commands cmdEnv), isPrefixOf pref name]
-    CmplStr (Just (Command _ opts _)) s
+    CmplStr (Just (Command _ opts _)) s0
       -> do mb_state0 <- try (evaluate (initState pgf (optLang opts) (optType opts)))
             case mb_state0 of
-              Right state0 -> let ws     = words (take (length s - length prefix) s)
+              Right state0 -> let (rprefix,rs) = break isSpace (reverse s0)
+                                  s            = reverse rs
+                                  prefix       = reverse rprefix
+                                  ws           = words s
                               in case loop state0 ws of
-                                   Nothing    -> ret ' ' []
+                                   Nothing    -> ret 0 []
                                    Just state -> let compls = getCompletions state prefix
-                                                 in ret ' ' (Map.keys compls)
+                                                 in ret (length prefix) (map (\x -> Haskeline.simpleCompletion x) (Map.keys compls))
-              Left (_ :: SomeException) -> ret ' ' []
+              Left (_ :: SomeException) -> ret 0 []
     CmplOpt (Just (Command n _ _)) pref
       -> case Map.lookup n (commands cmdEnv) of
-           Just inf -> do let flg_compls = ['-':flg | (flg,_) <- flags   inf, isPrefixOf pref flg]
+           Just inf -> do let flg_compls = [Haskeline.Completion ('-':flg++"=") ('-':flg) False | (flg,_) <- flags   inf, isPrefixOf pref flg]
-                              opt_compls = ['-':opt | (opt,_) <- options inf, isPrefixOf pref opt]
+                              opt_compls = [Haskeline.Completion ('-':opt)      ('-':opt) True | (opt,_) <- options inf, isPrefixOf pref opt]
-                          ret (if null flg_compls then ' ' else '=')
+                          ret (length pref+1)
                               (flg_compls++opt_compls)
-           Nothing  -> ret ' ' []
+           Nothing  -> ret (length pref) []
     CmplIdent (Just (Command "i" _ _)) _        -- HACK: file name completion for command i
-      -> filenameCompletionFunction prefix
+      -> Haskeline.completeFilename (left,right)
     CmplIdent _ pref
       -> do mb_abs <- try (evaluate (abstract pgf))
             case mb_abs of
-              Right abs -> ret ' ' [name | cid <- Map.keys (funs abs), let name = showCId cid, isPrefixOf pref name]
+              Right abs -> ret (length pref) [Haskeline.simpleCompletion name | cid <- Map.keys (funs abs), let name = showCId cid, isPrefixOf pref name]
-              Left (_ :: SomeException) -> ret ' ' []
+              Left (_ :: SomeException) -> ret (length pref) []
-    _ -> ret ' ' []
+    _ -> ret 0 []
   where
     pgf    = multigrammar cmdEnv
     cmdEnv = commandenv gfenv
@@ -305,8 +320,7 @@ wordCompletion gfenv line prefix p =
                        Left  es -> Nothing
                        Right ps -> loop ps ts
 
-    ret c [x] = return [x++[c]]
+    ret len xs  = return (drop len left,xs)
-    ret _ xs  = return xs
 
 
 data CompletionType