--------------------------------------------------------------------------------
-- 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 `Run` type which represents a single run of a
-- static analysis tool.
module Data.SARIF.Run (
    Run(..)
) where

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

import Data.Aeson hiding (Result)

import Data.SARIF.Artifact
import Data.SARIF.Result (Result(..))
import Data.SARIF.Tool (Tool(..))

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

-- | Represents individual runs of static analysis tools.
data Run = MkRun {
    -- | A description of the tool that was run.
    Run -> Tool
runTool :: Tool,
    -- | A list of the artifacts that were scanned by the tool.
    Run -> [Artifact]
runArtifacts :: [Artifact],
    -- | The results produced by the tool as a result of scanning
    -- the artifacts.
    Run -> [Result]
runResults :: [Result]
} deriving (Run -> Run -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Run -> Run -> Bool
$c/= :: Run -> Run -> Bool
== :: Run -> Run -> Bool
$c== :: Run -> Run -> Bool
Eq, Int -> Run -> ShowS
[Run] -> ShowS
Run -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Run] -> ShowS
$cshowList :: [Run] -> ShowS
show :: Run -> String
$cshow :: Run -> String
showsPrec :: Int -> Run -> ShowS
$cshowsPrec :: Int -> Run -> ShowS
Show)

instance ToJSON Run where
    toJSON :: Run -> Value
toJSON MkRun{[Artifact]
[Result]
Tool
runResults :: [Result]
runArtifacts :: [Artifact]
runTool :: Tool
runResults :: Run -> [Result]
runArtifacts :: Run -> [Artifact]
runTool :: Run -> Tool
..} = [Pair] -> Value
object
        [ Key
"tool" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Tool
runTool
        , Key
"artifacts" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Artifact]
runArtifacts
        , Key
"results" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Result]
runResults
        ]

instance FromJSON Run where
    parseJSON :: Value -> Parser Run
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Run" forall a b. (a -> b) -> a -> b
$ \Object
obj ->
        Tool -> [Artifact] -> [Result] -> Run
MkRun forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"tool"
              forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"artifacts" forall a. Parser (Maybe a) -> a -> Parser a
.!= []
              forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"results" forall a. Parser (Maybe a) -> a -> Parser a
.!= []

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