{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}

{- |
Description: Formats hlint ideas in the Statis Analysis Results Interchange Format (SARIF).
License: BSD-3-Clause

Supports the conversion of a list of HLint 'Idea's into SARIF.

SARIF (Static Analysis Results Interchange Format) is an open interchange format
for storing results from static analyses.
-}
module SARIF ( printIdeas
             , showIdeas
             , toJSONEncoding
             -- * See also
             --
             -- $references
             ) where

import Data.Aeson hiding (Error)
import Data.Aeson.Encoding
import Data.ByteString.Lazy (ByteString)
import Data.ByteString.Lazy qualified as B
import Data.Text.Lazy (Text)
import Data.Version (showVersion)
import GHC.Util
import Idea
import Paths_hlint (version)

-- | Print the given ideas to standard output.
--
-- For example:
--
-- >>> hlint ["src"] >>= printIdeas
--
-- For printing ideas in SARIF without dependent modules
-- having to import "Data.Aeson" or "Data.ByteString.Lazy".
printIdeas :: [Idea] -> IO ()
printIdeas :: [Idea] -> IO ()
printIdeas = ByteString -> IO ()
B.putStr (ByteString -> IO ()) -> ([Idea] -> ByteString) -> [Idea] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Idea] -> ByteString
showIdeas

