[darcs-users] darcs patch: Make Haskeline a required dependency (+ 4 more)

Petr Rockai me at mornfall.net
Tue Feb 3 18:01:38 UTC 2009


Hi,

I guess Salvatore could cross-review, I'm just going to read through this and
if I encounter anything, note it inline.

Judah Jacobson <judah.jacobson at gmail.com> writes:
> 2) Make Haskeline required instead of optional.  This removes a
> significant amount of platform-dependent terminal manipulation, so I
> think it's worth considering.
I fully agree.

> The Haskeline changes have been tested on both OS X and Windows; I
> split it into two patches since the second ("Don't set stdin's
> buffering") should probably be reviewed by someone more familiar than
> me with SelectChanges.hs.
SelectChanges prompting has been buggy anyway before this patch. Ie. I don't
think you can break it much more than it already is.

Make Haskeline a required dependency.
-------------------------------------
> hunk ./configure.ac 201
>  GHC_CHECK_MODULE(System.Console.Haskeline.Encoding( encode ),
>                   haskeline,
>                   let {f :: (a -> t IO b) -> (a -> t IO b); f = id} in f encode,
> -                 [haskelinefound=yes],
> -                 [haskelinefound=no])
> -if test $haskelinefound = "yes"; then
> -  AC_MSG_CHECKING([whether to use haskeline])
> -  AC_ARG_ENABLE(haskeline,
> -                AS_HELP_STRING([--disable-haskeline], [do not use haskeline, even if it is present]),
> -                haskeline=$enableval,
> -                haskeline=yes)
> -  AC_MSG_RESULT($haskeline)
> -  if test $haskeline = "yes"; then
> -    GHCFLAGS="$GHCFLAGS -DHAVE_HASKELINE"
> -  fi
> -fi
> +                 ,,
> +                 AC_MSG_ERROR(Cannot find Haskeline>=0.6; try installing the Haskell package haskeline?))
>  
>  dnl See if we need any packages from after the split base
>  
> hunk ./darcs.cabal 99
>    description: Use the external zlib binding package.
>    default:     False
>  
> -flag haskeline
> -  description: Use the haskeline package for command line editing support.
> -
>  flag terminfo
>    description: Use the terminfo package for enhanced console support.
>  
> hunk ./darcs.cabal 301
>                     mtl          >= 1.0 && < 1.2,
>                     parsec       >= 2.0 && < 3.1,
>                     html         == 1.0.*,
> -                   filepath     == 1.1.*
> +                   filepath     == 1.1.*,
> +                   haskeline    == 0.6.*
>  
>    if !os(windows)
>      build-depends: unix >= 1.0 && < 2.4
> hunk ./darcs.cabal 372
>      extra-libraries:  curses
>      cpp-options:      -DHAVE_CURSES
>  
> -  if flag(haskeline)
> -    build-depends:    haskeline == 0.6.*
> -    cpp-options:      -DHAVE_HASKELINE
> -
>    if flag(color)
>      x-use-color:
>  
> hunk ./darcs.cabal 441
>                     mtl          >= 1.0 && < 1.2,
>                     parsec       >= 2.0 && < 3.1,
>                     html         == 1.0.*,
> -                   filepath     == 1.1.*
> +                   filepath     == 1.1.*,
> +                   haskeline    == 0.6.*
>  
>    if !os(windows)
>      build-depends: unix >= 1.0 && < 2.4
> hunk ./darcs.cabal 508
>      extra-libraries:  curses
>      cpp-options:      -DHAVE_CURSES
>  
> -  if flag(haskeline)
> -    build-depends:    haskeline == 0.6.*
> -    cpp-options:      -DHAVE_HASKELINE
> -
>    if flag(color)
>      x-use-color:
Looks OK to me.

> hunk ./src/Darcs/Utils.hs 17
>                      formatPath ) where
>  
>  import Prelude hiding ( catch )
> -import Control.Exception ( bracket, bracket_, catch, Exception(IOException), throwIO, try, throw, ioErrors )
> -import Control.Concurrent ( newEmptyMVar, takeMVar, putMVar, forkIO )
> +import Control.Exception ( bracket, bracket_, catch, Exception(IOException), try, throw, ioErrors )
>  #if !defined(WIN32) ||  __GLASGOW_HASKELL__>=609
>  import Control.Concurrent ( threadWaitRead )
>  #endif
Import wibbling.

