diff options
| -rw-r--r-- | anissue.cabal | 1 | ||||
| -rw-r--r-- | app/Main.hs | 42 | ||||
| -rw-r--r-- | app/Process.hs | 23 |
3 files changed, 30 insertions, 36 deletions
diff --git a/anissue.cabal b/anissue.cabal index 9de81d2..7157c4e 100644 --- a/anissue.cabal +++ b/anissue.cabal @@ -108,6 +108,7 @@ executable anissue default-extensions: BlockArguments + DataKinds DeriveAnyClass DisambiguateRecordFields DuplicateRecordFields 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 |