improve error handling when calling external processes

1 files changed, 18 insertions, 6 deletions

diff --git a/app/Main.hs b/app/Main.hs
index ed059e5..ebe9856 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -48,9 +48,10 @@
 
 module Main where
 
-import Control.Exception (Exception, catch, throw)
+import Control.Exception (Exception, catch, throw, throwIO)
 import Data.Aeson qualified as A
-import Data.ByteString.Lazy.Char8 qualified as LB8
+import Data.ByteString.Lazy qualified as L
+import Data.ByteString.Lazy.Char8 qualified as L8
 import Data.Maybe (catMaybes)
 import Data.Maybe qualified as Maybe
 import Data.String qualified as String
@@ -173,8 +174,7 @@ getIssues filename =
         . concatMap (\result -> map ((,) result) result.matches)
         . map fixTreeGrepper
         . decode
-        . snd
-        <$> P.readProcessStdout
+        <$> sh
           ( String.fromString
               ( "tree-grepper --query '"
                   ++ treeGrepperLanguage
@@ -186,11 +186,23 @@ getIssues filename =
               )
           )
 
+data ProcessException = ProcessException String ExitCode L.ByteString
+  deriving (Show)
+
+instance Exception ProcessException
+
+sh :: P.ProcessConfig stdin stdoutIgnored stderr -> IO L.ByteString
+sh proc = do
+  (exitCode, out, err) <- P.readProcess proc
+  if exitCode == P.ExitSuccess
+    then pure out
+    else throwIO $ ProcessException (show proc) exitCode err
+
 fixTreeGrepper :: G.Result -> G.Result
 fixTreeGrepper treeGrepperResult =
   treeGrepperResult {G.matches = G.merge treeGrepperResult.matches}
 
 getFiles :: IO [String]
 getFiles =
-  fmap (lines . LB8.unpack . snd) $
-    P.readProcessStdout "git ls-files --cached --exclude-standard --other"
+  fmap (lines . L8.unpack) $
+    sh "git ls-files --cached --exclude-standard --other"