Merge pull request #334 from psibi/spawn-functions

Add new variants of spawnPipe functions with encoding support

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

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 <https://www.stackage.org/haddock/lts-15.9/base-4.13.0.0/src/GHC-IO-Handle-FD.html#fdToHandle>
+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 = "<file descriptor: " ++ show fd ++ ">"
+   FD.mkHandleFromFD fd fd_type fd_str iomode False{-non-block-} 
+                     (Just encoding)
+