-- | Format the given ideas in SARIF.
--
-- For converting ideas to SARIF without dependent modules
-- having to import "Data.Aeson".
showIdeas :: [Idea] -> ByteString
showIdeas :: [Idea] -> ByteString
showIdeas = Encoding' Value -> ByteString
forall a. Encoding' a -> ByteString
encodingToLazyByteString (Encoding' Value -> ByteString)
-> ([Idea] -> Encoding' Value) -> [Idea] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Idea] -> Encoding' Value
toJSONEncoding

-- | Converts the given ideas to a "Data.Aeson" encoding in SARIF.
toJSONEncoding :: [Idea] -> Encoding
toJSONEncoding :: [Idea] -> Encoding' Value
toJSONEncoding = Series -> Encoding' Value
pairs (Series -> Encoding' Value)
-> ([Idea] -> Series) -> [Idea] -> Encoding' Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Idea] -> Series
sarif

-- | Converts the given object to a top-level @sarifLog@ object.
--
-- See section 3.13 "sarifLog object", SARIF specification.
sarif :: [Idea] -> Series
sarif :: [Idea] -> Series
sarif [Idea]
ideas =
  Key -> Encoding' Value -> Series
pair Key
"version" (Text -> Encoding' Value
forall a. Text -> Encoding' a
lazyText Text
"2.1.0") Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<>
  Key -> Encoding' Value -> Series
pair Key
"$schema" (Text -> Encoding' Value
forall a. Text -> Encoding' a
lazyText Text
schemaURI) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<>
  Key -> Encoding' Value -> Series
pair Key
"runs" Encoding' Value
runs
  where runs :: Encoding' Value
runs = (Series -> Encoding' Value) -> [Series] -> Encoding' Value
forall a. (a -> Encoding' Value) -> [a] -> Encoding' Value
list Series -> Encoding' Value
pairs [ Key -> Encoding' Value -> Series
pair Key
"tool" (Series -> Encoding' Value
pairs Series
tool) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<>
                            Key -> Encoding' Value -> Series
pair Key
"results" ((Idea -> Encoding' Value) -> [Idea] -> Encoding' Value
forall a. (a -> Encoding' Value) -> [a] -> Encoding' Value
list (Series -> Encoding' Value
pairs (Series -> Encoding' Value)
-> (Idea -> Series) -> Idea -> Encoding' Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Idea -> Series
toResult) [Idea]
ideas) ]

-- | A @tool@ object describing what created the output.
--
-- Obviously, it will describe that HLint created the output.
--
-- See section 3.18 "tool object", SARIF specification.
tool :: Series
tool :: Series
tool = Key -> Encoding' Value -> Series
pair Key
"driver" (Encoding' Value -> Series) -> Encoding' Value -> Series
forall a b. (a -> b) -> a -> b
$ Series -> Encoding' Value
pairs (Series -> Encoding' Value) -> Series -> Encoding' Value
forall a b. (a -> b) -> a -> b
$
  Key -> Encoding' Value -> Series
pair Key
"name" (Text -> Encoding' Value
forall a. Text -> Encoding' a
lazyText Text
"hlint") Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<>
  Key -> Encoding' Value -> Series
pair Key
"version" (String -> Encoding' Value
forall a. String -> Encoding' a
string (String -> Encoding' Value) -> String -> Encoding' Value
forall a b. (a -> b) -> a -> b
$ Version -> String
showVersion Version
version) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<>
  Key -> Encoding' Value -> Series
pair Key
"informationUri" (Text -> Encoding' Value
forall a. Text -> Encoding' a
lazyText Text
hlintURI)

-- | Converts a given idea into a @result@ object.
--
-- It will describe the hint, the severity, suggestions for fixes, etc.
--
-- See section 3.27 "result object", SARIF specification.
toResult :: Idea -> Series
toResult :: Idea -> Series
toResult idea :: Idea
idea@Idea{String
[String]
[Refactoring SrcSpan]
[Note]
Maybe String
SrcSpan
Severity
ideaModule :: [String]
ideaDecl :: [String]
ideaSeverity :: Severity
ideaHint :: String
ideaSpan :: SrcSpan
ideaFrom :: String
ideaTo :: Maybe String
ideaNote :: [Note]
ideaRefactoring :: [Refactoring SrcSpan]
ideaModule :: Idea -> [String]
ideaDecl :: Idea -> [String]
ideaSeverity :: Idea -> Severity
ideaHint :: Idea -> String
ideaSpan :: Idea -> SrcSpan
ideaFrom :: Idea -> String
ideaTo :: Idea -> Maybe String
ideaNote :: Idea -> [Note]
ideaRefactoring :: Idea -> [Refactoring SrcSpan]
..} =
  Key -> Encoding' Value -> Series
pair Key
"message" (Series -> Encoding' Value
pairs (Series -> Encoding' Value) -> Series -> Encoding' Value
forall a b. (a -> b) -> a -> b
$ Key -> Encoding' Value -> Series
pair Key
"text" (Encoding' Value -> Series) -> Encoding' Value -> Series
forall a b. (a -> b) -> a -> b
$ String -> Encoding' Value
forall a. String -> Encoding' a
string (String -> Encoding' Value) -> String -> Encoding' Value
forall a b. (a -> b) -> a -> b
$ Idea -> String
forall a. Show a => a -> String
show Idea
idea) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<>
  Key -> Encoding' Value -> Series
pair Key
"level" (Text -> Encoding' Value
forall a. Text -> Encoding' a
lazyText (Text -> Encoding' Value) -> Text -> Encoding' Value
forall a b. (a -> b) -> a -> b
$ Severity -> Text
showSeverity Severity
ideaSeverity) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<>
  Key -> Encoding' Value -> Series
pair Key
"locations" ((Idea -> Encoding' Value) -> [Idea] -> Encoding' Value
forall a. (a -> Encoding' Value) -> [a] -> Encoding' Value
list (Series -> Encoding' Value
pairs (Series -> Encoding' Value)
-> (Idea -> Series) -> Idea -> Encoding' Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Idea -> Series
toLocation) [Idea
idea]) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<>
  Key -> Encoding' Value -> Series
pair Key
"fixes" ((Idea -> Encoding' Value) -> [Idea] -> Encoding' Value
forall a. (a -> Encoding' Value) -> [a] -> Encoding' Value
list (Series -> Encoding' Value
pairs (Series -> Encoding' Value)
-> (Idea -> Series) -> Idea -> Encoding' Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Idea -> Series
toFix) [Idea
idea]) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<>
  -- Use 'ideaHint' as the rule identifier.
  --
  -- "ruleId" is supposed to a stable, opaque identifier.
  -- 'ideaHint' is not opaque, nor is it quite guaranteed to be stable,
  -- but they will usually be stable enough, and disabling a hint is
  -- based on the name in 'ideaHint'.
  --
  -- Most importantly, there is no requirement that "ruleId"
  -- be a /unique/ identifier.
  Key -> Encoding' Value -> Series
pair Key
"ruleId" (String -> Encoding' Value
forall a. String -> Encoding' a
string String
ideaHint)

-- | Convert HLint severity to SARIF level.
--
-- See section 3.58.6 "level property", SARIF specification.
showSeverity :: Severity -> Text
showSeverity :: Severity -> Text
showSeverity Severity
Error = Text
"error"
showSeverity Severity
Warning = Text
"warning"
showSeverity Severity
Suggestion = Text
"note"
showSeverity Severity
Ignore = Text
"none"

-- | Converts the location information in a given idea to a @location@ object.
--
-- See section 3.28 "location object", SARIF specification.
toLocation :: Idea -> Series
toLocation :: Idea -> Series
toLocation idea :: Idea
idea@Idea{ideaSpan :: Idea -> SrcSpan
ideaSpan=SrcSpan{Int
String
srcSpanFilename :: String
srcSpanStartLine' :: Int
srcSpanStartColumn :: Int
srcSpanEndLine' :: Int
srcSpanEndColumn :: Int
srcSpanFilename :: SrcSpan -> String
srcSpanStartLine' :: SrcSpan -> Int
srcSpanStartColumn :: SrcSpan -> Int
srcSpanEndLine' :: SrcSpan -> Int
srcSpanEndColumn :: SrcSpan -> Int
..}, String
[String]
[Refactoring SrcSpan]
[Note]
Maybe String
Severity
ideaModule :: Idea -> [String]
ideaDecl :: Idea -> [String]
ideaSeverity :: Idea -> Severity
ideaHint :: Idea -> String
ideaFrom :: Idea -> String
ideaTo :: Idea -> Maybe String
ideaNote :: Idea -> [Note]
ideaRefactoring :: Idea -> [Refactoring SrcSpan]
ideaModule :: [String]
ideaDecl :: [String]
ideaSeverity :: Severity
ideaHint :: String
ideaFrom :: String
ideaTo :: Maybe String
ideaNote :: [Note]
ideaRefactoring :: [Refactoring SrcSpan]
..} =
  Series
physicalLocation Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> [String] -> [String] -> Series
logicalLocations [String]
ideaModule [String]
ideaDecl
  where physicalLocation :: Series
physicalLocation = Key -> Encoding' Value -> Series
pair Key
"physicalLocation" (Encoding' Value -> Series) -> Encoding' Value -> Series
forall a b. (a -> b) -> a -> b
$ Series -> Encoding' Value
pairs (Series -> Encoding' Value) -> Series -> Encoding' Value
forall a b. (a -> b) -> a -> b
$
          Key -> Encoding' Value -> Series
pair Key
"artifactLocation"
              (Series -> Encoding' Value
pairs (Series -> Encoding' Value) -> Series -> Encoding' Value
forall a b. (a -> b) -> a -> b
$ Key -> Encoding' Value -> Series
pair Key
"uri" (String -> Encoding' Value
forall a. String -> Encoding' a
string String
srcSpanFilename)) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<>
          Key -> Encoding' Value -> Series
pair Key
"region" (Series -> Encoding' Value
pairs (Series -> Encoding' Value) -> Series -> Encoding' Value
forall a b. (a -> b) -> a -> b
$ Idea -> Series
toRegion Idea
idea)

        logicalLocations :: [String] -> [String] -> Series
logicalLocations [String
mod] [String
decl] = Key -> Encoding' Value -> Series
pair Key
"logicalLocations" (Encoding' Value -> Series) -> Encoding' Value -> Series
forall a b. (a -> b) -> a -> b
$
          (Series -> Encoding' Value) -> [Series] -> Encoding' Value
forall a. (a -> Encoding' Value) -> [a] -> Encoding' Value
list Series -> Encoding' Value
pairs [ Key -> Encoding' Value -> Series
pair Key
"name" (String -> Encoding' Value
forall a. String -> Encoding' a
string String
decl) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<>
                       Key -> Encoding' Value -> Series
pair Key
"fullyQualifiedName" (String -> Encoding' Value
forall a. String -> Encoding' a
string (String -> Encoding' Value) -> String -> Encoding' Value
forall a b. (a -> b) -> a -> b
$ String
mod String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"." String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
decl) ]
          -- It would be nice to include whether it is a function or type
          -- in the "kind" field, but we do not have that information.

        -- If the lists are empty, then there is obviously no logical location.
        -- Logical location is still omitted when the lists are not singleton,
        -- because the associations between modules and declarations are
        -- not clear.
        logicalLocations [String]
_ [String]
_ = Series
forall a. Monoid a => a
mempty

-- | Converts a given idea to a @fix@ object.
--
-- It will suggest how code can be improved to deal with an issue.
-- This includes the file to be changed and how to change it.
--
-- See section 3.55 "fix object", SARIF specification.
toFix :: Idea -> Series
toFix :: Idea -> Series
toFix idea :: Idea
idea@Idea{String
[String]
[Refactoring SrcSpan]
[Note]
Maybe String
SrcSpan
Severity
ideaModule :: Idea -> [String]
ideaDecl :: Idea -> [String]
ideaSeverity :: Idea -> Severity
ideaHint :: Idea -> String
ideaSpan :: Idea -> SrcSpan
ideaFrom :: Idea -> String
ideaTo :: Idea -> Maybe String
ideaNote :: Idea -> [Note]
ideaRefactoring :: Idea -> [Refactoring SrcSpan]
ideaModule :: [String]
ideaDecl :: [String]
ideaSeverity :: Severity
ideaHint :: String
ideaSpan :: SrcSpan
ideaFrom :: String
ideaTo :: Maybe String
ideaNote :: [Note]
ideaRefactoring :: [Refactoring SrcSpan]
..} =
  Key -> Encoding' Value -> Series
pair Key
"description" (Series -> Encoding' Value
pairs (Series -> Encoding' Value) -> Series -> Encoding' Value
forall a b. (a -> b) -> a -> b
$ Key -> Encoding' Value -> Series
pair Key
"text" (Encoding' Value -> Series) -> Encoding' Value -> Series
forall a b. (a -> b) -> a -> b
$ String -> Encoding' Value
forall a. String -> Encoding' a
string String
ideaHint) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<>
  Key -> Encoding' Value -> Series
pair Key
"artifactChanges" ((Idea -> Encoding' Value) -> [Idea] -> Encoding' Value
forall a. (a -> Encoding' Value) -> [a] -> Encoding' Value
list (Series -> Encoding' Value
pairs (Series -> Encoding' Value)
-> (Idea -> Series) -> Idea -> Encoding' Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Idea -> Series
toChange) [Idea
idea])

-- | Converts a given idea to a @artifactChange@ object.
--
-- It will describe the details as to how the code can be changed.
-- I.e., the text to remove and what it should be replaced with.
--
-- See section 3.56 "artifactChange object", SARIF specification.
toChange :: Idea -> Series
toChange :: Idea -> Series
toChange idea :: Idea
idea@Idea{ideaSpan :: Idea -> SrcSpan
ideaSpan=SrcSpan{Int
String
srcSpanFilename :: SrcSpan -> String
srcSpanStartLine' :: SrcSpan -> Int
srcSpanStartColumn :: SrcSpan -> Int
srcSpanEndLine' :: SrcSpan -> Int
srcSpanEndColumn :: SrcSpan -> Int
srcSpanFilename :: String
srcSpanStartLine' :: Int
srcSpanStartColumn :: Int
srcSpanEndLine' :: Int
srcSpanEndColumn :: Int
..}, String
[String]
[Refactoring SrcSpan]
[Note]
Maybe String
Severity
ideaModule :: Idea -> [String]
ideaDecl :: Idea -> [String]
ideaSeverity :: Idea -> Severity
ideaHint :: Idea -> String
ideaFrom :: Idea -> String
ideaTo :: Idea -> Maybe String
ideaNote :: Idea -> [Note]
ideaRefactoring :: Idea -> [Refactoring SrcSpan]
ideaModule :: [String]
ideaDecl :: [String]
ideaSeverity :: Severity
ideaHint :: String
ideaFrom :: String
ideaTo :: Maybe String
ideaNote :: [Note]
ideaRefactoring :: [Refactoring SrcSpan]
..} =
  Key -> Encoding' Value -> Series
pair Key
"artifactLocation" (Series -> Encoding' Value
pairs Series
uri) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<>
  Key -> Encoding' Value -> Series
pair Key
"replacements" ((Series -> Encoding' Value) -> [Series] -> Encoding' Value
forall a. (a -> Encoding' Value) -> [a] -> Encoding' Value
list Series -> Encoding' Value
pairs [Series
deleted Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> Series
inserted])
  where uri :: Series
uri  = Key -> Encoding' Value -> Series
pair Key
"uri" (Encoding' Value -> Series) -> Encoding' Value -> Series
forall a b. (a -> b) -> a -> b
$ String -> Encoding' Value
forall a. String -> Encoding' a
string String
srcSpanFilename
        deleted :: Series
deleted = Key -> Encoding' Value -> Series
pair Key
"deletedRegion" (Encoding' Value -> Series) -> Encoding' Value -> Series
forall a b. (a -> b) -> a -> b
$ Series -> Encoding' Value
pairs (Series -> Encoding' Value) -> Series -> Encoding' Value
forall a b. (a -> b) -> a -> b
$ Idea -> Series
toRegion Idea
idea
        inserted :: Series
inserted = Series -> (String -> Series) -> Maybe String -> Series
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Series
forall a. Monoid a => a
mempty String -> Series
insertedContent Maybe String
ideaTo
        insertedContent :: String -> Series
insertedContent = Key -> Encoding' Value -> Series
pair Key
"insertedContent" (Encoding' Value -> Series)
-> (String -> Encoding' Value) -> String -> Series
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Series -> Encoding' Value
pairs (Series -> Encoding' Value)
-> (String -> Series) -> String -> Encoding' Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Encoding' Value -> Series
pair Key
"text" (Encoding' Value -> Series)
-> (String -> Encoding' Value) -> String -> Series
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Encoding' Value
forall a. String -> Encoding' a
string

-- | Converts the source span in an idea to a SARIF region.
--
-- See 3.30 "region object", SARIF specification.
toRegion :: Idea -> Series
toRegion :: Idea -> Series
toRegion Idea{ideaSpan :: Idea -> SrcSpan
ideaSpan=SrcSpan{Int
String
srcSpanFilename :: SrcSpan -> String
srcSpanStartLine' :: SrcSpan -> Int
srcSpanStartColumn :: SrcSpan -> Int
srcSpanEndLine' :: SrcSpan -> Int
srcSpanEndColumn :: SrcSpan -> Int
srcSpanFilename :: String
srcSpanStartLine' :: Int
srcSpanStartColumn :: Int
srcSpanEndLine' :: Int
srcSpanEndColumn :: Int
..}, String
[String]
[Refactoring SrcSpan]
[Note]
Maybe String
Severity
ideaModule :: Idea -> [String]
ideaDecl :: Idea -> [String]
ideaSeverity :: Idea -> Severity
ideaHint :: Idea -> String
ideaFrom :: Idea -> String
ideaTo :: Idea -> Maybe String
ideaNote :: Idea -> [Note]
ideaRefactoring :: Idea -> [Refactoring SrcSpan]
ideaModule :: [String]
ideaDecl :: [String]
ideaSeverity :: Severity
ideaHint :: String
ideaFrom :: String
ideaTo :: Maybe String
ideaNote :: [Note]
ideaRefactoring :: [Refactoring SrcSpan]
..} =
  Key -> Encoding' Value -> Series
pair Key
"startLine" (Int -> Encoding' Value
int Int
srcSpanStartLine') Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<>
  Key -> Encoding' Value -> Series
pair Key
"startColumn" (Int -> Encoding' Value
int Int
srcSpanStartColumn) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<>
  Key -> Encoding' Value -> Series
pair Key
"endLine" (Int -> Encoding' Value
int Int
srcSpanEndLine') Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<>
  Key -> Encoding' Value -> Series
pair Key
"endColumn" (Int -> Encoding' Value
int Int
srcSpanEndColumn)

-- | URI to SARIF schema definition.
schemaURI :: Text
schemaURI :: Text
schemaURI = Text
"https://raw.githubusercontent.com/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
            Text
"oasis-tcs/sarif-spec/master/Schemata/sarif-schema-2.1.0.json"

-- | URI to HLint home page.
hlintURI :: Text
hlintURI :: Text
hlintURI = Text
"https://github.com/ndmitchell/hlint"

-- $references
--
-- * [SARIF Tutorials](https://github.com/microsoft/sarif-tutorials)
-- * [Static Analysis Results Interchange Format](https://docs.oasis-open.org/sarif/sarif/v2.1.0/cs01/sarif-v2.1.0-cs01.html), version 2.1.0