--------------------------------------------------------------------------------
-- 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 top-level structure of SARIF.
module Data.SARIF.Log (
    Log(..),
    defaultLog,
    decodeSarifFileStrict,
    encodeSarifAsLBS
) where

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

import Data.Aeson
import qualified Data.ByteString.Lazy as LBS
import Data.Text

import Data.SARIF.Run (Run(..))

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

-- | Each SARIF file contains one `Log` value at the top.
data Log = MkLog {
    -- | The version identifier of the SARIF format used by the file.
    Log -> Text
logVersion :: Text,
    -- | A list of descriptions of runs of static analysis tools.
    Log -> [Run]
logRuns :: [Run]
} deriving (Log -> Log -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Log -> Log -> Bool
$c/= :: Log -> Log -> Bool
== :: Log -> Log -> Bool
$c== :: Log -> Log -> Bool
Eq, Int -> Log -> ShowS
[Log] -> ShowS
Log -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Log] -> ShowS
$cshowList :: [Log] -> ShowS
show :: Log -> String
$cshow :: Log -> String
showsPrec :: Int -> Log -> ShowS
$cshowsPrec :: Int -> Log -> ShowS
Show)

-- | The URL of the JSON schema that describes SARIF.
schemaUrl :: Text
schemaUrl :: Text
schemaUrl = Text
"https://raw.githubusercontent.com/oasis-tcs/sarif-spec/master/Schemata/sarif-schema-2.1.0.json"

instance ToJSON Log where
    toJSON :: Log -> Value
toJSON MkLog{[Run]
Text
logRuns :: [Run]
logVersion :: Text
logRuns :: Log -> [Run]
logVersion :: Log -> Text
..} = [Pair] -> Value
object
        [ Key
"version" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
logVersion
        , Key
"runs" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Run]
logRuns
        , Key
"$schema" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
schemaUrl
        ]

instance FromJSON Log where
    parseJSON :: Value -> Parser Log
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Log" forall a b. (a -> b) -> a -> b
$ \Object
obj ->
        Text -> [Run] -> Log
MkLog forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"version"
              forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"runs"

-- | Represents a default `Log` value.
defaultLog :: Log
defaultLog :: Log
defaultLog = MkLog{
    logVersion :: Text
logVersion = Text
"2.1.0",
    logRuns :: [Run]
logRuns = []
}

-- | `decodeSarifFileStrict` @filepath@ is a type-specialised version of
-- `eitherDecodeFileStrict` for `Log`.
decodeSarifFileStrict :: FilePath -> IO (Either String Log)
decodeSarifFileStrict :: String -> IO (Either String Log)
decodeSarifFileStrict = forall a. FromJSON a => String -> IO (Either String a)
eitherDecodeFileStrict

-- | `encodeSarifAsLBS` @log@ encodes a `Log` value as a lazy `LBS.ByteString`.
-- This is a type-specialised version of `encode`.
encodeSarifAsLBS :: Log -> LBS.ByteString
encodeSarifAsLBS :: Log -> ByteString
encodeSarifAsLBS = forall a. ToJSON a => a -> ByteString
encode

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