From f86850311f21354b2d3aeb9af343f5b8e81be972 Mon Sep 17 00:00:00 2001
From: Alexander Foremny <aforemny@posteo.de>
Date: Mon, 16 Oct 2023 23:02:26 +0200
Subject: fix unicode-related output problems

The underlying problem had been truncating `String` to `ByteString` (via
`IsString(fromString))`, which is unsafe.
---
 app/Process.hs | 23 ++++++++++++++++-------
 1 file changed, 16 insertions(+), 7 deletions(-)

(limited to 'app/Process.hs')

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
-- 
cgit v1.2.3