Add useTermHandles behavior for explicitly providing term handles a…

…nd term type

System/Console/Haskeline.hs

@@ -39,6 +39,7 @@ module System.Console.Haskeline(
                     defaultBehavior,
                     useFileHandle,
                     useFile,
+                    useTermHandles,
                     preferTerm,
                     -- * User interaction functions
                     -- ** Reading user input

System/Console/Haskeline/Backend.hs

@@ -23,27 +23,39 @@ defaultRunTerm = (liftIO (hGetEcho stdin) >>= guard >> stdinTTY)
 terminalRunTerm :: IO RunTerm
 terminalRunTerm = directTTY `orElse` fileHandleRunTerm stdin
 
+#ifndef MINGW
+useTermHandlesRunTerm :: Maybe String -> Handle -> Handle -> IO RunTerm
+useTermHandlesRunTerm termtype input output =
+    explicitTTY termtype input output `orElse` fileHandleRunTerm input
+#endif
+
 stdinTTY :: MaybeT IO RunTerm
 #ifdef MINGW
 stdinTTY = win32TermStdin
 #else
-stdinTTY = stdinTTYHandles >>= runDraw
+stdinTTY = stdinTTYHandles >>= runDraw Nothing
 #endif
 
 directTTY :: MaybeT IO RunTerm
 #ifdef MINGW
 directTTY = win32Term
 #else
-directTTY = ttyHandles >>= runDraw
+directTTY = ttyHandles >>= runDraw Nothing
+#endif
+
+#ifndef MINGW
+explicitTTY :: Maybe String -> Handle -> Handle -> MaybeT IO RunTerm
+explicitTTY termtype input output =
+    explicitTTYHandles input output >>= runDraw termtype
 #endif
 
 
 #ifndef MINGW
-runDraw :: Handles -> MaybeT IO RunTerm
+runDraw :: Maybe String -> Handles -> MaybeT IO RunTerm
 #ifndef TERMINFO
-runDraw = runDumbTerm
+runDraw _termtype = runDumbTerm
 #else
-runDraw h = runTerminfoDraw h `mplus` runDumbTerm h
+runDraw termtype h = runTerminfoDraw termtype h `mplus` runDumbTerm h
 #endif
 #endif
 

System/Console/Haskeline/Backend/Posix.hsc

@@ -9,6 +9,7 @@ module System.Console.Haskeline.Backend.Posix (
                         mapLines,
                         stdinTTYHandles,
                         ttyHandles,
+                        explicitTTYHandles,
                         posixRunTerm,
                         fileRunTerm
                  ) where
@@ -276,6 +277,15 @@ openTerm :: IOMode -> MaybeT IO ExternalHandle
 openTerm mode = handle (\(_::IOException) -> mzero)
             $ liftIO $ openInCodingMode "/dev/tty" mode
 
+explicitTTYHandles :: Handle -> Handle -> MaybeT IO Handles
+explicitTTYHandles h_in h_out = do
+    isInTerm <- liftIO $ hIsTerminalDevice h_in
+    guard isInTerm
+    return Handles
+            { hIn = externalHandle h_in
+            , hOut = externalHandle h_out
+            , closeHandles = return ()
+            }
 
 posixRunTerm ::
     Handles

System/Console/Haskeline/Backend/Terminfo.hs

@@ -125,9 +125,9 @@ evalDraw term actions = EvalTerm eval liftE
                             . unDraw 
 
 
-runTerminfoDraw :: Handles -> MaybeT IO RunTerm
-runTerminfoDraw h = do
-    mterm <- liftIO $ Exception.try setupTermFromEnv
+runTerminfoDraw :: Maybe String -> Handles -> MaybeT IO RunTerm
+runTerminfoDraw termtype h = do
+    mterm <- liftIO $ Exception.try $ maybe setupTermFromEnv setupTerm termtype
     case mterm of
         Left (_::SetupTermError) -> mzero
         Right term -> do

System/Console/Haskeline/InputT.hs

@@ -216,6 +216,16 @@ useFile file = Behavior $ do
 preferTerm :: Behavior
 preferTerm = Behavior terminalRunTerm
 
+#ifndef MINGW
+-- | Use terminal-style interaction on the given input and output handles.  The terminal
+-- type may also be explicitly specified.
+--
+-- This behavior is for dealing with terminals other than the controlling terminal.
+-- The caller is responsible for closing handles after use.  Not available on Windows.
+useTermHandles :: Maybe String -> Handle -> Handle -> Behavior
+useTermHandles termtype input output =
+    Behavior $ useTermHandlesRunTerm termtype input output
+#endif
 
 -- | Read 'Prefs' from @~/.haskeline.@   If there is an error reading the file,
 -- the 'defaultPrefs' will be returned.