fix unicode-related output problems

The underlying problem had been truncating `String` to `ByteString` (via
`IsString(fromString))`, which is unsafe.

2 files changed, 29 insertions, 36 deletions

diff --git a/app/Main.hs b/app/Main.hs
index 553ca38..fb81f07 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -216,10 +216,6 @@
 --
 -- @topic dependencies
 
--- FIXME Render all unicode symbols correctly
---
--- Some symbols like e.g. `╬` are not rendered properly.
-
 -- TODO Add fulltext search
 --
 -- Additional to `--filter` it should be possible to search for issues
@@ -301,11 +297,6 @@
 --
 -- COMMENT Sounds good!
 
--- FIXME Crash when displaying some unicode emojis
---
--- Running `anissue show tool-crashes-when-displaying-unicode-emojis`
--- will crash because of 🏗️.
-
 -- TODO Support issue comments
 -- Currently, comments do not get picked up in issue descriptions; see the
 -- issue below.
@@ -432,13 +423,10 @@
 
 module Main where
 
-import Data.ByteString.Lazy qualified as LB
 import Data.Function ((&))
 import Data.List (find)
-import Data.Maybe (catMaybes, fromMaybe)
-import Data.String qualified as String
+import Data.Maybe (catMaybes)
 import Data.Text qualified as T
-import Data.Text.Encoding qualified as T
 import Data.Text.Lazy qualified as LT
 import Data.Text.Lazy.IO qualified as LT
 import Data.Time.Clock (UTCTime (utctDay))
@@ -454,7 +442,7 @@ import Options.Applicative qualified as O
 import Prettyprinter ((<+>))
 import Prettyprinter qualified as P
 import Prettyprinter.Render.Terminal qualified as P
-import Process (sh_)
+import Process (proc, sh_, textInput)
 import System.Console.Terminal.Size qualified as Terminal
 import System.Exit (ExitCode (ExitFailure), exitWith)
 import System.Process.Typed qualified as P
@@ -630,20 +618,16 @@ main = do
                      )
                   ++ "\n\n"
           sh_
-            ( P.setStdin
-                ( String.fromString
-                    ( "# "
-                        ++ T.unpack issue.title
-                        ++ "\n\n"
-                        ++ fromMaybe "" (fmap T.unpack issue.description)
-                    )
-                )
-                ( case width of
-                    Nothing ->
-                      "mdcat --local"
-                    Just width' ->
-                      String.fromString (printf "mdcat --columns %d --local" width')
-                )
+            ( ( case width of
+                  Nothing -> "mdcat --local"
+                  Just width' -> proc "mdcat --columns % --local" width'
+              )
+                & P.setStdin
+                  ( textInput
+                      ( ("# " <> LT.fromStrict issue.title)
+                          <> maybe "" (("\n\n" <>) . LT.fromStrict) issue.description
+                      )
+                  )
             )
           putDoc colorize $
             P.pretty $
@@ -673,7 +657,7 @@ putDoc colorize doc = do
       sh_
         ( "${PAGER-less}"
             & P.shell
-            & P.setStdin (P.byteStringInput (LB.fromStrict (T.encodeUtf8 (LT.toStrict s))))
+            & P.setStdin (textInput s)
         )
     else LT.putStr s
 
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