--------------------------------------------------------------------------------
-- 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 `Artifact` type to represent SARIF artifacts.
module Data.SARIF.Artifact (
    Artifact(..)
) where

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

import Data.Aeson.Optional
import Data.Text

import Data.SARIF.Location

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

-- | An artifact represents e.g. a source file.
data Artifact = MkArtifact {
    -- | The location where the artifact was found.
    Artifact -> ArtifactLocation
artifactLocation :: ArtifactLocation,
    -- | The mime type of the artifact.
    Artifact -> Maybe Text
artifactMimeType :: Maybe Text
} deriving (Artifact -> Artifact -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Artifact -> Artifact -> Bool
$c/= :: Artifact -> Artifact -> Bool
== :: Artifact -> Artifact -> Bool
$c== :: Artifact -> Artifact -> Bool
Eq, Int -> Artifact -> ShowS
[Artifact] -> ShowS
Artifact -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Artifact] -> ShowS
$cshowList :: [Artifact] -> ShowS
show :: Artifact -> String
$cshow :: Artifact -> String
showsPrec :: Int -> Artifact -> ShowS
$cshowsPrec :: Int -> Artifact -> ShowS
Show)

instance ToJSON Artifact where
    toJSON :: Artifact -> Value
toJSON MkArtifact{Maybe Text
ArtifactLocation
artifactMimeType :: Maybe Text
artifactLocation :: ArtifactLocation
artifactMimeType :: Artifact -> Maybe Text
artifactLocation :: Artifact -> ArtifactLocation
..} = [Maybe Pair] -> Value
object
        [ Key
"location" forall a. ToJSON a => Key -> a -> Maybe Pair
.= ArtifactLocation
artifactLocation
        , Key
"mimeType" forall a. ToJSON a => Key -> Maybe a -> Maybe Pair
.=? Maybe Text
artifactMimeType
        ]

instance FromJSON Artifact where
    parseJSON :: Value -> Parser Artifact
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Artifact" forall a b. (a -> b) -> a -> b
$ \Object
obj ->
        ArtifactLocation -> Maybe Text -> Artifact
MkArtifact forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"location"
                   forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"mimeType"

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