packages feed

haskeline 0.7.3.0 → 0.7.3.1

raw patch · 10 files changed

+223/−33 lines, 10 filesdep +processPVP ok

version bump matches the API change (PVP)

Dependencies added: process

API changes (from Hackage documentation)

Files

Changelog view
@@ -1,3 +1,6 @@+Changed in version 0.7.3.1:+   * Properly disable echoing in getPassword when running in MinTTY.+   * Use `cast` from Data.Typeable instead of Data.Dynamic. Changed in version 0.7.3.0:    * Require ghc version of at least 7.4.1, and clean up obsolete code    * Add thread-safe (in terminal-style interaction) external print function
System/Console/Haskeline.hs view
@@ -235,6 +235,10 @@  When using file-style interaction, this function turns off echoing while reading the line of input.++Note that if Haskeline is built against a version of the @Win32@ library+earlier than 2.5, 'getPassword' will incorrectly echo back input on MinTTY+consoles (such as Cygwin or MSYS). -}  getPassword :: MonadException m => Maybe Char -- ^ A masking character; e.g., @Just \'*\'@@@ -243,9 +247,7 @@                     (\tops prefix -> runInputCmdT tops                                         $ runCommandLoop tops prefix loop                                         $ Password [] x)-                    (\fops -> let h_in = inputHandle fops-                              in bracketSet (hGetEcho h_in) (hSetEcho h_in) False-                                  $ runMaybeT $ getLocaleLine fops)+                    (\fops -> withoutInputEcho fops $ runMaybeT $ getLocaleLine fops)  where     loop = choiceCmd [ simpleChar '\n' +> finish                      , simpleKey Backspace +> change deletePasswordChar
System/Console/Haskeline/Backend/Posix.hsc view
@@ -34,7 +34,7 @@ import System.Console.Haskeline.Backend.Posix.Encoder  import GHC.IO.FD (fdFD)-import Data.Dynamic (cast)+import Data.Typeable (cast) import System.IO.Error import GHC.IO.Exception import GHC.IO.Handle.Types hiding (getState)@@ -320,12 +320,15 @@                                         hFlush (ehOut hs)                 , closeTerm = closeHandles hs                 , wrapInterrupt = withSigIntHandler-                , termOps = Right FileOps-                          { inputHandle = ehIn hs+                , termOps = let h_in = ehIn hs+                            in Right FileOps+                          { withoutInputEcho = bracketSet (hGetEcho h_in)+                                                          (hSetEcho h_in)+                                                          False                           , wrapFileInput = withCodingMode (hIn hs)-                          , getLocaleChar = guardedEOF hGetChar (ehIn hs)-                          , maybeReadNewline = hMaybeReadNewline (ehIn hs)-                          , getLocaleLine = guardedEOF hGetLine (ehIn hs)+                          , getLocaleChar = guardedEOF hGetChar h_in+                          , maybeReadNewline = hMaybeReadNewline h_in+                          , getLocaleLine = guardedEOF hGetLine h_in                           }                 }
System/Console/Haskeline/Backend/Win32.hsc view
@@ -22,19 +22,13 @@ import System.Console.Haskeline.LineState import System.Console.Haskeline.Term import System.Console.Haskeline.Backend.WCWidth+import System.Console.Haskeline.Backend.Win32.Echo (hWithoutInputEcho)  import Data.ByteString.Internal (createAndTrim) import qualified Data.ByteString as B -##if defined(i386_HOST_ARCH)-## define WINDOWS_CCONV stdcall-##elif defined(x86_64_HOST_ARCH)-## define WINDOWS_CCONV ccall-##else-## error Unknown mingw32 arch-##endif- #include "win_console.h"+##include "windows_cconv.h"  foreign import WINDOWS_CCONV "windows.h ReadConsoleInputW" c_ReadConsoleInput     :: HANDLE -> Ptr () -> DWORD -> Ptr DWORD -> IO Bool@@ -409,7 +403,7 @@                     putStrOut = putter,                     wrapInterrupt = withCtrlCHandler,                     termOps = Right FileOps-                                { inputHandle = h_in+                                { withoutInputEcho = hWithoutInputEcho h_in                                 , wrapFileInput = hWithBinaryMode h_in                                 , getLocaleChar = getMultiByteChar cp h_in                                 , maybeReadNewline = hMaybeReadNewline h_in
+ System/Console/Haskeline/Backend/Win32/Echo.hs view
@@ -0,0 +1,171 @@+{-# LANGUAGE CPP #-}++module System.Console.Haskeline.Backend.Win32.Echo (hWithoutInputEcho) where++import Control.Exception (throw)+import Control.Monad (void)+import Control.Monad.IO.Class (liftIO)++import System.Console.Haskeline.MonadException (MonadException, bracket)+import System.Exit (ExitCode(..))+import System.IO (Handle, hGetContents, hGetEcho, hSetEcho)+import System.Process (StdStream(..), createProcess, shell,+                       std_in, std_out, waitForProcess)++#if MIN_VERSION_Win32(2,5,0)+import Control.Concurrent.MVar (readMVar)++import Data.Typeable (cast)++import Foreign.C.Types+import Foreign.StablePtr (StablePtr, freeStablePtr, newStablePtr)++import GHC.IO.FD (FD(..))+import GHC.IO.Handle.Types (Handle(..), Handle__(..))++import System.Win32.Types (HANDLE)+import System.Win32.MinTTY (isMinTTYHandle)+#endif++-- | Return the handle's current input 'EchoState'.+hGetInputEchoState :: Handle -> IO EchoState+hGetInputEchoState input = do+  min_tty <- minTTY input+  if min_tty+     then fmap MinTTY (hGetInputEchoSTTY input)+     else fmap DefaultTTY $ hGetEcho input++-- | Return all of @stty@'s current settings in a non-human-readable format.+--+-- This function is not very useful on its own. Its greater purpose is to+-- provide a compact 'STTYSettings' that can be fed back into+-- 'hSetInputEchoState'.+hGetInputEchoSTTY :: Handle -> IO STTYSettings+hGetInputEchoSTTY input = hSttyRaw input "-g"++-- | Set the handle's input 'EchoState'.+hSetInputEchoState :: Handle -> EchoState -> IO ()+hSetInputEchoState input (MinTTY settings) = hSetInputEchoSTTY input settings+hSetInputEchoState input (DefaultTTY echo) = hSetEcho input echo++-- | Create an @stty@ process and wait for it to complete. This is useful for+-- changing @stty@'s settings, after which @stty@ does not output anything.+--+-- @+-- hSetInputEchoSTTY input = 'void' . 'hSttyRaw' input+-- @+hSetInputEchoSTTY :: Handle -> STTYSettings -> IO ()+hSetInputEchoSTTY input = void . hSttyRaw input++-- | Save the handle's current input 'EchoState', perform a computation,+-- restore the saved 'EchoState', and then return the result of the+-- computation.+--+-- @+-- bracketInputEcho input action =+--  'bracket' ('liftIO' $ 'hGetInputEchoState' input)+--            ('liftIO' . 'hSetInputEchoState' input)+--            (const action)+-- @+hBracketInputEcho :: MonadException m => Handle -> m a -> m a+hBracketInputEcho input action =+  bracket (liftIO $ hGetInputEchoState input)+          (liftIO . hSetInputEchoState input)+          (const action)++-- | Perform a computation with the handle's input echoing disabled. Before+-- running the computation, the handle's input 'EchoState' is saved, and the+-- saved 'EchoState' is restored after the computation finishes.+hWithoutInputEcho :: MonadException m => Handle -> m a -> m a+hWithoutInputEcho input action = do+  echo_off <- liftIO $ hEchoOff input+  hBracketInputEcho input+                    (liftIO (hSetInputEchoState input echo_off) >> action)++-- | Create an @stty@ process, wait for it to complete, and return its output.+hSttyRaw :: Handle -> String -> IO STTYSettings+hSttyRaw input arg = do+  let stty = (shell $ "stty " ++ arg) {+        std_in  = UseHandle input+      , std_out = CreatePipe+      }+  (_, mbStdout, _, rStty) <- createProcess stty+  exStty <- waitForProcess rStty+  case exStty of+    e@ExitFailure{} -> throw e+    ExitSuccess     -> maybe (return "") hGetContents mbStdout++-- | A representation of the handle input's current echoing state.+-- See, for instance, 'hEchoOff'.+data EchoState+  = MinTTY STTYSettings+    -- ^ The argument to (or value returned from) an invocation of the @stty@+    -- command-line utility. Most POSIX-like shells have @stty@, including+    -- MinTTY on Windows. Since neither 'hGetEcho' nor 'hSetEcho' work on+    -- MinTTY, when 'getInputEchoState' runs on MinTTY, it returns a value+    -- built with this constructor.+    --+    -- However, native Windows consoles like @cmd.exe@ or PowerShell do not+    -- have @stty@, so if you construct an 'EchoState' with this constructor+    -- manually, take care not to use it with a native Windows console.+  | DefaultTTY Bool+    -- ^ A simple on ('True') or off ('False') toggle. This is returned by+    -- 'hGetEcho' and given as an argument to 'hSetEcho', which work on most+    -- consoles, with the notable exception of MinTTY on Windows. If you+    -- construct an 'EchoState' with this constructor manually, take care not+    -- to use it with MinTTY.+  deriving (Eq, Ord, Show)++-- | Indicates that the handle's input echoing is (or should be) off.+hEchoOff :: Handle -> IO EchoState+hEchoOff input = do+  min_tty <- minTTY input+  return $ if min_tty+              then MinTTY "-echo"+              else DefaultTTY False++-- | Settings used to configure the @stty@ command-line utility.+type STTYSettings = String++-- | Is the current process attached to a MinTTY console (e.g., Cygwin or MSYS)?+minTTY :: Handle -> IO Bool+#if MIN_VERSION_Win32(2,5,0)+minTTY input = withHandleToHANDLE input isMinTTYHandle+#else+-- On older versions of Win32, we simply punt.+minTTY _     = return False+#endif++#if MIN_VERSION_Win32(2,5,0)+foreign import ccall unsafe "_get_osfhandle"+  c_get_osfhandle :: CInt -> IO HANDLE++-- | Extract a Windows 'HANDLE' from a Haskell 'Handle' and perform+-- an action on it.++-- Originally authored by Max Bolingbroke in the ansi-terminal library+withHandleToHANDLE :: Handle -> (HANDLE -> IO a) -> IO a+withHandleToHANDLE haskell_handle action =+    -- Create a stable pointer to the Handle. This prevents the garbage collector+    -- getting to it while we are doing horrible manipulations with it, and hence+    -- stops it being finalized (and closed).+    withStablePtr haskell_handle $ const $ do+        -- Grab the write handle variable from the Handle+        let write_handle_mvar = case haskell_handle of+                FileHandle _ handle_mvar     -> handle_mvar+                DuplexHandle _ _ handle_mvar -> handle_mvar+                  -- This is "write" MVar, we could also take the "read" one++        -- Get the FD from the algebraic data type+        Just fd <- fmap (\(Handle__ { haDevice = dev }) -> fmap fdFD (cast dev))+                 $ readMVar write_handle_mvar++        -- Finally, turn that (C-land) FD into a HANDLE using msvcrt+        windows_handle <- c_get_osfhandle fd++        -- Do what the user originally wanted+        action windows_handle++withStablePtr :: a -> (StablePtr a -> IO b) -> IO b+withStablePtr value = bracket (newStablePtr value) freeStablePtr+#endif
System/Console/Haskeline/Directory.hsc view
@@ -18,14 +18,7 @@  #include <windows.h> #include <shlobj.h>--##if defined(i386_HOST_ARCH)-## define WINDOWS_CCONV stdcall-##elif defined(x86_64_HOST_ARCH)-## define WINDOWS_CCONV ccall-##else-## error Unknown mingw32 arch-##endif+##include "windows_cconv.h"  foreign import WINDOWS_CCONV "FindFirstFileW" c_FindFirstFile             :: LPCTSTR -> Ptr () -> IO HANDLE@@ -63,7 +56,7 @@ getHomeDirectory :: IO FilePath getHomeDirectory = System.Directory.getHomeDirectory -#else +#else  import System.Directory
System/Console/Haskeline/Term.hs view
@@ -67,7 +67,8 @@ -- Backends can assume that getLocaleLine, getLocaleChar and maybeReadNewline -- are "wrapped" by wrapFileInput. data FileOps = FileOps {-            inputHandle :: Handle, -- ^ e.g. for turning off echoing.+            withoutInputEcho :: forall m a . MonadException m => m a -> m a,+            -- ^ Perform an action without echoing input.             wrapFileInput :: forall a . IO a -> IO a,             getLocaleLine :: MaybeT IO String,             getLocaleChar :: MaybeT IO Char,
haskeline.cabal view
@@ -1,6 +1,6 @@ Name:           haskeline Cabal-Version:  >=1.10-Version:        0.7.3.0+Version:        0.7.3.1 Category:       User Interfaces License:        BSD3 License-File:   LICENSE@@ -20,7 +20,7 @@ Bug-Reports:    https://github.com/judah/haskeline/issues Stability:      Stable Build-Type:     Custom-extra-source-files: examples/Test.hs Changelog+extra-source-files: examples/Test.hs Changelog includes/*.h  source-repository head     type: git@@ -44,7 +44,8 @@     -- wasn't fixed until 7.4.1     Build-depends: base >=4.5 && < 4.11, containers>=0.4 && < 0.6,                    directory>=1.1 && < 1.4, bytestring>=0.9 && < 0.11,-                   filepath >= 1.2 && < 1.5, transformers >= 0.2 && < 0.6+                   filepath >= 1.2 && < 1.5, transformers >= 0.2 && < 0.6,+                   process >= 1.0 && < 1.5     Default-Language: Haskell98     Default-Extensions:                 ForeignFunctionInterface, Rank2Types, FlexibleInstances,@@ -86,13 +87,14 @@     if os(windows) {         Build-depends: Win32>=2.0         Other-modules: System.Console.Haskeline.Backend.Win32+                       System.Console.Haskeline.Backend.Win32.Echo         c-sources: cbits/win_console.c-        includes: win_console.h+        includes: win_console.h, windows_cconv.h         install-includes: win_console.h         cpp-options: -DMINGW     } else {         Build-depends: unix>=2.0 && < 2.8-        Other-modules: +        Other-modules:                 System.Console.Haskeline.Backend.Posix                 System.Console.Haskeline.Backend.Posix.Encoder                 System.Console.Haskeline.Backend.DumbTerm
+ includes/h_iconv.h view
@@ -0,0 +1,9 @@+#include <iconv.h>++iconv_t haskeline_iconv_open(const char *tocode, const char *fromcode);++void haskeline_iconv_close(iconv_t cd);++size_t haskeline_iconv(iconv_t cd, char **inbuf, size_t *inbytesleft,+                char **outbuf, size_t *outbytesleft);+
+ includes/windows_cconv.h view
@@ -0,0 +1,12 @@+#ifndef WINDOWS_CCONV_H+#define WINDOWS_CCONV_H++#if defined(i386_HOST_ARCH)+# define WINDOWS_CCONV stdcall+#elif defined(x86_64_HOST_ARCH)+# define WINDOWS_CCONV ccall+#else+# error Unknown mingw32 arch+#endif++#endif