module Data.SARIF.Tool (
Tool(..),
ToolComponent(..),
defaultToolComponent
) where
import GHC.Generics
import Data.Aeson.Optional
import Data.Text
import Data.UUID.Types
import Data.SARIF.ReportingDescriptor
data Tool = MkTool {
Tool -> ToolComponent
toolDriver :: ToolComponent,
Tool -> [ToolComponent]
toolExtensions :: [ToolComponent]
} deriving (Tool -> Tool -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Tool -> Tool -> Bool
$c/= :: Tool -> Tool -> Bool
== :: Tool -> Tool -> Bool
$c== :: Tool -> Tool -> Bool
Eq, Int -> Tool -> ShowS
[Tool] -> ShowS
Tool -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Tool] -> ShowS
$cshowList :: [Tool] -> ShowS
show :: Tool -> String
$cshow :: Tool -> String
showsPrec :: Int -> Tool -> ShowS
$cshowsPrec :: Int -> Tool -> ShowS
Show, forall x. Rep Tool x -> Tool
forall x. Tool -> Rep Tool x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Tool x -> Tool
$cfrom :: forall x. Tool -> Rep Tool x
Generic)
instance ToJSON Tool where
toJSON :: Tool -> Value
toJSON MkTool{[ToolComponent]
ToolComponent
toolExtensions :: [ToolComponent]
toolDriver :: ToolComponent
toolExtensions :: Tool -> [ToolComponent]
toolDriver :: Tool -> ToolComponent
..} = [Maybe Pair] -> Value
object
[ Key
"driver" forall a. ToJSON a => Key -> a -> Maybe Pair
.= ToolComponent
toolDriver
, Key
"extensions" forall a. ToJSON a => Key -> a -> Maybe Pair
.= [ToolComponent]
toolExtensions
]
instance FromJSON Tool where
parseJSON :: Value -> Parser Tool
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Tool" forall a b. (a -> b) -> a -> b
$ \Object
obj ->
ToolComponent -> [ToolComponent] -> Tool
MkTool forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"driver"
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"extensions" forall a. Parser (Maybe a) -> a -> Parser a
.!= []
data ToolComponent = MkToolComponent {
ToolComponent -> Maybe Text
toolComponentName :: Maybe Text,
ToolComponent -> Maybe Text
toolComponentFullName :: Maybe Text,
ToolComponent -> Maybe Text
toolComponentSemanticVersion :: Maybe Text,
ToolComponent -> Maybe Text
toolComponentVersion :: Maybe Text,
ToolComponent -> Maybe UUID
toolComponentGUID :: Maybe UUID,
ToolComponent -> Maybe Text
toolComponentInformationUri :: Maybe Text,
ToolComponent -> [ReportingDescriptor]
toolComponentRules :: [ReportingDescriptor]
} deriving (ToolComponent -> ToolComponent -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ToolComponent -> ToolComponent -> Bool
$c/= :: ToolComponent -> ToolComponent -> Bool
== :: ToolComponent -> ToolComponent -> Bool
$c== :: ToolComponent -> ToolComponent -> Bool
Eq, Int -> ToolComponent -> ShowS
[ToolComponent] -> ShowS
ToolComponent -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ToolComponent] -> ShowS
$cshowList :: [ToolComponent] -> ShowS
show :: ToolComponent -> String
$cshow :: ToolComponent -> String
showsPrec :: Int -> ToolComponent -> ShowS
$cshowsPrec :: Int -> ToolComponent -> ShowS
Show, forall x. Rep ToolComponent x -> ToolComponent
forall x. ToolComponent -> Rep ToolComponent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ToolComponent x -> ToolComponent
$cfrom :: forall x. ToolComponent -> Rep ToolComponent x
Generic)
instance ToJSON ToolComponent where
toJSON :: ToolComponent -> Value
toJSON MkToolComponent{[ReportingDescriptor]
Maybe Text
Maybe UUID
toolComponentRules :: [ReportingDescriptor]
toolComponentInformationUri :: Maybe Text
toolComponentGUID :: Maybe UUID
toolComponentVersion :: Maybe Text
toolComponentSemanticVersion :: Maybe Text
toolComponentFullName :: Maybe Text
toolComponentName :: Maybe Text
toolComponentRules :: ToolComponent -> [ReportingDescriptor]
toolComponentInformationUri :: ToolComponent -> Maybe Text
toolComponentGUID :: ToolComponent -> Maybe UUID
toolComponentVersion :: ToolComponent -> Maybe Text
toolComponentSemanticVersion :: ToolComponent -> Maybe Text
toolComponentFullName :: ToolComponent -> Maybe Text
toolComponentName :: ToolComponent -> Maybe Text
..} = [Maybe Pair] -> Value
object
[ Key
"name" forall a. ToJSON a => Key -> a -> Maybe Pair
.= Maybe Text
toolComponentName
, Key
"fullName" forall a. ToJSON a => Key -> Maybe a -> Maybe Pair
.=? Maybe Text
toolComponentFullName
, Key
"semanticVersion" forall a. ToJSON a => Key -> Maybe a -> Maybe Pair
.=? Maybe Text
toolComponentSemanticVersion
, Key
"version" forall a. ToJSON a => Key -> Maybe a -> Maybe Pair
.=? Maybe Text
toolComponentVersion
, Key
"guid" forall a. ToJSON a => Key -> Maybe a -> Maybe Pair
.=? Maybe UUID
toolComponentGUID
, Key
"informationUri" forall a. ToJSON a => Key -> Maybe a -> Maybe Pair
.=? Maybe Text
toolComponentInformationUri
, Key
"rules" forall a. ToJSON a => Key -> a -> Maybe Pair
.= [ReportingDescriptor]
toolComponentRules
]
instance FromJSON ToolComponent where
parseJSON :: Value -> Parser ToolComponent
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ToolComponent" forall a b. (a -> b) -> a -> b
$ \Object
obj ->
Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe UUID
-> Maybe Text
-> [ReportingDescriptor]
-> ToolComponent
MkToolComponent forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"fullName"
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
"semanticVersion"
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
"version"
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
"guid"
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
"informationUri"
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"rules" forall a. Parser (Maybe a) -> a -> Parser a
.!= []
defaultToolComponent :: ToolComponent
defaultToolComponent :: ToolComponent
defaultToolComponent = MkToolComponent{
toolComponentName :: Maybe Text
toolComponentName = forall a. Maybe a
Nothing,
toolComponentFullName :: Maybe Text
toolComponentFullName = forall a. Maybe a
Nothing,
toolComponentSemanticVersion :: Maybe Text
toolComponentSemanticVersion = forall a. Maybe a
Nothing,
toolComponentVersion :: Maybe Text
toolComponentVersion = forall a. Maybe a
Nothing,
toolComponentGUID :: Maybe UUID
toolComponentGUID = forall a. Maybe a
Nothing,
toolComponentInformationUri :: Maybe Text
toolComponentInformationUri = forall a. Maybe a
Nothing,
toolComponentRules :: [ReportingDescriptor]
toolComponentRules = []
}