> hunk ./src/Darcs/Utils.hs 30
>  import Numeric ( showHex )
>  import System.Exit ( ExitCode(..) )
>  import System.Environment ( getEnv )
> -import System.IO ( hFlush, hPutStrLn, stderr, stdout, stdin,
> +import System.IO ( hPutStrLn, stderr, stdin,
>                     BufferMode ( NoBuffering ),
>                     hLookAhead, hReady, hSetBuffering, hGetBuffering, hIsTerminalDevice )
>  import Data.Char ( toUpper )
More import wibbling.

> hunk ./src/Darcs/Utils.hs 46
>  
>  import Progress ( withoutProgress )
>  
> -#ifdef HAVE_HASKELINE
> -import System.Console.Haskeline ( runInputT, defaultSettings, getInputLine )
> +import System.Console.Haskeline ( runInputT, defaultSettings, getInputLine,
> +                                  getInputChar, outputStrLn )
>  import System.Console.Haskeline.Encoding ( encode )
>  import qualified Data.ByteString.Char8 as B
> hunk ./src/Darcs/Utils.hs 50
> -#endif
Fine.

> hunk ./src/Darcs/Utils.hs 143
>             (reset_umask rc)
>             job
>
> --- withThread is used to allow ctrl-C to work even while we're waiting for
> --- user input.  The job is run in a separate thread, and any exceptions it
> --- produces are re-thrown in the parent thread.
> -withThread :: IO a -> IO a
> -withThread j = do m <- newEmptyMVar
> -                  forkIO (runJob m)
> -                  takeMVar m >>= either throwIO return
> -    where runJob m = (j >>= putMVar m . Right) `catch` (putMVar m . Left)
> -
Good riddance.

> hunk ./src/Darcs/Utils.hs 144
> -#ifdef HAVE_HASKELINE
>  askUser prompt = withoutProgress $ runInputT defaultSettings $
>                      getInputLine prompt
>                          >>= maybe (error "askUser: unexpected end of input") return
> hunk ./src/Darcs/Utils.hs 150
>              -- Return the input as encoded, 8-bit Chars (same as the
>              -- non-Haskeline backend).
>                          >>= fmap B.unpack . encode
> -#else
> -askUser prompt = withThread $ withoutProgress $ do putStr prompt
> -                                                   hFlush stdout
> -                                                   waitForStdin
> -#ifndef WIN32
> -                                                   getLine
> -#else
> -                                                   stripCr `fmap` getLine
> -#endif
> -#endif
More good riddance.

> hunk ./src/Darcs/Utils.hs 216
>  promptYorn p = promptCharFancy p "yn" Nothing []
>
>  promptCharFancy :: String -> [Char] -> Maybe Char -> [Char] -> IO Char
> -promptCharFancy p chs md help_chs =
> - do a <- withThread $ without_buffering $
> -           do putStr $ p ++ " ["++ setDefault chs ++"]" ++ helpStr
> -              hFlush stdout
> -              waitForStdin
> -              c <- getChar
> -#ifdef WIN32
> -              -- We need to simulate echo
> -              e <- get_raw_mode
> -              when e $ putChar c
> -#endif
> -              return c
> -    when (a /= '\n') $ putStr "\n" 
> +promptCharFancy p chs md help_chs = withoutProgress $ runInputT defaultSettings $
> +                                        loopChar
> + where
> + loopChar = do
> +    let prompt = p ++ " [" ++ setDefault chs ++ "]" ++ helpStr
> +    a <- getInputChar prompt >>= maybe (error "promptCharFancy: unexpected end of input")
> +                                    return
>      case () of 
>       _ | a `elem` chs                   -> return a
>         | a == ' ' -> case md of Nothing -> tryAgain 
Basically replaces promptCharFancy with a call to haskeline. More hacks
disappear.

> hunk ./src/Darcs/Utils.hs 229
>                                  Just d  -> return d
>         | a `elem` help_chs              -> return a
>         | otherwise                      -> tryAgain
> - where 
>   helpStr = case help_chs of
>             []    -> ""
>             (h:_) -> ", or " ++ (h:" for help: ")
> hunk ./src/Darcs/Utils.hs 232
> - tryAgain = do putStrLn "Invalid response, try again!"
> -               promptCharFancy p chs md help_chs
> + tryAgain = do outputStrLn "Invalid response, try again!"
> +               loopChar
>   setDefault s = case md of Nothing -> s
>                             Just d  -> map (setUpper d) s
>   setUpper d c = if d == c then toUpper c else c

Don't set stdin's buffering; Haskeline will do that for us.
-----------------------------------------------------------
> hunk ./src/Darcs/SelectChanges.hs 73
>  import Darcs.Match ( have_nonrange_match, match_a_patch, match_a_patchread )
>  import Darcs.Flags ( DarcsFlag( Summary, DontGrabDeps, Verbose, DontPromptForDependencies), isInteractive )
>  import Darcs.Sealed ( FlippedSeal(..), flipSeal, seal2, unseal2 )
> -import Darcs.Utils ( askUser, promptCharFancy, without_buffering )
> +import Darcs.Utils ( askUser, promptCharFancy )
>  import Printer ( prefix, putDocLn )
>  #include "impossible.h"
>  
> hunk ./src/Darcs/SelectChanges.hs 168
>    ps_to_consider :> _ -> vc ps_to_consider
>   where
>         vc :: RepoPatch p => FL (PatchInfoAnd p) C(x y) -> IO ()
> -       vc p = without_buffering $ do text_view opts ps_len 0 NilRL init_tps init_pc
> -                                     return ()
> +       vc p = do text_view opts ps_len 0 NilRL init_tps init_pc
> +                 return ()
Not related to the review, but text_view apparently suffers from some creeping
parametrism.

>          where (init_pc, init_tps) = patch_choices_tps p
>                ps_len = lengthFL init_tps
>  
> hunk ./src/Darcs/SelectChanges.hs 194
>                                -> (FORALL(a) (FL (PatchInfoAnd p) :> PatchInfoAnd p) C(a r) -> IO ()) -> IO ()
>  with_selected_patch_from_repo jn repository opts job = do
>      p_s <- read_repo repository
> -    sp <- without_buffering $ wspfr jn (match_a_patchread opts)
> +    sp <- wspfr jn (match_a_patchread opts)
>                                (concatRL p_s) NilFL
>      case sp of
>       Just (FlippedSeal (skipped :> selected)) -> job (skipped :> selected)
> hunk ./src/Darcs/SelectChanges.hs 248
>   ps_to_consider :> other_ps ->
>           if not $ isInteractive opts
>           then job $ ps_to_consider :> other_ps
> -         else do pc <- without_buffering $
> -                       tentatively_text_select "" jobname (Noun "patch") Last crit
> +         else do pc <- tentatively_text_select "" jobname (Noun "patch") Last crit
>                                                opts ps_len 0 NilRL init_tps init_pc
>                   job $ selected_patches_last rejected_ps pc
>           where rejected_ps = ps_to_consider
> hunk ./src/Darcs/SelectChanges.hs 264
>   ps_to_consider :> other_ps ->
>           if not $ isInteractive opts
>           then job $ ps_to_consider :> other_ps
> -         else do pc <- without_buffering $
> -                       tentatively_text_select "" jobname (Noun "patch") First crit
> +         else do pc <- tentatively_text_select "" jobname (Noun "patch") First crit
>                                                opts ps_len 0 NilRL init_tps init_pc
>                   job $ selected_patches_first rejected_ps pc
>           where rejected_ps = other_ps
> hunk ./src/Darcs/SelectChanges.hs 280
>   ps_to_consider :> other_ps ->
>           if not $ isInteractive opts
>           then job $ invert other_ps :> invert ps_to_consider
> -         else do pc <- without_buffering $
> -                       tentatively_text_select "" jobname (Noun "patch") FirstReversed crit
> +         else do pc <- tentatively_text_select "" jobname (Noun "patch") FirstReversed crit
>                                               opts ps_len 0 NilRL init_tps init_pc
>                   job $ selected_patches_first_reversed rejected_ps pc
>           where rejected_ps = ps_to_consider
> hunk ./src/Darcs/SelectChanges.hs 296
>   ps_to_consider :> other_ps ->
>           if not $ isInteractive opts
>           then job $ invert other_ps :> invert ps_to_consider
> -         else do pc <- without_buffering $
> -                       tentatively_text_select "" jobname (Noun "patch") LastReversed crit
> +         else do pc <- tentatively_text_select "" jobname (Noun "patch") LastReversed crit
>                                               opts ps_len 0 NilRL init_tps init_pc
>                   job $ selected_patches_last_reversed rejected_ps pc
>           where rejected_ps = other_ps
> hunk ./src/Darcs/Utils.hs 13
>                      showHexLen, add_to_error_loc,
>                      maybeGetEnv, firstNotBlank, firstJustM, firstJustIO,
>                      isUnsupportedOperationError, isHardwareFaultError,
> -                    get_viewer, edit_file, promptYorn, promptCharFancy, without_buffering,
> +                    get_viewer, edit_file, promptYorn, promptCharFancy,
>                      formatPath ) where
Removes without_buffering from a lot of places, as advertised. I'd like to hear
a comment from Judah on how the buffering issue is handled by haskeline,
though. My pet peeve with that keeping a key pressed to get past many patches
screws up some internal state right now. It might be because the buffering is
disabled all the time, but the program is not ready to read. IIUIC, haskeline
will only disable buffering while it is ready to process input? Maybe that will
actually fix that bug. Well, let me see, anyway. *applies and builds*.

