[mrkkrp#323] Add a JSON output format (mrkkrp#334)

* [mrkkrp#323] Add a JSON output format

Resolves mrkkrp#323

* Update CHANGELOG

* Fix Stack build

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
 

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
 

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

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

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,15 +68,15 @@ 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
  handleCabalErr
  :: 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
 

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

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

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.

src/Stan/Core/ModuleName.hs

@@ -13,14 +13,16 @@ module Stan.Core.ModuleName
  , fromGhcModuleName
  ) where
 
+import Data.Aeson.Micro (ToJSON)
+
 import qualified Stan.Ghc.Compat as Ghc
 
 
 -- | Wrapper around Haskell module name.
 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

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.

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

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.
 -}

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