From 11417fc194673decbfcb6e8b7e3da0af203feff1 Mon Sep 17 00:00:00 2001
From: stuebinm
Date: Sun, 6 Mar 2022 16:21:24 +0100
Subject: walint: some marginally nicer code

---
 src/Main.hs | 102 ++++++++++++++++++++++++++++--------------------------------
 1 file changed, 47 insertions(+), 55 deletions(-)

diff --git a/src/Main.hs b/src/Main.hs
index bf39564..b2002bf 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -1,32 +1,28 @@
-{-# LANGUAGE DeriveAnyClass    #-}
-{-# LANGUAGE DeriveGeneric     #-}
-{-# LANGUAGE LambdaCase        #-}
-{-# LANGUAGE NamedFieldPuns    #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE MultiWayIf #-}
+{-# LANGUAGE DeriveAnyClass      #-}
+{-# LANGUAGE DeriveGeneric       #-}
+{-# LANGUAGE LambdaCase          #-}
+{-# LANGUAGE NamedFieldPuns      #-}
+{-# LANGUAGE OverloadedStrings   #-}
+{-# LANGUAGE RecordWildCards     #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 
 module Main where
 
 import           Universum
 
-import           Data.Aeson               (eitherDecode, encode)
+import           Data.Aeson               (eitherDecodeFileStrict', encode)
 import           Data.Aeson.Encode.Pretty (encodePretty)
 import           Data.Aeson.KeyMap        (coercionToHashMap)
-import qualified Data.ByteString.Lazy     as LB
-import qualified Data.Text.Encoding       as T
-import qualified Data.Text.IO             as T
 import           WithCli                  (HasArguments, withCli)
 
 import           CheckDir                 (recursiveCheckDir, resultIsFatal, DirResult (dirresultGraph))
 import           Control.Monad            (when)
 import           LintConfig               (LintConfig (..), patchConfig)
+import           System.Exit              (ExitCode (ExitFailure))
 import           Types                    (Level (..))
 import           Util                     (printPretty)
-import           WriteRepo                (writeAdjustedRepository)
-import Text.Dot (showDot)
-
-import           System.Exit              (ExitCode (ExitFailure, ExitSuccess))
 import qualified Version                  as V (version)
+import           WriteRepo                (writeAdjustedRepository)
 
 -- | the options this cli tool can take
 data Options = Options
@@ -55,50 +51,46 @@ main :: IO ()
 main = withCli run
 
 run :: Options -> IO ()
-run options = do
+run Options { .. } = do
   aesonWarning
 
-  when (version options) $ do
+  if version then
     putStrLn V.version
-    exitSuccess
-
-  let repo = fromMaybe "." (repository options)
-  let entry = fromMaybe "main.json" (entrypoint options)
-  let level = fromMaybe Suggestion (lintlevel options)
-
-  lintconfig <- case configFile options of
-    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: " <> toText err
-        Right file -> pure (patchConfig file (config options))
-
-  lints <- recursiveCheckDir lintconfig repo entry
-
-  if | dot options ->
-       putStrLn (showDot $ dirresultGraph lints)
-     | json options ->
-       printLB
-        $ if pretty options then encodePretty lints else encode lints
-     | otherwise -> printPretty (level, lints)
-
-  case out options of
-    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 -> putTextLn "\nMap failed linting!"
-          ExitFailure 2 -> putTextLn "\nOutpath already exists, not writing anything."
-          _ -> pass
-      exitWith c
-
-
-
-
--- | haskell's many string types are FUN …
-printLB :: LB.ByteString -> IO ()
-printLB a = T.putStrLn $ T.decodeUtf8 $ LB.toStrict a
+  else do
+    let repo = fromMaybe "." repository
+    let entry = fromMaybe "main.json" entrypoint
+    let level = fromMaybe Suggestion lintlevel
+    configFile' <- case configFile of
+      Nothing -> do
+        hPutStrLn stderr ("option --config-file=FILEPATH required" :: Text)
+        exitFailure
+      Just path -> pure path
+
+    lintconfig <- eitherDecodeFileStrict' configFile' >>= \case
+      Left  err  -> error $ "config file invalid: " <> toText err
+      Right file -> pure (patchConfig file config)
+
+    lints <- recursiveCheckDir lintconfig repo entry
+
+    if json
+      then putText
+      $ decodeUtf8 (if pretty then encodePretty lints else encode lints)
+      else printPretty (level, lints)
+
+    case out of
+      Nothing
+        | resultIsFatal lintconfig lints -> exitWith (ExitFailure 1)
+        | otherwise -> exitSuccess
+      Just outpath -> do
+        c <- writeAdjustedRepository lintconfig repo outpath lints
+        unless json $
+          case c of
+            ExitFailure 1 ->
+              putTextLn "\nMap failed linting!"
+            ExitFailure 2 ->
+              putTextLn "\nOutpath already exists, not writing anything."
+            _ -> pass
+        exitWith c
 
 
 -- if Aesons's internal map and HashMap are the same type, then coercionToHashMap
-- 
cgit v1.2.3