--------------------------------------------------------------------------------
-- SARIF implementation for Haskell
--------------------------------------------------------------------------------
-- This source code is licensed under the MIT license found in the LICENSE    --
-- file in the root directory of this source tree.                            --
--------------------------------------------------------------------------------

-- | Provides the `Result` type which represents results of a
-- static analysis tool.
module Data.SARIF.Result (
    Level(..),
    Result(..)
) where

--------------------------------------------------------------------------------

import Data.Aeson.Optional hiding (Result, Error)
import Data.Text

import Data.SARIF.Level
import Data.SARIF.Location
import Data.SARIF.MultiformatMessageString

--------------------------------------------------------------------------------

-- | Represents the results of a run of a static analysis tool.
data Result = MkResult {
    -- | The unique ID of the rule of which this result is an occurrence of.
    Result -> Text
resultRuleId :: Text,
    -- | A result-specific message which may refer to specific variable names
    -- etc. which caused the rule to trigger.
    Result -> MultiformatMessageString
resultMessage :: MultiformatMessageString,
    -- | A list of locations which caused the rule to trigger.
    Result -> [Location]
resultLocations :: [Location],
    -- | An optional override for the default `Level` of the rule.
    Result -> Maybe Level
resultLevel :: Maybe Level
} deriving (Result -> Result -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Result -> Result -> Bool
$c/= :: Result -> Result -> Bool
== :: Result -> Result -> Bool
$c== :: Result -> Result -> Bool
Eq, Int -> Result -> ShowS
[Result] -> ShowS
Result -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Result] -> ShowS
$cshowList :: [Result] -> ShowS
show :: Result -> String
$cshow :: Result -> String
showsPrec :: Int -> Result -> ShowS
$cshowsPrec :: Int -> Result -> ShowS
Show)

instance ToJSON Result where
    toJSON :: Result -> Value
toJSON MkResult{[Location]
Maybe Level
Text
MultiformatMessageString
resultLevel :: Maybe Level
resultLocations :: [Location]
resultMessage :: MultiformatMessageString
resultRuleId :: Text
resultLevel :: Result -> Maybe Level
resultLocations :: Result -> [Location]
resultMessage :: Result -> MultiformatMessageString
resultRuleId :: Result -> Text
..} = [Maybe Pair] -> Value
object
        [ Key
"ruleId" forall a. ToJSON a => Key -> a -> Maybe Pair
.= Text
resultRuleId
        , Key
"message" forall a. ToJSON a => Key -> a -> Maybe Pair
.= MultiformatMessageString
resultMessage
        , Key
"locations" forall a. ToJSON a => Key -> a -> Maybe Pair
.= [Location]
resultLocations
        , Key
"level" forall a. ToJSON a => Key -> Maybe a -> Maybe Pair
.=? Maybe Level
resultLevel
        ]

instance FromJSON Result where
    parseJSON :: Value -> Parser Result
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Result" forall a b. (a -> b) -> a -> b
$ \Object
obj ->
        Text
-> MultiformatMessageString -> [Location] -> Maybe Level -> Result
MkResult forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"ruleId"
                 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"message"
                 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"locations"
                 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"level"

--------------------------------------------------------------------------------