{-# 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 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 = forall a. Encoding' a -> ByteString
encodingToLazyByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Idea] -> Encoding
toJSONEncoding

-- | Converts the given ideas to a "Data.Aeson" encoding in SARIF.
toJSONEncoding :: [Idea] -> Encoding
toJSONEncoding :: [Idea] -> Encoding
toJSONEncoding = Series -> Encoding
pairs 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 -> Series
pair Key
"version" (forall a. Text -> Encoding' a
lazyText Text
"2.1.0") forall a. Semigroup a => a -> a -> a
<>
  Key -> Encoding -> Series
pair Key
"$schema" (forall a. Text -> Encoding' a
lazyText Text
schemaURI) forall a. Semigroup a => a -> a -> a
<>
  Key -> Encoding -> Series
pair Key
"runs" Encoding
runs
  where runs :: Encoding
runs = forall a. (a -> Encoding) -> [a] -> Encoding
list Series -> Encoding
pairs [ Key -> Encoding -> Series
pair Key
"tool" (Series -> Encoding
pairs Series
tool) forall a. Semigroup a => a -> a -> a
<>
                            Key -> Encoding -> Series
pair Key
"results" (forall a. (a -> Encoding) -> [a] -> Encoding
list (Series -> Encoding
pairs 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 -> Series
pair Key
"driver" forall a b. (a -> b) -> a -> b
$ Series -> Encoding
pairs forall a b. (a -> b) -> a -> b
$
  Key -> Encoding -> Series
pair Key
"name" (forall a. Text -> Encoding' a
lazyText Text
"hlint") forall a. Semigroup a => a -> a -> a
<>
  Key -> Encoding -> Series
pair Key
"version" (forall a. String -> Encoding' a
string forall a b. (a -> b) -> a -> b
$ Version -> String
showVersion Version
version) forall a. Semigroup a => a -> a -> a
<>
  Key -> Encoding -> Series
pair Key
"informationUri" (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
ideaRefactoring :: Idea -> [Refactoring SrcSpan]
ideaNote :: Idea -> [Note]
ideaTo :: Idea -> Maybe String
ideaFrom :: Idea -> String
ideaSpan :: Idea -> SrcSpan
ideaHint :: Idea -> String
ideaSeverity :: Idea -> Severity
ideaDecl :: Idea -> [String]
ideaModule :: Idea -> [String]
ideaRefactoring :: [Refactoring SrcSpan]
ideaNote :: [Note]
ideaTo :: Maybe String
ideaFrom :: String
ideaSpan :: SrcSpan
ideaHint :: String
ideaSeverity :: Severity
ideaDecl :: [String]
ideaModule :: [String]
..} =
  Key -> Encoding -> Series
pair Key
"message" (Series -> Encoding
pairs forall a b. (a -> b) -> a -> b
$ Key -> Encoding -> Series
pair Key
"text" forall a b. (a -> b) -> a -> b
$ forall a. String -> Encoding' a
string forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Idea
idea) forall a. Semigroup a => a -> a -> a
<>
  Key -> Encoding -> Series
pair Key
"level" (forall a. Text -> Encoding' a
lazyText forall a b. (a -> b) -> a -> b
$ Severity -> Text
showSeverity Severity
ideaSeverity) forall a. Semigroup a => a -> a -> a
<>
  Key -> Encoding -> Series
pair Key
"locations" (forall a. (a -> Encoding) -> [a] -> Encoding
list (Series -> Encoding
pairs forall b c a. (b -> c) -> (a -> b) -> a -> c
. Idea -> Series
toLocation) [Idea
idea]) forall a. Semigroup a => a -> a -> a
<>
  Key -> Encoding -> Series
pair Key
"fixes" (forall a. (a -> Encoding) -> [a] -> Encoding
list (Series -> Encoding
pairs forall b c a. (b -> c) -> (a -> b) -> a -> c
. Idea -> Series
toFix) [Idea
idea]) 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 -> Series
pair Key
"ruleId" (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
srcSpanEndColumn :: SrcSpan -> Int
srcSpanEndLine' :: SrcSpan -> Int
srcSpanStartColumn :: SrcSpan -> Int
srcSpanStartLine' :: SrcSpan -> Int
srcSpanFilename :: SrcSpan -> String
srcSpanEndColumn :: Int
srcSpanEndLine' :: Int
srcSpanStartColumn :: Int
srcSpanStartLine' :: Int
srcSpanFilename :: String
..}, String
[String]
[Refactoring SrcSpan]
[Note]
Maybe String
Severity
ideaRefactoring :: [Refactoring SrcSpan]
ideaNote :: [Note]
ideaTo :: Maybe String
ideaFrom :: String
ideaHint :: String
ideaSeverity :: Severity
ideaDecl :: [String]
ideaModule :: [String]
ideaRefactoring :: Idea -> [Refactoring SrcSpan]
ideaNote :: Idea -> [Note]
ideaTo :: Idea -> Maybe String
ideaFrom :: Idea -> String
ideaHint :: Idea -> String
ideaSeverity :: Idea -> Severity
ideaDecl :: Idea -> [String]
ideaModule :: Idea -> [String]
..} =
  Series
physicalLocation forall a. Semigroup a => a -> a -> a
<> [String] -> [String] -> Series
logicalLocations [String]
ideaModule [String]
ideaDecl
  where physicalLocation :: Series
physicalLocation = Key -> Encoding -> Series
pair Key
"physicalLocation" forall a b. (a -> b) -> a -> b
$ Series -> Encoding
pairs forall a b. (a -> b) -> a -> b
$
          Key -> Encoding -> Series
pair Key
"artifactLocation"
              (Series -> Encoding
pairs forall a b. (a -> b) -> a -> b
$ Key -> Encoding -> Series
pair Key
"uri" (forall a. String -> Encoding' a
string String
srcSpanFilename)) forall a. Semigroup a => a -> a -> a
<>
          Key -> Encoding -> Series
pair Key
"region" (Series -> Encoding
pairs forall a b. (a -> b) -> a -> b
$ Idea -> Series
toRegion Idea
idea)

        logicalLocations :: [String] -> [String] -> Series
logicalLocations [String
mod] [String
decl] = Key -> Encoding -> Series
pair Key
"logicalLocations" forall a b. (a -> b) -> a -> b
$
          forall a. (a -> Encoding) -> [a] -> Encoding
list Series -> Encoding
pairs [ Key -> Encoding -> Series
pair Key
"name" (forall a. String -> Encoding' a
string String
decl) forall a. Semigroup a => a -> a -> a
<>
                       Key -> Encoding -> Series
pair Key
"fullyQualifiedName" (forall a. String -> Encoding' a
string forall a b. (a -> b) -> a -> b
$ String
mod forall a. [a] -> [a] -> [a]
++ 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]
_ = 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
ideaRefactoring :: [Refactoring SrcSpan]
ideaNote :: [Note]
ideaTo :: Maybe String
ideaFrom :: String
ideaSpan :: SrcSpan
ideaHint :: String
ideaSeverity :: Severity
ideaDecl :: [String]
ideaModule :: [String]
ideaRefactoring :: Idea -> [Refactoring SrcSpan]
ideaNote :: Idea -> [Note]
ideaTo :: Idea -> Maybe String
ideaFrom :: Idea -> String
ideaSpan :: Idea -> SrcSpan
ideaHint :: Idea -> String
ideaSeverity :: Idea -> Severity
ideaDecl :: Idea -> [String]
ideaModule :: Idea -> [String]
..} =
  Key -> Encoding -> Series
pair Key
"description" (Series -> Encoding
pairs forall a b. (a -> b) -> a -> b
$ Key -> Encoding -> Series
pair Key
"text" forall a b. (a -> b) -> a -> b
$ forall a. String -> Encoding' a
string String
ideaHint) forall a. Semigroup a => a -> a -> a
<>
  Key -> Encoding -> Series
pair Key
"artifactChanges" (forall a. (a -> Encoding) -> [a] -> Encoding
list (Series -> Encoding
pairs 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
srcSpanEndColumn :: Int
srcSpanEndLine' :: Int
srcSpanStartColumn :: Int
srcSpanStartLine' :: Int
srcSpanFilename :: String
srcSpanEndColumn :: SrcSpan -> Int
srcSpanEndLine' :: SrcSpan -> Int
srcSpanStartColumn :: SrcSpan -> Int
srcSpanStartLine' :: SrcSpan -> Int
srcSpanFilename :: SrcSpan -> String
..}, String
[String]
[Refactoring SrcSpan]
[Note]
Maybe String
Severity
ideaRefactoring :: [Refactoring SrcSpan]
ideaNote :: [Note]
ideaTo :: Maybe String
ideaFrom :: String
ideaHint :: String
ideaSeverity :: Severity
ideaDecl :: [String]
ideaModule :: [String]
ideaRefactoring :: Idea -> [Refactoring SrcSpan]
ideaNote :: Idea -> [Note]
ideaTo :: Idea -> Maybe String
ideaFrom :: Idea -> String
ideaHint :: Idea -> String
ideaSeverity :: Idea -> Severity
ideaDecl :: Idea -> [String]
ideaModule :: Idea -> [String]
..} =
  Key -> Encoding -> Series
pair Key
"artifactLocation" (Series -> Encoding
pairs Series
uri) forall a. Semigroup a => a -> a -> a
<>
  Key -> Encoding -> Series
pair Key
"replacements" (forall a. (a -> Encoding) -> [a] -> Encoding
list Series -> Encoding
pairs [Series
deleted forall a. Semigroup a => a -> a -> a
<> Series
inserted])
  where uri :: Series
uri  = Key -> Encoding -> Series
pair Key
"uri" forall a b. (a -> b) -> a -> b
$ forall a. String -> Encoding' a
string String
srcSpanFilename
        deleted :: Series
deleted = Key -> Encoding -> Series
pair Key
"deletedRegion" forall a b. (a -> b) -> a -> b
$ Series -> Encoding
pairs forall a b. (a -> b) -> a -> b
$ Idea -> Series
toRegion Idea
idea
        inserted :: Series
inserted = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty String -> Series
insertedContent Maybe String
ideaTo
        insertedContent :: String -> Series
insertedContent = Key -> Encoding -> Series
pair Key
"insertedContent" forall b c a. (b -> c) -> (a -> b) -> a -> c
. Series -> Encoding
pairs forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Encoding -> Series
pair Key
"text" forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
srcSpanEndColumn :: Int
srcSpanEndLine' :: Int
srcSpanStartColumn :: Int
srcSpanStartLine' :: Int
srcSpanFilename :: String
srcSpanEndColumn :: SrcSpan -> Int
srcSpanEndLine' :: SrcSpan -> Int
srcSpanStartColumn :: SrcSpan -> Int
srcSpanStartLine' :: SrcSpan -> Int
srcSpanFilename :: SrcSpan -> String
..}, String
[String]
[Refactoring SrcSpan]
[Note]
Maybe String
Severity
ideaRefactoring :: [Refactoring SrcSpan]
ideaNote :: [Note]
ideaTo :: Maybe String
ideaFrom :: String
ideaHint :: String
ideaSeverity :: Severity
ideaDecl :: [String]
ideaModule :: [String]
ideaRefactoring :: Idea -> [Refactoring SrcSpan]
ideaNote :: Idea -> [Note]
ideaTo :: Idea -> Maybe String
ideaFrom :: Idea -> String
ideaHint :: Idea -> String
ideaSeverity :: Idea -> Severity
ideaDecl :: Idea -> [String]
ideaModule :: Idea -> [String]
..} =
  Key -> Encoding -> Series
pair Key
"startLine" (Int -> Encoding
int Int
srcSpanStartLine') forall a. Semigroup a => a -> a -> a
<>
  Key -> Encoding -> Series
pair Key
"startColumn" (Int -> Encoding
int Int
srcSpanStartColumn) forall a. Semigroup a => a -> a -> a
<>
  Key -> Encoding -> Series
pair Key
"endLine" (Int -> Encoding
int Int
srcSpanEndLine') forall a. Semigroup a => a -> a -> a
<>
  Key -> Encoding -> Series
pair Key
"endColumn" (Int -> Encoding
int Int
srcSpanEndColumn)

-- | URI to SARIF schema definition.
schemaURI :: Text
schemaURI :: Text
schemaURI = Text
"https://raw.githubusercontent.com/" 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