diff options
Diffstat (limited to '')
| -rw-r--r-- | src/Main.hs | 30 |
1 files changed, 13 insertions, 17 deletions
diff --git a/src/Main.hs b/src/Main.hs index f0a6c09..bf39564 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -7,18 +7,15 @@ module Main where -import Control.Monad (unless, when) -import Control.Monad.Identity (Identity) +import Universum + import Data.Aeson (eitherDecode, encode) import Data.Aeson.Encode.Pretty (encodePretty) import Data.Aeson.KeyMap (coercionToHashMap) import qualified Data.ByteString.Lazy as LB -import Data.Maybe (fromMaybe) import qualified Data.Text.Encoding as T import qualified Data.Text.IO as T -import System.Exit (ExitCode (..), exitWith) -import System.IO (hPutStrLn, stderr) -import WithCli (Generic, HasArguments, withCli) +import WithCli (HasArguments, withCli) import CheckDir (recursiveCheckDir, resultIsFatal, DirResult (dirresultGraph)) import Control.Monad (when) @@ -28,6 +25,7 @@ import Util (printPretty) import WriteRepo (writeAdjustedRepository) import Text.Dot (showDot) +import System.Exit (ExitCode (ExitFailure, ExitSuccess)) import qualified Version as V (version) -- | the options this cli tool can take @@ -62,7 +60,7 @@ run options = do when (version options) $ do putStrLn V.version - exitWith ExitSuccess + exitSuccess let repo = fromMaybe "." (repository options) let entry = fromMaybe "main.json" (entrypoint options) @@ -72,7 +70,7 @@ run options = do Nothing -> error "Need a config file!" Just path -> LB.readFile path >>= \res -> case eitherDecode res :: Either String (LintConfig Identity) of - Left err -> error $ "config file invalid: " <> err + Left err -> error $ "config file invalid: " <> toText err Right file -> pure (patchConfig file (config options)) lints <- recursiveCheckDir lintconfig repo entry @@ -85,16 +83,14 @@ run options = do | otherwise -> printPretty (level, lints) case out options of - Nothing -> exitWith $ case resultIsFatal lintconfig lints of - False -> ExitSuccess - True -> ExitFailure 1 + Nothing -> exitWith $ if resultIsFatal lintconfig lints then ExitFailure 1 else ExitSuccess Just outpath -> do c <- writeAdjustedRepository lintconfig repo outpath lints unless (json options) $ case c of - ExitFailure 1 -> putStrLn "\nMap failed linting!" - ExitFailure 2 -> putStrLn "\nOutpath already exists, not writing anything." - _ -> pure () + ExitFailure 1 -> putTextLn "\nMap failed linting!" + ExitFailure 2 -> putTextLn "\nOutpath already exists, not writing anything." + _ -> pass exitWith c @@ -113,10 +109,10 @@ printLB a = T.putStrLn $ T.decodeUtf8 $ LB.toStrict a aesonWarning :: IO () aesonWarning = case coercionToHashMap of Just _ -> hPutStrLn stderr - "Warning: this program was compiled using an older version of the Aeson Library\n\ + ("Warning: this program was compiled using an older version of the Aeson Library\n\ \used for parsing JSON, which is susceptible to hash flooding attacks.\n\ \n\ \Recompiling with a newer version is recommended when handling untrusted inputs.\n\ \n\ - \See https://cs-syd.eu/posts/2021-09-11-json-vulnerability for details." - _ -> pure () + \See https://cs-syd.eu/posts/2021-09-11-json-vulnerability for details." :: Text) + _ -> pass |