From 8b2bd3ae5cd1b667842c34f6e218be43c7194c36 Mon Sep 17 00:00:00 2001 From: Sibi Prabakaran Date: Fri, 24 Apr 2020 12:38:29 +0530 Subject: [PATCH] Add new variants of spawnPipe functions with encoding support MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit The current handle returned by `spawnPipe` doesn't have any encoding and it uses the function fdToHandle which returns a Binary Handle. When spawnPipe is used with a program like xmobar, this can easily lead to errors: λ> h <- spawnPipe "xmobar" λ> hPutStrLn h "\35753Haskell\25110\32773Ghci\33021\27491\30830\26174\31034\27721\23383\24182\19988\35835\21462\27721\23383\21629\21517\30340\25991\26723" : hGetLine: invalid argument (invalid byte sequence) One workaround, to avoid this is to use `hSetEncoding`. But from reading GHC's source code - the entire Handle and write operations seems stateful. So doing something like hPutStr and hSetEncoding can theoretically lead to an undefined state as the first write will use latin encoding and the second write will use the new encoding. More details about it are present here: * http://hackage.haskell.org/package/base-4.12.0.0/docs/src/GHC.IO.Handle.Internals.html#writeCharBuffer * http://hackage.haskell.org/package/base-4.12.0.0/docs/src/GHC.IO.Buffer.html#CharBuffer So having these new functions will ensure that we get the handles in the proper encoding in the first place. --- CHANGES.md | 6 +++++ XMonad/Util/Run.hs | 56 ++++++++++++++++++++++++++++++++++++++++++++-- 2 files changed, 60 insertions(+), 2 deletions(-) diff --git a/CHANGES.md b/CHANGES.md index d355fb842f..a9a858ca9c 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -39,6 +39,12 @@ ### Bug Fixes and Minor Changes + * `XMonad.Util.Run` + + Added two new functions to the module: `spawnPipeWithLocaleEncoding` and + `spawnPipeWithUtf8Encoding`. Using these function should be + preferred over `spawnPipe`. + * `XMonad.Prompt.Window` Added 'allApplications' function which maps application executable diff --git a/XMonad/Util/Run.hs b/XMonad/Util/Run.hs index 1312145ce0..0fe519f1d9 100644 --- a/XMonad/Util/Run.hs +++ b/XMonad/Util/Run.hs @@ -27,7 +27,8 @@ module XMonad.Util.Run ( safeRunInTerm, seconds, spawnPipe, - + spawnPipeWithLocaleEncoding, + spawnPipeWithUtf8Encoding, hPutStr, hPutStrLn -- re-export for convenience ) where @@ -39,6 +40,9 @@ import System.IO import System.Process (runInteractiveProcess) import XMonad import Control.Monad +import qualified GHC.IO.FD as FD +import qualified GHC.IO.Handle.FD as FD +import qualified System.Posix.Internals as Posix -- $usage -- For an example usage of 'runInTerm' see "XMonad.Prompt.Ssh" @@ -144,7 +148,9 @@ runInTerm = unsafeRunInTerm safeRunInTerm :: String -> String -> X () safeRunInTerm options command = asks (terminal . config) >>= \t -> safeSpawn t [options, " -e " ++ command] --- | Launch an external application through the system shell and return a @Handle@ to its standard input. +-- | Launch an external application through the system shell and +-- return a @Handle@ to its standard input. Note that the @Handle@ +-- is a binary Handle. You should probably use 'spawnPipeWithUtf8Encoding'. spawnPipe :: MonadIO m => String -> m Handle spawnPipe x = io $ do (rd, wr) <- createPipe @@ -156,3 +162,49 @@ spawnPipe x = io $ do executeFile "/bin/sh" False ["-c", encodeString x] Nothing closeFd rd return h + +-- | Same as 'spawnPipe', but uses the current 'localeEncoding'. +spawnPipeWithLocaleEncoding :: MonadIO m => String -> m Handle +spawnPipeWithLocaleEncoding x = io $ do + (rd, wr) <- createPipe + setFdOption wr CloseOnExec True + h <- fdToTextHandle (fromIntegral wr) localeEncoding + hSetBuffering h LineBuffering + _ <- xfork $ do + _ <- dupTo rd stdInput + executeFile "/bin/sh" False ["-c", encodeString x] Nothing + closeFd rd + return h + +-- | Same as 'spawnPipe', but uses the 'utf8' encoding. +spawnPipeWithUtf8Encoding :: MonadIO m => String -> m Handle +spawnPipeWithUtf8Encoding x = io $ do + (rd, wr) <- createPipe + setFdOption wr CloseOnExec True + h <- fdToTextHandle (fromIntegral wr) utf8 + hSetBuffering h LineBuffering + _ <- xfork $ do + _ <- dupTo rd stdInput + executeFile "/bin/sh" False ["-c", encodeString x] Nothing + closeFd rd + return h + +-- | Same as 'fdToHandle', but this makes a text Handle instead of +-- Binary. The handle is set with the 'TextEncoding' you pass. +-- +-- Implementation taken and modified from +fdToTextHandle :: Posix.FD -> TextEncoding -> IO Handle +fdToTextHandle fdint encoding = do + iomode <- Posix.fdGetMode fdint + (fd,fd_type) <- FD.mkFD fdint iomode Nothing + False{-is_socket-} + -- NB. the is_socket flag is False, meaning that: + -- on Windows we're guessing this is not a socket (XXX) + False{-is_nonblock-} + -- file descriptors that we get from external sources are + -- not put into non-blocking mode, because that would affect + -- other users of the file descriptor + let fd_str = "" + FD.mkHandleFromFD fd fd_type fd_str iomode False{-non-block-} + (Just encoding) +