Fix #47: add a Cabal flag to enable/disable the terminfo backend (on by default).

System/Console/Haskeline/Backend.hs

@@ -5,7 +5,9 @@ import System.Console.Haskeline.Term
 #ifdef MINGW
 import System.Console.Haskeline.Backend.Win32 as Win32
 #else
+#ifdef TERMINFO
 import System.Console.Haskeline.Backend.Terminfo as Terminfo
+#endif
 import System.Console.Haskeline.Backend.DumbTerm as DumbTerm
 #endif
 
@@ -14,9 +16,13 @@ myRunTerm :: IO RunTerm
 #ifdef MINGW
 myRunTerm = win32Term
 #else
+#ifndef TERMINFO
+myRunTerm = runDumbTerm
+#else
 myRunTerm = do
     mRun <- runTerminfoDraw
     case mRun of 
         Nothing -> runDumbTerm
         Just run -> return run
 #endif
+#endif

System/Console/Haskeline/Backend/DumbTerm.hs

@@ -33,11 +33,11 @@ instance MonadException m => MonadException (DumbTerm m) where
 runDumbTerm :: IO RunTerm
 runDumbTerm = posixRunTerm $ \enc h ->
                 TermOps {
-                        getLayout = getPosixLayout h Nothing,
+                        getLayout = tryGetLayouts (posixLayouts h),
                         runTerm = \f -> 
                                 runPosixT enc h $ evalStateT' initWindow
                                 $ unDumbTerm
-                                $ withPosixGetEvent enc h Nothing f
+                                $ withPosixGetEvent enc [] f
                         }
                                 
 instance MonadTrans DumbTerm where

