-- |

--

-- * Locations exist for all "code entities"

--

--     * variables

--     * function calls

--     * function definitions

--     * while loops

--     * etc.

-- 

-- * Locations are constructed /only during parsing/

--

--     * users should /not/ construct locations

--

-- * Locations help to present security findings to users

--

-- * In addition, locations are used as /primary keys/ in the container database

--

--     * more precisely, locations are /variables/ in the resulting __Prolog__ program

--     * each location corresponds to /exactly one/ "code entity"

--     * this is why users should /never/ construct locations

--     * it is completely the parser's job !

--


{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DeriveGeneric     #-}
{-# LANGUAGE DeriveAnyClass    #-}

module Location

where

import Data.Aeson
import GHC.Generics

-- |

-- Lines and columns are 1-based, for compatability with

-- [Sarif](https://docs.oasis-open.org/sarif/sarif/v2.1.0/errata01/os/sarif-v2.1.0-errata01-os-complete.html#_Toc141790937).

--

-- > The line number of the first line in a text artifact SHALL be 1.

data Location =
     Location
     {
         Location -> FilePath
filename  :: FilePath,
         Location -> Word
lineStart :: Word,
         Location -> Word
lineEnd   :: Word,
         Location -> Word
colStart  :: Word,
         Location -> Word
colEnd    :: Word
     }
     deriving ( Int -> Location -> ShowS
[Location] -> ShowS
Location -> FilePath
(Int -> Location -> ShowS)
-> (Location -> FilePath) -> ([Location] -> ShowS) -> Show Location
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Location -> ShowS
showsPrec :: Int -> Location -> ShowS
$cshow :: Location -> FilePath
show :: Location -> FilePath
$cshowList :: [Location] -> ShowS
showList :: [Location] -> ShowS
Show, ReadPrec [Location]
ReadPrec Location
Int -> ReadS Location
ReadS [Location]
(Int -> ReadS Location)
-> ReadS [Location]
-> ReadPrec Location
-> ReadPrec [Location]
-> Read Location
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Location
readsPrec :: Int -> ReadS Location
$creadList :: ReadS [Location]
readList :: ReadS [Location]
$creadPrec :: ReadPrec Location
readPrec :: ReadPrec Location
$creadListPrec :: ReadPrec [Location]
readListPrec :: ReadPrec [Location]
Read, Location -> Location -> Bool
(Location -> Location -> Bool)
-> (Location -> Location -> Bool) -> Eq Location
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Location -> Location -> Bool
== :: Location -> Location -> Bool
$c/= :: Location -> Location -> Bool
/= :: Location -> Location -> Bool
Eq, (forall x. Location -> Rep Location x)
-> (forall x. Rep Location x -> Location) -> Generic Location
forall x. Rep Location x -> Location
forall x. Location -> Rep Location x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Location -> Rep Location x
from :: forall x. Location -> Rep Location x
$cto :: forall x. Rep Location x -> Location
to :: forall x. Rep Location x -> Location
Generic, [Location] -> Value
[Location] -> Encoding
Location -> Bool
Location -> Value
Location -> Encoding
(Location -> Value)
-> (Location -> Encoding)
-> ([Location] -> Value)
-> ([Location] -> Encoding)
-> (Location -> Bool)
-> ToJSON Location
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: Location -> Value
toJSON :: Location -> Value
$ctoEncoding :: Location -> Encoding
toEncoding :: Location -> Encoding
$ctoJSONList :: [Location] -> Value
toJSONList :: [Location] -> Value
$ctoEncodingList :: [Location] -> Encoding
toEncodingList :: [Location] -> Encoding
$comitField :: Location -> Bool
omitField :: Location -> Bool
ToJSON, Maybe Location
Value -> Parser [Location]
Value -> Parser Location
(Value -> Parser Location)
-> (Value -> Parser [Location])
-> Maybe Location
-> FromJSON Location
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser Location
parseJSON :: Value -> Parser Location
$cparseJSONList :: Value -> Parser [Location]
parseJSONList :: Value -> Parser [Location]
$comittedField :: Maybe Location
omittedField :: Maybe Location
FromJSON, Eq Location
Eq Location =>
(Location -> Location -> Ordering)
-> (Location -> Location -> Bool)
-> (Location -> Location -> Bool)
-> (Location -> Location -> Bool)
-> (Location -> Location -> Bool)
-> (Location -> Location -> Location)
-> (Location -> Location -> Location)
-> Ord Location
Location -> Location -> Bool
Location -> Location -> Ordering
Location -> Location -> Location
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Location -> Location -> Ordering
compare :: Location -> Location -> Ordering
$c< :: Location -> Location -> Bool
< :: Location -> Location -> Bool
$c<= :: Location -> Location -> Bool
<= :: Location -> Location -> Bool
$c> :: Location -> Location -> Bool
> :: Location -> Location -> Bool
$c>= :: Location -> Location -> Bool
>= :: Location -> Location -> Bool
$cmax :: Location -> Location -> Location
max :: Location -> Location -> Location
$cmin :: Location -> Location -> Location
min :: Location -> Location -> Location
Ord )