>From some quick testing on screen/rxvt combo under linux:

- enter in patch selection no longer repeats the prompt (I don't think this
  matters at all)
- cursor navigation keys work in patch name prompts (which is actual
  improvement)

> hunk ./src/Darcs/Utils.hs 17
> -import Control.Exception ( bracket, bracket_, catch, Exception(IOException), try, throw, ioErrors )
> -#if !defined(WIN32) ||  __GLASGOW_HASKELL__>=609
> -import Control.Concurrent ( threadWaitRead )
> -#endif
> +import Control.Exception ( bracket, bracket_, catch, Exception(IOException), try )
>  import GHC.IOBase ( IOException(ioe_location),
>                      IOErrorType(UnsupportedOperation, HardwareFault) )
> hunk ./src/Darcs/Utils.hs 20
> -import System.IO.Error ( isUserError, ioeGetErrorType, ioeGetErrorString,
> -                         isEOFError )
> +import System.IO.Error ( isUserError, ioeGetErrorType, ioeGetErrorString )
>  
>  import Darcs.SignalHandler ( catchNonSignal )
>  import Numeric ( showHex )
> hunk ./src/Darcs/Utils.hs 26
>  import System.Exit ( ExitCode(..) )
>  import System.Environment ( getEnv )
> -import System.IO ( hPutStrLn, stderr, stdin,
> -                   BufferMode ( NoBuffering ),
> -                   hLookAhead, hReady, hSetBuffering, hGetBuffering, hIsTerminalDevice )
> +import System.IO ( hPutStrLn, stderr )
>  import Data.Char ( toUpper )
>  import Darcs.RepoPath ( FilePathLike, getCurrentDirectory, setCurrentDirectory, toFilePath )
>  import Data.Maybe ( listToMaybe, isJust )
> hunk ./src/Darcs/Utils.hs 45
>  import System.Console.Haskeline.Encoding ( encode )
>  import qualified Data.ByteString.Char8 as B
>  
> -#ifdef WIN32
> -import System.Posix.Internals ( getEcho, setCooked, setEcho )
> -#endif
> -
>  showHexLen :: (Integral a) => Int -> a -> String
>  showHexLen n x = let s = showHex x ""
>                   in replicate (n - length s) ' ' ++ s
> hunk ./src/Darcs/Utils.hs 141
>              -- non-Haskeline backend).
>                          >>= fmap B.unpack . encode
>  
> -waitForStdin :: IO ()
> -#ifdef WIN32
> -#if __GLASGOW_HASKELL__ >= 609
> -waitForStdin = threadWaitRead 0
> -#else
> -waitForStdin = return ()  -- threadWaitRead didn't work prior to 6.9
> -#endif
> -#else
> -waitForStdin = threadWaitRead 0
> -#endif
> -
>  stripCr :: String -> String
>  stripCr ""     = ""
>  stripCr "\r"   = ""
> hunk ./src/Darcs/Utils.hs 216
>   setDefault s = case md of Nothing -> s
>                             Just d  -> map (setUpper d) s
>   setUpper d c = if d == c then toUpper c else c
> -
> -without_buffering :: IO a -> IO a
> -without_buffering job = withoutProgress $ do
> -    bracket nobuf rebuf $ \_ -> job
> -    where nobuf = do is_term <- hIsTerminalDevice stdin
> -                     bi <- hGetBuffering stdin
> -                     raw <- get_raw_mode
> -                     when is_term $ do hSetBuffering stdin NoBuffering `catch` \_ -> return ()
> -                                       set_raw_mode True
> -                     return (bi,raw)
> -          rebuf (bi,raw) = do is_term <- hIsTerminalDevice stdin
> -#if SYS == windows
> -                              buffers <- hGetBuffering stdin
> -                              hSetBuffering stdin NoBuffering `catch` \_ -> return ()
> -                              drop_returns
> -                              hSetBuffering stdin buffers `catch` \_ -> return ()
> -#else
> -                              drop_returns
> -#endif
> -                              when is_term $ do hSetBuffering stdin bi `catch` \_ -> return ()
> -                                                set_raw_mode raw
> -          drop_returns = do is_ready <- hReady stdin `catch` \ e ->
> -                                        case ioErrors e of
> -                                          Just x -> if isEOFError x
> -                                                      then return True
> -                                                      else throw e
> -                                          _ -> throw e
> -                            when is_ready $
> -                              do waitForStdin
> -                                 c <- hLookAhead stdin `catch` \_ -> return ' '
> -                                 when (c == '\n') $
> -                                   do getChar
> -                                      drop_returns
> -
> --- Code which was in the module RawMode before. Moved here to break cyclic imports
> -#ifdef WIN32
> -
> -get_raw_mode :: IO Bool
> -get_raw_mode = not `fmap` getEcho 0
> -  `catchall` return False -- getEcho sometimes fails when called from scripts
> -
> -set_raw_mode :: Bool -> IO ()
> -set_raw_mode raw = (setCooked 0 normal >> setEcho 0 normal)
> -   `catchall` return () -- setCooked sometimes fails when called from scripts
> - where normal = not raw
> -
> -#else
> -
> -get_raw_mode :: IO Bool
> -get_raw_mode = return False
> -
> -set_raw_mode :: Bool -> IO ()
> -set_raw_mode _ = return ()
> -
> -#endif
Removing lots of custom cruft that is better handled by haskeline
anyway. Likeable.

