--------------------------------------------------------------------------------
-- 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 `Level` type, which enumerates SARIF result levels.
-- See https://docs.oasis-open.org/sarif/sarif/v2.1.0/cs01/sarif-v2.1.0-cs01.html#_Ref493511208
module Data.SARIF.Level (
    Level(..)
) where

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

import Data.Aeson.Optional hiding (Error)

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

-- | A `Level` value represents the severity of a result.
data Level
    -- | The concept of “severity” does not apply.
    = None
    -- | A minor problem or an opportunity to improve the code was found.
    | Note
    -- | A problem was found.
    | Warning
    -- | A serious problem was found.
    | Error
    deriving (Level -> Level -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Level -> Level -> Bool
$c/= :: Level -> Level -> Bool
== :: Level -> Level -> Bool
$c== :: Level -> Level -> Bool
Eq, Int -> Level -> ShowS
[Level] -> ShowS
Level -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Level] -> ShowS
$cshowList :: [Level] -> ShowS
show :: Level -> String
$cshow :: Level -> String
showsPrec :: Int -> Level -> ShowS
$cshowsPrec :: Int -> Level -> ShowS
Show)

instance ToJSON Level where
    toJSON :: Level -> Value
toJSON Level
None = Value
"none"
    toJSON Level
Note = Value
"note"
    toJSON Level
Warning = Value
"warning"
    toJSON Level
Error = Value
"error"

instance FromJSON Level where
    parseJSON :: Value -> Parser Level
parseJSON (String Text
"none") = forall (f :: * -> *) a. Applicative f => a -> f a
pure Level
None
    parseJSON (String Text
"note") = forall (f :: * -> *) a. Applicative f => a -> f a
pure Level
Note
    parseJSON (String Text
"warning") = forall (f :: * -> *) a. Applicative f => a -> f a
pure Level
Warning
    parseJSON (String Text
"error") = forall (f :: * -> *) a. Applicative f => a -> f a
pure Level
Error
    parseJSON Value
_ = forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Unexpected value for result level"

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