System/Console/Haskeline/Backend/Posix.hsc

 module System.Console.Haskeline.Backend.Posix (
                         withPosixGetEvent,
-                        getPosixLayout,
+                        posixLayouts,
+                        tryGetLayouts,
                         PosixT,
                         runPosixT,
                         Encoders(unicodeToLocale),
@@ -12,12 +13,11 @@ module System.Console.Haskeline.Backend.Posix (
 import Foreign
 import Foreign.C.Types
 import qualified Data.Map as Map
-import System.Console.Terminfo
 import System.Posix.Terminal hiding (Interrupt)
 import Control.Monad
 import Control.Concurrent hiding (throwTo)
 import Control.Concurrent.Chan
-import Data.Maybe
+import Data.Maybe (catMaybes)
 import System.Posix.Signals.Exts
 import System.Posix.IO(stdInput)
 import Data.List
@@ -42,8 +42,8 @@ import GHC.Handle (withHandle_)
 
 foreign import ccall ioctl :: CInt -> CULong -> Ptr a -> IO CInt
 
-getPosixLayout :: Handle -> Maybe Terminal -> IO Layout
-getPosixLayout h term = tryGetLayouts [ioctlLayout h, envLayout, tinfoLayout term]
+posixLayouts :: Handle -> [IO (Maybe Layout)]
+posixLayouts h = [ioctlLayout h, envLayout]
 
 ioctlLayout :: Handle -> IO (Maybe Layout)
 ioctlLayout h = allocaBytes (#size struct winsize) $ \ws -> do
@@ -65,12 +65,6 @@ envLayout = handle (\(_::IOException) -> return Nothing) $ do
     c <- getEnv "COLUMNS"
     return $ Just $ Layout {height=read r,width=read c}
 
-tinfoLayout :: Maybe Terminal -> IO (Maybe Layout)
-tinfoLayout = maybe (return Nothing) $ \t -> return $ getCapability t $ do
-                        r <- termColumns
-                        c <- termLines
-                        return Layout {height=r,width=c}
-
 tryGetLayouts :: [IO (Maybe Layout)] -> IO Layout
 tryGetLayouts [] = return Layout {height=24,width=80}
 tryGetLayouts (f:fs) = do
@@ -84,11 +78,10 @@ tryGetLayouts (f:fs) = do
 -- Key sequences
 
 getKeySequences :: (MonadIO m, MonadReader Prefs m)
-        => Maybe Terminal -> m (TreeMap Char Key)
-getKeySequences term = do
+        => [(String,Key)] -> m (TreeMap Char Key)
+getKeySequences tinfos = do
     sttys <- liftIO sttyKeys
     customKeySeqs <- getCustomKeySeqs
-    let tinfos = maybe [] terminfoKeys term
     -- note ++ acts as a union; so the below favors sttys over tinfos
     return $ listToTree
         $ ansiKeys ++ tinfos ++ sttys ++ customKeySeqs
@@ -109,22 +102,6 @@ ansiKeys = [("\ESC[D",  simpleKey LeftKey)
             ,("\ESC[B",  simpleKey DownKey)
             ,("\b",      simpleKey Backspace)]
 
-terminfoKeys :: Terminal -> [(String,Key)]
-terminfoKeys term = catMaybes $ map getSequence keyCapabilities
-    where 
-        getSequence (cap,x) = do 
-                            keys <- getCapability term cap
-                            return (keys,x)
-        keyCapabilities = 
-                [(keyLeft,      simpleKey LeftKey)
-                ,(keyRight,      simpleKey RightKey)
-                ,(keyUp,         simpleKey UpKey)
-                ,(keyDown,       simpleKey DownKey)
-                ,(keyBackspace,  simpleKey Backspace)
-                ,(keyDeleteChar, simpleKey Delete)
-                ,(keyHome,       simpleKey Home)
-                ,(keyEnd,        simpleKey End)
-                ]
 
 sttyKeys :: IO [(String, Key)]
 sttyKeys = do
@@ -183,21 +160,13 @@ lookupChars (TreeMap tm) (c:cs) = case Map.lookup c tm of
 -----------------------------
 
 withPosixGetEvent :: (MonadTrans t, MonadIO m, MonadException (t m), MonadReader Prefs m) 
-                        => Encoders -> Handle -> Maybe Terminal -> (t m Event -> t m a) -> t m a
-withPosixGetEvent enc h term f = do
-    baseMap <- lift $ getKeySequences term
+                        => Encoders -> [(String,Key)] -> (t m Event -> t m a) -> t m a
+withPosixGetEvent enc termKeys f = do
+    baseMap <- lift $ getKeySequences termKeys
     evenChan <- liftIO $ newChan
-    wrapKeypad h term $ withWindowHandler evenChan
+    withWindowHandler evenChan
         $ f $ liftIO $ getEvent enc baseMap evenChan
 
--- If the keypad on/off capabilities are defined, wrap the computation with them.
-wrapKeypad :: MonadException m => Handle -> Maybe Terminal -> m a -> m a
-wrapKeypad h = maybe id $ \term f -> (maybeOutput term keypadOn >> f) 
-                            `finally` maybeOutput term keypadOff
-  where
-    maybeOutput term cap = liftIO $ hRunTermOutput h term $
-                            fromMaybe mempty (getCapability term cap)
-
 withWindowHandler :: MonadException m => Chan Event -> m a -> m a
 withWindowHandler eventChan = withHandler windowChange $ 
     Catch $ writeChan eventChan WindowResize

System/Console/Haskeline/Backend/Terminfo.hs

@@ -10,11 +10,13 @@ import Data.List(intersperse)
 import System.IO
 import qualified Control.Exception.Extensible as Exception
 import qualified Data.ByteString.Char8 as B
+import Data.Maybe (fromMaybe, catMaybes)
 
 import System.Console.Haskeline.Monads as Monads
 import System.Console.Haskeline.LineState
 import System.Console.Haskeline.Term
 import System.Console.Haskeline.Backend.Posix
+import System.Console.Haskeline.Key
 
 -- | Keep track of all of the output capabilities we can use.
 -- 
@@ -119,15 +121,49 @@ runTerminfoDraw = do
             Nothing -> return Nothing
             Just actions -> fmap Just $ posixRunTerm $ \enc h ->
                 TermOps {
-                    getLayout = getPosixLayout h (Just term),
+                    getLayout = tryGetLayouts (posixLayouts h
+                                                ++ [tinfoLayout term]),
                     runTerm = \f ->
                              runPosixT enc h
                               $ evalStateT' initTermPos
                               $ runReaderT' term
                               $ runReaderT' actions
                               $ unDraw
-                              $ withPosixGetEvent enc h (Just term) f
+                              $ wrapKeypad h term
+                              $ withPosixGetEvent enc (terminfoKeys term) f
                     }
+
+-- If the keypad on/off capabilities are defined, wrap the computation with them.
+wrapKeypad :: MonadException m => Handle -> Terminal -> m a -> m a
+wrapKeypad h term f = (maybeOutput keypadOn >> f)
+                            `finally` maybeOutput keypadOff
+  where
+    maybeOutput cap = liftIO $ hRunTermOutput h term $
+                            fromMaybe mempty (getCapability term cap)
+
+tinfoLayout :: Terminal -> IO (Maybe Layout)
+tinfoLayout term = return $ getCapability term $ do
+                        r <- termColumns
+                        c <- termLines
+                        return Layout {height=r,width=c}
+
+terminfoKeys :: Terminal -> [(String,Key)]
+terminfoKeys term = catMaybes $ map getSequence keyCapabilities
+    where
+        getSequence (cap,x) = do
+                            keys <- getCapability term cap
+                            return (keys,x)
+        keyCapabilities =
+                [(keyLeft,      simpleKey LeftKey)
+                ,(keyRight,      simpleKey RightKey)
+                ,(keyUp,         simpleKey UpKey)
+                ,(keyDown,       simpleKey DownKey)
+                ,(keyBackspace,  simpleKey Backspace)
+                ,(keyDeleteChar, simpleKey Delete)
+                ,(keyHome,       simpleKey Home)
+                ,(keyEnd,        simpleKey End)
+                ]
+
     
 output :: MonadIO m => TermAction -> Draw m ()
 output f = do

haskeline.cabal

@@ -25,6 +25,10 @@ extra-source-files: examples/Test.hs
 flag old-base
     Description: Use the base packages from before version 6.8
 
+flag terminfo
+    Description: Use the terminfo package for POSIX consoles.
+    Default: True
+
 Library
     if flag(old-base)
         Build-depends: base < 3
@@ -71,13 +75,17 @@ Library
         install-includes: win_console.h
         cpp-options: -DMINGW
     } else {
-        Build-depends: terminfo==0.3.*, unix==2.2.* || ==2.3.*
+        Build-depends: unix==2.2.* || ==2.3.*
                         -- unix-2.3 doesn't build on ghc-6.8.1
         Extra-libraries: iconv
         Other-modules: 
                 System.Console.Haskeline.Backend.Posix
                 System.Console.Haskeline.Backend.IConv
                 System.Console.Haskeline.Backend.DumbTerm
-                System.Console.Haskeline.Backend.Terminfo
+        if flag(terminfo) {
+            Build-depends: terminfo==0.3.*
+            Other-modules: System.Console.Haskeline.Backend.Terminfo
+            cpp-options: -DTERMINFO
+        }
     }
     ghc-options: -Wall