diff options
author | Alexander Foremny <aforemny@posteo.de> | 2023-10-16 23:02:26 +0200 |
---|---|---|
committer | Alexander Foremny <aforemny@posteo.de> | 2023-10-16 23:12:06 +0200 |
commit | f86850311f21354b2d3aeb9af343f5b8e81be972 (patch) | |
tree | 34937040543e85d01655c04fd3228ec720d7b9dd /app/Process.hs | |
parent | 20e95095090d5febce7deb17cfa6eec0a93e0482 (diff) |
fix unicode-related output problems
The underlying problem had been truncating `String` to `ByteString` (via
`IsString(fromString))`, which is unsafe.
Diffstat (limited to 'app/Process.hs')
-rw-r--r-- | app/Process.hs | 23 |
1 files changed, 16 insertions, 7 deletions
diff --git a/app/Process.hs b/app/Process.hs index 8ad4346..9ce5e46 100644 --- a/app/Process.hs +++ b/app/Process.hs @@ -7,23 +7,26 @@ module Process ProcessType, Quotable (..), proc, + textInput, ) where import Control.Exception (Exception, throwIO) -import Data.ByteString.Lazy (ByteString) +import Data.ByteString.Lazy.Char8 qualified as LB import Data.List (intercalate) import Data.String (fromString) -import Data.Text (Text, unpack) +import Data.Text qualified as T +import Data.Text.Lazy qualified as LT +import Data.Text.Lazy.Encoding qualified as LT import System.Exit (ExitCode (ExitSuccess)) -import System.Process.Typed (ProcessConfig, readProcess, readProcessStderr) +import System.Process.Typed (ProcessConfig, StreamSpec, StreamType (STInput), byteStringInput, readProcess, readProcessStderr) -data ProcessException = ProcessException String ExitCode ByteString +data ProcessException = ProcessException String ExitCode LB.ByteString deriving (Show) instance Exception ProcessException -sh :: ProcessConfig stdin stdoutIgnored stderr -> IO ByteString +sh :: ProcessConfig stdin stdoutIgnored stderr -> IO LB.ByteString sh processConfig = do (exitCode, out, err) <- readProcess processConfig if exitCode == ExitSuccess @@ -47,8 +50,11 @@ instance {-# OVERLAPPING #-} Quotable String where escape ('\'' : cs) = '\'' : '\\' : '\'' : '\'' : escape cs escape (c : cs) = c : escape cs -instance Quotable Text where - quote = quote . unpack +instance Quotable T.Text where + quote = quote . T.unpack + +instance Quotable Int where + quote = show instance {-# OVERLAPPABLE #-} Quotable a => Quotable [a] where quote = intercalate " " . map quote @@ -72,3 +78,6 @@ interp as (c : cs) = c : interp as cs proc :: ProcessType r => String -> r proc fmt = spr fmt [] + +textInput :: LT.Text -> StreamSpec 'STInput () +textInput = byteStringInput . LT.encodeUtf8 |