diff options
| -rw-r--r-- | src/Main.hs | 102 |
1 files 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 |