[kowainik#467] Add SARIF support

src/Stan.hs

@@ -38,6 +38,7 @@ import Stan.Inspection (Inspection (..), inspectionsMd, prettyShowInspection,
 import Stan.Inspection.All (getInspectionById, inspections, lookupInspectionById)
 import Stan.Observation (Observation (..), prettyShowIgnoredObservations)
 import Stan.Report (generateReport)
+import Stan.SARIF (toSARIF)
 import Stan.Severity (Severity (Error))
 import Stan.Toml (configCodec, getTomlConfig, usedTomlFiles)
 
@@ -55,6 +56,7 @@ run = runStanCli >>= \case
 runStan :: StanArgs -> IO ()
 runStan StanArgs{..} = do
     let notJson = not stanArgsJsonOut
+               && not stanArgsSARIF
     -- ENV vars
     env@EnvVars{..} <- getEnvVars
     let defConfTrial = envVarsUseDefaultConfigFile <> stanArgsUseDefaultConfigFile
@@ -89,7 +91,10 @@ runStan StanArgs{..} = do
             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
+        else
+            if stanArgsSARIF
+            then putLBSLn $ toSARIF analysis
+            else putLBSLn $ encode analysis
 
         -- report generation
         whenJust stanArgsReport $ \ReportArgs{..} -> do

src/Stan/Cli.hs

@@ -61,6 +61,7 @@ data StanArgs = StanArgs
     , stanArgsConfigFile           :: !(Maybe FilePath)  -- ^ Path to a custom configurations file.
     , stanArgsConfig               :: !PartialConfig
     , stanArgsJsonOut              :: !Bool  -- ^ Output the machine-readable output in JSON format instead.
+    , stanArgsSARIF                :: !Bool -- ^ Output the results as a SARIF file.
     }
 
 newtype ReportArgs = ReportArgs
@@ -122,6 +123,7 @@ stanP = do
     stanArgsUseDefaultConfigFile <- useDefaultConfigFileP
     stanArgsOutputSettings <- outputSettingsP
     stanArgsJsonOut <- jsonOutputP
+    stanArgsSARIF <- sarifOutputP
     pure $ Stan StanArgs{..}
 
 -- | @stan inspection@ command parser.
@@ -210,6 +212,12 @@ jsonOutputP = switch $ mconcat
     , help "Output the machine-readable output in JSON format instead"
     ]
 
+sarifOutputP :: Parser Bool
+sarifOutputP = switch $ mconcat
+    [ long "sarif"
+    , help "Output the results as a SARIF file"
+    ]
+
 reportP :: Parser (Maybe ReportArgs)
 reportP = optional
     $  hsubparser

src/Stan/SARIF.hs

