module Data.SARIF.Location (
Location(..),
ArtifactLocation(..),
Region(..),
PhysicalLocation(..)
) where
import Data.Aeson
import Data.Text
newtype Location = MkLocation {
Location -> Maybe PhysicalLocation
locationPhysicalLocation :: Maybe PhysicalLocation
} deriving (Location -> Location -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Location -> Location -> Bool
$c/= :: Location -> Location -> Bool
== :: Location -> Location -> Bool
$c== :: Location -> Location -> Bool
Eq, Int -> Location -> ShowS
[Location] -> ShowS
Location -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Location] -> ShowS
$cshowList :: [Location] -> ShowS
show :: Location -> String
$cshow :: Location -> String
showsPrec :: Int -> Location -> ShowS
$cshowsPrec :: Int -> Location -> ShowS
Show)
instance ToJSON Location where
toJSON :: Location -> Value
toJSON MkLocation{Maybe PhysicalLocation
locationPhysicalLocation :: Maybe PhysicalLocation
locationPhysicalLocation :: Location -> Maybe PhysicalLocation
..} = [Pair] -> Value
object
[ Key
"physicalLocation" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe PhysicalLocation
locationPhysicalLocation
]
instance FromJSON Location where
parseJSON :: Value -> Parser Location
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Location" forall a b. (a -> b) -> a -> b
$ \Object
obj ->
Maybe PhysicalLocation -> Location
MkLocation forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"physicalLocation"
newtype ArtifactLocation = MkArtifactLocation {
ArtifactLocation -> Text
artifactLocationUri :: Text
} deriving (ArtifactLocation -> ArtifactLocation -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ArtifactLocation -> ArtifactLocation -> Bool
$c/= :: ArtifactLocation -> ArtifactLocation -> Bool
== :: ArtifactLocation -> ArtifactLocation -> Bool
$c== :: ArtifactLocation -> ArtifactLocation -> Bool
Eq, Int -> ArtifactLocation -> ShowS
[ArtifactLocation] -> ShowS
ArtifactLocation -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ArtifactLocation] -> ShowS
$cshowList :: [ArtifactLocation] -> ShowS
show :: ArtifactLocation -> String
$cshow :: ArtifactLocation -> String
showsPrec :: Int -> ArtifactLocation -> ShowS
$cshowsPrec :: Int -> ArtifactLocation -> ShowS
Show)
instance ToJSON ArtifactLocation where
toJSON :: ArtifactLocation -> Value
toJSON MkArtifactLocation{Text
artifactLocationUri :: Text
artifactLocationUri :: ArtifactLocation -> Text
..} = [Pair] -> Value
object
[ Key
"uri" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
artifactLocationUri
]
instance FromJSON ArtifactLocation where
parseJSON :: Value -> Parser ArtifactLocation
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ArtifactLocation" forall a b. (a -> b) -> a -> b
$ \Object
obj ->
Text -> ArtifactLocation
MkArtifactLocation forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"uri"
data Region = MkRegion {
Region -> Int
regionStartLine :: Int,
Region -> Int
regionStartColumn :: Int,
Region -> Int
regionEndLine :: Int,
Region -> Int
regionEndColumn :: Int
} deriving (Region -> Region -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Region -> Region -> Bool
$c/= :: Region -> Region -> Bool
== :: Region -> Region -> Bool
$c== :: Region -> Region -> Bool
Eq, Int -> Region -> ShowS
[Region] -> ShowS
Region -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Region] -> ShowS
$cshowList :: [Region] -> ShowS
show :: Region -> String
$cshow :: Region -> String
showsPrec :: Int -> Region -> ShowS
$cshowsPrec :: Int -> Region -> ShowS
Show)
instance ToJSON Region where
toJSON :: Region -> Value
toJSON MkRegion{Int
regionEndColumn :: Int
regionEndLine :: Int
regionStartColumn :: Int
regionStartLine :: Int
regionEndColumn :: Region -> Int
regionEndLine :: Region -> Int
regionStartColumn :: Region -> Int
regionStartLine :: Region -> Int
..} = [Pair] -> Value
object
[ Key
"startLine" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int
regionStartLine
, Key
"startColumn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int
regionStartColumn
, Key
"endLine" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int
regionEndLine
, Key
"endColumn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int
regionEndColumn
]
instance FromJSON Region where
parseJSON :: Value -> Parser Region
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Region" forall a b. (a -> b) -> a -> b
$ \Object
obj ->
Int -> Int -> Int -> Int -> Region
MkRegion forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"startLine"
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"startColumn"
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"endLine"
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"endColumn"
data PhysicalLocation = MkPhysicalLocation {
PhysicalLocation -> ArtifactLocation
physicalLocationArtifactLocation :: ArtifactLocation,
PhysicalLocation -> Region
physicalLocationRegion :: Region
} deriving (PhysicalLocation -> PhysicalLocation -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PhysicalLocation -> PhysicalLocation -> Bool
$c/= :: PhysicalLocation -> PhysicalLocation -> Bool
== :: PhysicalLocation -> PhysicalLocation -> Bool
$c== :: PhysicalLocation -> PhysicalLocation -> Bool
Eq, Int -> PhysicalLocation -> ShowS
[PhysicalLocation] -> ShowS
PhysicalLocation -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PhysicalLocation] -> ShowS
$cshowList :: [PhysicalLocation] -> ShowS
show :: PhysicalLocation -> String
$cshow :: PhysicalLocation -> String
showsPrec :: Int -> PhysicalLocation -> ShowS
$cshowsPrec :: Int -> PhysicalLocation -> ShowS
Show)
instance ToJSON PhysicalLocation where
toJSON :: PhysicalLocation -> Value
toJSON MkPhysicalLocation{Region
ArtifactLocation
physicalLocationRegion :: Region
physicalLocationArtifactLocation :: ArtifactLocation
physicalLocationRegion :: PhysicalLocation -> Region
physicalLocationArtifactLocation :: PhysicalLocation -> ArtifactLocation
..} = [Pair] -> Value
object
[ Key
"artifactLocation" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ArtifactLocation
physicalLocationArtifactLocation
, Key
"region" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Region
physicalLocationRegion
]
instance FromJSON PhysicalLocation where
parseJSON :: Value -> Parser PhysicalLocation
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"PhysicalLocation" forall a b. (a -> b) -> a -> b
$ \Object
obj ->
ArtifactLocation -> Region -> PhysicalLocation
MkPhysicalLocation forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"artifactLocation"
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"region"