Don't use the bytestring-mmap package on Windows.
-------------------------------------------------
> hunk ./darcs.cabal 349
>          cpp-options:      -DHAVE_HTTP
>          x-have-http:
>  
> -  if flag(mmap)
> +  if flag(mmap) && !os(windows)
>      build-depends:    bytestring-mmap >= 0.2
>      cpp-options:      -DHAVE_MMAP
>  
> hunk ./darcs.cabal 485
>          cpp-options:      -DHAVE_HTTP
>          x-have-http:
>  
> -  if flag(mmap)
> +  if flag(mmap) && !os(windows)
>      build-depends:    bytestring-mmap >= 0.2
>      cpp-options:      -DHAVE_MMAP
I would have expected cabal to deal with unavailability of bytestring-mmap on
windows gracefully by itself? Does it cause any actual trouble this way? (Can't
check as I don't have a windows host available.)

Tell Cabal about send_email.c on Windows.
-----------------------------------------
> hunk ./darcs.cabal 432
>                      System.Posix.Files
>                      System.Posix.IO
>      cpp-options:    -DWIN32
> +    c-sources:      src/win32/send_email.c
>  
>    if os(solaris)
>      cc-options:     -DHAVE_SIGINFO_H

Hm, wondering if Salvatore did not run into this being a problem? (I have no
idea about it, let's just run it against the buildbots.)

Remove a redundant clause from the Cabal file."
-----------------------------------------------
> hunk ./darcs.cabal 414
>    if !flag(external-zlib)
>      extra-libraries:  z
>  
> -  if os(windows)
> -    hs-source-dirs: src/win32
> -    include-dirs:   src/win32
> -    other-modules:  CtrlC
> -                    System.Posix
> -                    System.Posix.Files
> -                    System.Posix.IO
> -    cpp-options:    -DWIN32
>    cc-options:       -D_REENTRANT
>  
>    if os(windows)
OK, I have a dupe of this patch in my repo that I forgot to send today. Lemme
unpull my copy. *done*

All in all, I think this is a good patch and would welcome its inclusion.

Thanks!

-- 
Peter Rockai | me()mornfall!net | prockai()redhat!com
 http://blog.mornfall.net | http://web.mornfall.net

"In My Egotistical Opinion, most people's C programs should be
 indented six feet downward and covered with dirt."
     -- Blair P. Houghton on the subject of C program indentation


More information about the darcs-users mailing list