@@ -0,0 +1,127 @@
+{- |
+Copyright: (c) 2020 Kowainik
+SPDX-License-Identifier: MPL-2.0
+Maintainer: Kowainik <[email protected]>
+
+Provides functions to convert @Stan@'s data types to equivalent SARIF ones.
+-}
+
+module Stan.SARIF
+    ( toSARIF
+    ) where
+
+import qualified Data.ByteString.Lazy as LBS
+import qualified Data.Map.Lazy as Map
+import Data.SARIF as SARIF
+import qualified Data.Text as T
+import Data.Version (showVersion)
+
+import Paths_stan (version)
+import Stan.Analysis (Analysis (..))
+import Stan.Core.Id
+import Stan.FileInfo
+import Stan.Ghc.Compat
+import Stan.Inspection
+import Stan.Inspection.All (inspections)
+import Stan.Observation
+import Stan.Severity as Stan
+
+-- | Represents @Stan@ as a `SARIF.Tool` value.
+stanTool :: SARIF.Tool
+stanTool = MkTool{
+    toolDriver = defaultToolComponent{
+        toolComponentName = Just "Stan",
+        -- Haskell versions aren't valid semver versions
+        toolComponentVersion = Just $ T.pack $ showVersion version,
+        toolComponentInformationUri = Just "https://github.com/kowainik/stan/",
+        toolComponentRules = Map.elems reportingDescriptors
+    },
+    toolExtensions = []
+}
+
+-- | `fileMapToArtifacts` @fileMap@ converts @fileMap@ to a list of
+-- `SARIF.Artifact` values.
+fileMapToArtifacts :: FileMap -> [SARIF.Artifact]
+fileMapToArtifacts fm = map toArtifact $ Map.keys fm
+    where toArtifact fp = MkArtifact{
+                artifactLocation = MkArtifactLocation{
+                    artifactLocationUri = T.pack fp
+                },
+                artifactMimeType = Nothing
+            }
+
+-- | `toLevel` @severity@ converts a @Stan@ `Severity` to a SARIF `Level`.
+toLevel :: Severity -> Level
+toLevel Style        = Note
+toLevel Performance  = SARIF.Warning
+toLevel PotentialBug = SARIF.Warning
+toLevel Stan.Warning = SARIF.Warning
+toLevel Stan.Error   = SARIF.Error
+
+-- | `toReportingDescriptor` @inspection@ converts @inspection@ to
+-- a `SARIF.ReportingDescriptor`.
+toReportingDescriptor :: Inspection -> SARIF.ReportingDescriptor
+toReportingDescriptor Inspection{..} =
+    (defaultReportingDescriptor $ unId inspectionId){
+        rdName = Nothing,
+        rdShortDescription = Just $
+            defaultMultiformatMessageString inspectionName,
+        rdFullDescription = Just $
+            defaultMultiformatMessageString inspectionDescription,
+        -- TODO: make this useful
+        rdHelpUri = Just "https://github.com/kowainik/stan/",
+        rdHelp = Just $
+            defaultMultiformatMessageString (T.unlines inspectionSolution),
+        rdDefaultConfiguration = Just $ defaultReportingConfiguration{
+            rcLevel = Just $ toLevel inspectionSeverity
+        } -- ,
+        -- tricky, because Stan isn't currently using aeson
+        -- rdProperties = Map.singleton "tags" $ _ $ map (toJSON . _) inspectionCategory
+    }
+
+-- | `reportingDescriptors` is a `Map.Map` of `SARIF.ReportingDescriptor` which
+-- correspond to @Stan@ `Inspection`s, indexed by their Id.
+reportingDescriptors :: Map.Map Text SARIF.ReportingDescriptor
+reportingDescriptors = Map.fromList
+    [ (rdId rd, rd) | rd <- map toReportingDescriptor inspections ]
+
+-- | `observationToResult` @observation@ converts an @observation@ to
+-- a `SARIF.Result`.
+observationToResult :: Observation -> SARIF.Result
+observationToResult Observation{..} =
+    let mrd = Map.lookup (unId observationInspectionId) reportingDescriptors
+    in MkResult{
+        resultRuleId = unId observationInspectionId,
+        resultLevel = Nothing,
+        resultMessage = defaultMultiformatMessageString $
+            fromMaybe "A problem was detected here." $
+                mrd >>= fmap mmsText . rdFullDescription,
+        resultLocations = [
+            MkLocation{
+                locationPhysicalLocation = Just MkPhysicalLocation{
+                    physicalLocationArtifactLocation = MkArtifactLocation{
+                        artifactLocationUri = T.pack observationFile
+                    },
+                    physicalLocationRegion = MkRegion{
+                        regionStartLine = srcSpanStartLine observationSrcSpan,
+                        regionStartColumn = srcSpanStartCol observationSrcSpan,
+                        regionEndLine = srcSpanEndLine observationSrcSpan,
+                        regionEndColumn = srcSpanEndCol observationSrcSpan
+                    }
+                }
+            }
+        ]
+    }
+
+-- | `toSARIF` @analysis@ converts an @analysis@ to a SARIF log and encodes it
+-- as JSON which is returned as a `LBS.ByteString`.
+toSARIF :: Analysis -> LBS.ByteString
+toSARIF Analysis{..} = encodeSarifAsLBS $ defaultLog{
+    logRuns = [
+        MkRun{
+            runTool = stanTool,
+            runArtifacts = fileMapToArtifacts analysisFileMap,
+            runResults = map observationToResult $ toList analysisObservations
+        }
+    ]
+}

stack.yaml

@@ -1,6 +1,8 @@
 resolver: lts-18.18
 
 extra-deps:
+- git: https://github.com/mbg/sarif.git
+  commit: 08d1a9878de944b8de0a67dc4cf0f0634b23fd08
 - colourista-0.1.0.1
 - dir-traverse-0.2.2.3
 - dlist-0.8.0.8

stan.cabal

@@ -110,6 +110,7 @@ library
                            Stan.Report.Css
                            Stan.Report.Html
                            Stan.Report.Settings
+                         Stan.SARIF
                          Stan.Severity
                          Stan.Toml
 
@@ -134,6 +135,7 @@ library
                      , optparse-applicative >= 0.15 && < 0.17
                      , pretty-simple ^>= 4.0
                      , process ^>= 1.6.8.0
+                     , sarif ^>= 0.1
                      , slist ^>= 0.1
                      , tomland ^>= 1.3.0.0
                      , trial ^>= 0.0.0.0