From f4c9e4e1f3ed7248764018a912278fb067b9ee01 Mon Sep 17 00:00:00 2001 From: Veronika Romashkina Date: Sat, 4 Jul 2020 11:44:56 +0100 Subject: [PATCH] [#323] Add a JSON output format (#334) * [#323] Add a JSON output format Resolves #323 * Update CHANGELOG * Fix Stack build --- CHANGELOG.md | 3 +++ README.md | 3 +++ src/Stan.hs | 33 ++++++++++++++++++++------------- src/Stan/Analysis.hs | 19 ++++++++++++++++++- src/Stan/Cabal.hs | 14 ++++++++------ src/Stan/Category.hs | 3 ++- src/Stan/Cli.hs | 8 ++++++++ src/Stan/Core/Id.hs | 3 ++- src/Stan/Core/ModuleName.hs | 4 +++- src/Stan/FileInfo.hs | 11 +++++++++++ src/Stan/Inspection.hs | 11 +++++++++++ src/Stan/Observation.hs | 31 ++++++++++++++++++++++++------- src/Stan/Severity.hs | 4 ++++ src/Stan/Toml.hs | 6 +++--- stack.yaml | 3 ++- stan.cabal | 1 + test/Test/Stan/Analysis.hs | 2 +- 17 files changed, 124 insertions(+), 35 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 7ab0e3a2..ef1c1f3f 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -14,6 +14,9 @@ The change log is available [on GitHub][2]. Add GHC version to the `--version` output. * [#326](https://github.com/kowainik/stan/issues/326): Handle constraints before constructors in `STAN-0206`. +* [#323](https://github.com/kowainik/stan/issues/323): + Add `--json-output` option that output the results in machine readable JSON + format instead. Also all other printing is turned off then. ## 0.0.0.0 diff --git a/README.md b/README.md index d41ed8c8..60205421 100644 --- a/README.md +++ b/README.md @@ -371,6 +371,7 @@ for each run (similarly to the TOML configurations): categories or severities - Generate the HTML report file - Set up the output verbosity +- Choose to have machine readable JSON output instead Here is the high-level explanation of the available sub-commands: @@ -395,6 +396,7 @@ stan [--no-default] [-s|--short] [--hide-solution] + [--json-output] [-h|--help] [-v|--version] @@ -411,6 +413,7 @@ Description: --no-default Ignore local .stan.toml configuration file -s,--short Hide verbose output information for observations --hide-solution Hide verbose solution information for observations + --json-output Output the machine-readable output in JSON format instead -h,--help Show this help text -v,--version Show Stan's version diff --git a/src/Stan.hs b/src/Stan.hs index bc24fe3e..871e907b 100644 --- a/src/Stan.hs +++ b/src/Stan.hs @@ -14,6 +14,7 @@ module Stan ) where import Colourista (errorMessage, formatWith, infoMessage, italic, successMessage, warningMessage) +import Data.Aeson.Micro (encode) import System.Directory (doesFileExist, getCurrentDirectory) import System.Environment (getArgs) import System.FilePath (takeFileName) @@ -54,36 +55,42 @@ run = runStanCli >>= \case runStan :: StanArgs -> IO () runStan StanArgs{..} = do + let notJson = not stanArgsJsonOut -- ENV vars env@EnvVars{..} <- getEnvVars let defConfTrial = envVarsUseDefaultConfigFile <> stanArgsUseDefaultConfigFile - infoMessage "Checking environment variables and CLI arguments for default configurations file usage..." - putTextLn $ indent $ prettyTaggedTrial defConfTrial + when notJson $ do + infoMessage "Checking environment variables and CLI arguments for default configurations file usage..." + putTextLn $ indent $ prettyTaggedTrial defConfTrial let useDefConfig = maybe True snd (trialToMaybe defConfTrial) -- config - tomlConfig <- getTomlConfig useDefConfig stanArgsConfigFile + tomlConfig <- getTomlConfig notJson useDefConfig stanArgsConfigFile let configTrial = finaliseConfig $ defaultConfig <> tomlConfig <> stanArgsConfig - infoMessage "The following Configurations are used:\n" - putTextLn $ indent $ prettyTrialWith (toString . prettyConfigCli) configTrial + when notJson $ do + infoMessage "The following Configurations are used:\n" + putTextLn $ indent $ prettyTrialWith (toString . prettyConfigCli) configTrial whenResult_ configTrial $ \warnings config -> do hieFiles <- readHieFiles stanArgsHiedir -- create cabal default extensions map - cabalExtensionsMap <- createCabalExtensionsMap stanArgsCabalFilePath hieFiles + cabalExtensionsMap <- createCabalExtensionsMap notJson stanArgsCabalFilePath hieFiles -- get checks for each file let checksMap = applyConfig (map hie_hs_file hieFiles) config let analysis = runAnalysis cabalExtensionsMap checksMap (configIgnored config) hieFiles -- show what observations are ignored - putText $ indent $ prettyShowIgnoredObservations + when notJson $ putText $ indent $ prettyShowIgnoredObservations (configIgnored config) (analysisIgnoredObservations analysis) -- show the result let observations = analysisObservations analysis let isNullObs = null observations - if isNullObs - then successMessage "All clean! Stan did not find any observations at the moment." - else warningMessage "Stan found the following observations for the project:\n" - putTextLn $ prettyShowAnalysis analysis stanArgsOutputSettings + if notJson + then do + if isNullObs + then successMessage "All clean! Stan did not find any observations at the moment." + else warningMessage "Stan found the following observations for the project:\n" + putTextLn $ prettyShowAnalysis analysis stanArgsOutputSettings + else putLBSLn $ encode analysis -- report generation whenJust stanArgsReport $ \ReportArgs{..} -> do @@ -100,7 +107,7 @@ runStan StanArgs{..} = do , .. } generateReport analysis config warnings stanEnv ProjectInfo{..} - infoMessage "Report is generated here -> stan.html" + when notJson $ infoMessage "Report is generated here -> stan.html" when reportArgsBrowse $ openBrowser "stan.html" -- decide on exit status @@ -128,7 +135,7 @@ runInspection InspectionArgs{..} = case inspectionArgsId of runTomlToCli :: TomlToCliArgs -> IO () runTomlToCli TomlToCliArgs{..} = do let useDefConfig = isNothing tomlToCliArgsFilePath - partialConfig <- getTomlConfig useDefConfig tomlToCliArgsFilePath + partialConfig <- getTomlConfig True useDefConfig tomlToCliArgsFilePath case finaliseConfig partialConfig of Result _ res -> putTextLn $ configToCliCommand res fiasco -> do diff --git a/src/Stan/Analysis.hs b/src/Stan/Analysis.hs index fc78f888..791c86e1 100644 --- a/src/Stan/Analysis.hs +++ b/src/Stan/Analysis.hs @@ -11,8 +11,9 @@ module Stan.Analysis , runAnalysis ) where +import Data.Aeson.Micro (ToJSON (..), object, (.=)) import Extensions (ExtensionsError (..), OnOffExtension, ParsedExtensions (..), - SafeHaskellExtension, parseSourceWithPath) + SafeHaskellExtension, parseSourceWithPath, showOnOffExtension) import Relude.Extra.Lens (Lens', lens, over) import Stan.Analysis.Analyser (analysisByInspection) @@ -44,6 +45,22 @@ data Analysis = Analysis , analysisFileMap :: !FileMap } deriving stock (Show) +instance ToJSON Analysis where + toJSON Analysis{..} = object + [ "modulesNum" .= analysisModulesNum + , "linesOfCode" .= analysisLinesOfCode + , "usedExtensions" .= + let (ext, safeExt) = analysisUsedExtensions + in map showOnOffExtension (toList ext) + <> map (show @Text) (toList safeExt) + , "inspections" .= toList analysisInspections + , "observations" .= toJsonObs analysisObservations + , "ignoredObservations" .= toJsonObs analysisIgnoredObservations + , "fileMap" .= map (first toText) (Map.toList analysisFileMap) + ] + where + toJsonObs = toList . S.sortOn observationLoc + modulesNumL :: Lens' Analysis Int modulesNumL = lens analysisModulesNum diff --git a/src/Stan/Cabal.hs b/src/Stan/Cabal.hs index fb545d91..d3350e93 100644 --- a/src/Stan/Cabal.hs +++ b/src/Stan/Cabal.hs @@ -42,17 +42,19 @@ usedCabalFiles fs = do (that are in .cabal file) to the resulting parsed extensions for each. -} createCabalExtensionsMap - :: [FilePath] -- ^ @.cabal@ files + :: Bool -- ^ Do print into terminal? + -> [FilePath] -- ^ @.cabal@ files -> [HieFile] -> IO (Map FilePath (Either ExtensionsError ParsedExtensions)) -createCabalExtensionsMap cabalPath hies = case cabalPath of +createCabalExtensionsMap isLoud cabalPath hies = case cabalPath of -- if cabal files are not specified via CLI option -- try to find cabal files in current directory [] -> findCabalFiles >>= \case -- if cabal file is not found, pass the empty map instead [] -> do - warningMessage ".cabal file not found in the current directory." - infoMessage " 💡 Try using --cabal-file-path option to specify the path to the .cabal file.\n" + when isLoud $ do + warningMessage ".cabal file not found in the current directory." + infoMessage " 💡 Try using --cabal-file-path option to specify the path to the .cabal file.\n" pure mempty -- else concat map for each @.cabal@ file. cabals -> mconcat <$> mapM getExtensionsWithCabal cabals @@ -66,7 +68,7 @@ createCabalExtensionsMap cabalPath hies = case cabalPath of :: FilePath -> IO (Map FilePath (Either ExtensionsError ParsedExtensions)) getExtensionsWithCabal cabal = do - infoMessage $ "Using the following .cabal file: " <> toText cabal <> "\n" + when isLoud $ infoMessage $ "Using the following .cabal file: " <> toText cabal <> "\n" (Right <<$>> parseCabalFileExtensions cabal) `catch` handleCabalErr where @@ -74,7 +76,7 @@ createCabalExtensionsMap cabalPath hies = case cabalPath of :: CabalException -> IO (Map FilePath (Either ExtensionsError ParsedExtensions)) handleCabalErr err = do - errorMessage "Error when parsing cabal file. Stan will continue without information from .cabal file" + when isLoud $ errorMessage "Error when parsing cabal file. Stan will continue without information from .cabal file" pure $ Map.fromList $ map (toSnd (const $ Left $ CabalError err) . hie_hs_file) hies diff --git a/src/Stan/Category.hs b/src/Stan/Category.hs index a1ee5ac3..461fc0af 100644 --- a/src/Stan/Category.hs +++ b/src/Stan/Category.hs @@ -25,12 +25,13 @@ module Stan.Category ) where import Colourista (formatWith, magentaBg) +import Data.Aeson.Micro (ToJSON) -- | A type of the inspection. newtype Category = Category { unCategory :: Text - } deriving newtype (Show, Eq, Hashable) + } deriving newtype (Show, Eq, Hashable, ToJSON) -- | Show 'Category' in a human-friendly format. prettyShowCategory :: Category -> Text diff --git a/src/Stan/Cli.hs b/src/Stan/Cli.hs index bdf07e72..4474170f 100644 --- a/src/Stan/Cli.hs +++ b/src/Stan/Cli.hs @@ -60,6 +60,7 @@ data StanArgs = StanArgs , stanArgsUseDefaultConfigFile :: !(TaggedTrial Text Bool) -- ^ Use default @.stan.toml@ file , stanArgsConfigFile :: !(Maybe FilePath) -- ^ Path to a custom configurations file. , stanArgsConfig :: !PartialConfig + , stanArgsJsonOut :: !Bool -- ^ Output the machine-readable output in JSON format instead. } newtype ReportArgs = ReportArgs @@ -120,6 +121,7 @@ stanP = do stanArgsConfigFile <- configFileP stanArgsUseDefaultConfigFile <- useDefaultConfigFileP stanArgsOutputSettings <- outputSettingsP + stanArgsJsonOut <- jsonOutputP pure $ Stan StanArgs{..} -- | @stan inspection@ command parser. @@ -202,6 +204,12 @@ useDefaultConfigFileP = taggedTrialParser "no-default" $ flag' False $ mconcat , help "Ignore local .stan.toml configuration file" ] +jsonOutputP :: Parser Bool +jsonOutputP = switch $ mconcat + [ long "json-output" + , help "Output the machine-readable output in JSON format instead" + ] + reportP :: Parser (Maybe ReportArgs) reportP = optional $ hsubparser diff --git a/src/Stan/Core/Id.hs b/src/Stan/Core/Id.hs index 4e3f05c5..306ad133 100644 --- a/src/Stan/Core/Id.hs +++ b/src/Stan/Core/Id.hs @@ -19,6 +19,7 @@ module Stan.Core.Id , castId ) where +import Data.Aeson.Micro (ToJSON) import Data.Type.Equality (type (==)) @@ -28,7 +29,7 @@ structures by using a phantom parameter. newtype Id a = Id { unId :: Text } deriving stock (Show) - deriving newtype (Eq, Ord, Hashable) + deriving newtype (Eq, Ord, Hashable, ToJSON) {- | A type alias for the situations when we don't care about the parameter of 'Id' but don't want to deal with type variables. diff --git a/src/Stan/Core/ModuleName.hs b/src/Stan/Core/ModuleName.hs index ea3e740b..904bbf7e 100644 --- a/src/Stan/Core/ModuleName.hs +++ b/src/Stan/Core/ModuleName.hs @@ -13,6 +13,8 @@ module Stan.Core.ModuleName , fromGhcModuleName ) where +import Data.Aeson.Micro (ToJSON) + import qualified Stan.Ghc.Compat as Ghc @@ -20,7 +22,7 @@ import qualified Stan.Ghc.Compat as Ghc newtype ModuleName = ModuleName { unModuleName :: Text } deriving stock (Show) - deriving newtype (Eq, Hashable, IsString) + deriving newtype (Eq, Hashable, IsString, ToJSON) -- | Convert 'GHC.ModuleName' to 'ModuleName'. fromGhcModuleName :: Ghc.ModuleName -> ModuleName diff --git a/src/Stan/FileInfo.hs b/src/Stan/FileInfo.hs index 5f4d347e..23f1f715 100644 --- a/src/Stan/FileInfo.hs +++ b/src/Stan/FileInfo.hs @@ -14,6 +14,7 @@ module Stan.FileInfo , isExtensionDisabled ) where +import Data.Aeson.Micro (ToJSON (..), object, (.=)) import Extensions (Extensions (..), ExtensionsError, ExtensionsResult, OnOffExtension (..), ParsedExtensions (..), showOnOffExtension) import GHC.LanguageExtensions.Type (Extension) @@ -35,6 +36,16 @@ data FileInfo = FileInfo , fileInfoObservations :: !Observations } deriving stock (Show, Eq) +instance ToJSON FileInfo where + toJSON FileInfo{..} = object + [ "path" .= toText fileInfoPath + , "moduleName" .= fileInfoModuleName + , "loc" .= fileInfoLoc + , "cabalExtensions" .= extensionsToText fileInfoCabalExtensions + , "extensions" .= extensionsToText fileInfoExtensions + , "observations" .= toList fileInfoObservations + ] + type FileMap = Map FilePath FileInfo -- | Return the list of pretty-printed extensions. diff --git a/src/Stan/Inspection.hs b/src/Stan/Inspection.hs index c6a1e90d..23ece92d 100644 --- a/src/Stan/Inspection.hs +++ b/src/Stan/Inspection.hs @@ -32,6 +32,7 @@ import Relude.Extra.Lens (Lens', lens) import Colourista (blue, bold, formatWith, green) import Colourista.Short (b, i) +import Data.Aeson.Micro (ToJSON (..), object, (.=)) import Stan.Category (Category (..), prettyShowCategory) import Stan.Core.Id (Id (..)) @@ -55,6 +56,16 @@ data Inspection = Inspection , inspectionAnalysis :: !InspectionAnalysis } deriving stock (Show, Eq) +instance ToJSON Inspection where + toJSON Inspection{..} = object + [ "id" .= inspectionId + , "name" .= inspectionName + , "description" .= inspectionDescription + , "solution" .= inspectionSolution + , "category" .= toList inspectionCategory + , "severity" .= inspectionSeverity + ] + descriptionL :: Lens' Inspection Text descriptionL = lens inspectionDescription diff --git a/src/Stan/Observation.hs b/src/Stan/Observation.hs index b69b2b9f..d88329e6 100644 --- a/src/Stan/Observation.hs +++ b/src/Stan/Observation.hs @@ -24,6 +24,7 @@ module Stan.Observation import Colourista (blue, bold, formatWith, green, italic, reset, yellow) import Colourista.Short (b, i) +import Data.Aeson.Micro (ToJSON (..), object, (.=)) import Data.List (partition) import Slist (Slist) @@ -58,6 +59,15 @@ data Observation = Observation , observationFileContent :: !ByteString } deriving stock (Show, Eq) +instance ToJSON Observation where + toJSON Observation{..} = object + [ "id" .= observationId + , "inspectionId" .= observationInspectionId + , "loc" .= showSpan observationLoc + , "file" .= toText observationFile + , "moduleName" .= observationModuleName + ] + -- | Type alias for the sized list of 'Observation's. type Observations = Slist Observation @@ -98,13 +108,6 @@ prettyShowObservation OutputSettings{..} o@Observation{..} = case outputSettings <> " — " <> inspectionName inspection - showSpan :: RealSrcSpan -> Text - showSpan s = show (srcSpanFile s) - <> "(" <> show (srcSpanStartLine s) - <> ":" <> show (srcSpanStartCol s) - <> "-" <> show (srcSpanEndLine s) - <> ":" <> show (srcSpanEndCol s) - <> ")" observationTable :: [Text] observationTable = @@ -170,6 +173,20 @@ prettyObservationSource isColour Observation{..} = start = srcSpanStartCol observationLoc - 1 arrow = srcSpanEndCol observationLoc - start - 1 +{- | Show 'RealSrcSpan' in the following format: + +@ +filename.ext(11:12-13:14) +@ +-} +showSpan :: RealSrcSpan -> Text +showSpan s = show (srcSpanFile s) + <> "(" <> show (srcSpanStartLine s) + <> ":" <> show (srcSpanStartCol s) + <> "-" <> show (srcSpanEndLine s) + <> ":" <> show (srcSpanEndCol s) + <> ")" + {- | Checkes the predicate on colourfulness and returns an empty text when the colouroing is disabled. -} diff --git a/src/Stan/Severity.hs b/src/Stan/Severity.hs index af69caf8..51b0a4c6 100644 --- a/src/Stan/Severity.hs +++ b/src/Stan/Severity.hs @@ -17,6 +17,7 @@ module Stan.Severity ) where import Colourista (blue, bold, cyan, formatWith, magenta, red, yellow) +import Data.Aeson.Micro (ToJSON (..)) {- | Severity level of the inspection. @@ -49,6 +50,9 @@ data Severity | Error deriving stock (Show, Read, Eq, Ord, Enum, Bounded) +instance ToJSON Severity where + toJSON = toJSON . show @Text + -- | Description of each 'Severity' level. severityDescription :: Severity -> Text severityDescription = \case diff --git a/src/Stan/Toml.hs b/src/Stan/Toml.hs index 5545b08a..4d646d8a 100644 --- a/src/Stan/Toml.hs +++ b/src/Stan/Toml.hs @@ -55,8 +55,8 @@ usedTomlFiles useDefault mFile = do memptyIfNotExist :: FilePath -> IO [FilePath] memptyIfNotExist fp = ifM (doesFileExist fp) (pure [fp]) (pure []) -getTomlConfig :: Bool -> Maybe FilePath -> IO PartialConfig -getTomlConfig useDefault mTomlFile = do +getTomlConfig :: Bool -> Bool -> Maybe FilePath -> IO PartialConfig +getTomlConfig isLoud useDefault mTomlFile = do def <- if useDefault then defaultCurConfigFile >>= readToml >>= \case @@ -74,7 +74,7 @@ getTomlConfig useDefault mTomlFile = do isFile <- doesFileExist file if isFile then do - infoMessage $ "Reading Configurations from " <> toText file <> " ..." + when isLoud $ infoMessage $ "Reading Configurations from " <> toText file <> " ..." pure <$> Toml.decodeFile configCodec file else pure $ fiasco $ "TOML Configurations file doesn't exist: " <> toText file diff --git a/stack.yaml b/stack.yaml index 824e0a11..0a47ede0 100644 --- a/stack.yaml +++ b/stack.yaml @@ -3,6 +3,7 @@ resolver: lts-16.1 extra-deps: - dir-traverse-0.2.2.3 - extensions-0.0.0.1 +- microaeson-0.1.0.0 - trial-0.0.0.0 - trial-optparse-applicative-0.0.0.0 -- trial-tomland-0.0.0.0 \ No newline at end of file +- trial-tomland-0.0.0.0 diff --git a/stan.cabal b/stan.cabal index 587fbe3a..98f1aaa8 100644 --- a/stan.cabal +++ b/stan.cabal @@ -138,6 +138,7 @@ library , ghc >= 8.8 && < 8.11 , ghc-boot-th >= 8.8 && < 8.11 , gitrev ^>= 1.3.1 + , microaeson ^>= 0.1.0.0 , optparse-applicative ^>= 0.15 , pretty-simple ^>= 3.2 , process ^>= 1.6.8.0 diff --git a/test/Test/Stan/Analysis.hs b/test/Test/Stan/Analysis.hs index 8dfd0d9e..e707a8d7 100644 --- a/test/Test/Stan/Analysis.hs +++ b/test/Test/Stan/Analysis.hs @@ -21,7 +21,7 @@ import qualified Data.Set as Set analysisSpec :: [HieFile] -> Spec analysisSpec hieFiles = describe "Static Analysis" $ do - extensionsMap <- runIO $ createCabalExtensionsMap ["stan.cabal"] hieFiles + extensionsMap <- runIO $ createCabalExtensionsMap True ["stan.cabal"] hieFiles let checksMap = mkDefaultChecks (map hie_hs_file hieFiles) -- tests without ignorance