robocop

commit db7110fec5bcfb2e279c346e111b2b20601ea67a
parent 53ec32cf745a27c4b6a91da79c7774e57b9e3400
Author: Christian Grothoff <christian@grothoff.org>
Date:   Thu,  5 Jun 2025 11:57:47 +0200

exit with non-zero exit status on failures

Diffstat:
M
app/Main.hs
 | 
11
++++++++---

1 file changed, 8 insertions(+), 3 deletions(-)
diff --git a/app/Main.hs b/app/Main.hs
@@ -26,6 +26,7 @@ import Options.Applicative (execParser)
 
 import System.Directory
 import System.FilePath
+import System.Exit
 import System.IO
 
 import Toml (decodeFile)
@@ -43,7 +44,9 @@ readJSON config sanction_list = do
   else do
           line <- getLine
           case (eitherDecode . encodeUtf8 . TL.pack) line of
-            Left err    -> hPutStrLn stderr $ "Failed to decode JSON (" ++ show err ++ ")"
+            Left err    -> do
+                    hPutStrLn stderr $ "Failed to decode JSON input (" ++ show err ++ ")"
+                    exitWith (ExitFailure 1)
             Right entry -> do
                     case entry of
                              NP person -> printScores $ checkPersons config (individuals sanction_list) person
@@ -71,7 +74,9 @@ main = do
   let v = verbosity config
 
   case valid_config of
-    False -> return ()
+    False -> do
+                hPutStrLn stderr $ "Invalid configuration"
+                exitWith (ExitFailure 1)
     True  -> do start <- getCurrentTime
                 when (v > Silent) $ hPutStrLn stderr $ "Starting at " ++ show start
 
@@ -80,7 +85,7 @@ main = do
                 case sanction_list of
                   Left err  -> do curr_dir <- getCurrentDirectory
                                   _ <- handleError v $ Left $ Robocop_InvalidXML (T.pack $ curr_dir </> ssl_location config) (show err)
-                                  return ()
+                                  exitWith (ExitFailure 1)
                   Right xml -> do let tgts = xmlToSSL xml
                                   case start_date tgts of
                                     Just age -> hPutStrLn stderr $ "Seconds since epoch: " ++ (show (floor $ diffUTCTime start (UTCTime age 0) :: Int))