{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeApplications #-}
module Error.Diagnose.Position (Position (..)) where
#ifdef USE_AESON
import Data.Aeson (ToJSON(..), object, (.=))
#endif
import Data.Default (Default, def)
import Data.Hashable (Hashable)
import GHC.Generics (Generic (..))
import Prettyprinter (Pretty (..), colon)
data Position = Position
{
Position -> (Int, Int)
begin :: (Int, Int),
Position -> (Int, Int)
end :: (Int, Int),
Position -> FilePath
file :: FilePath
}
deriving (Int -> Position -> ShowS
[Position] -> ShowS
Position -> FilePath
(Int -> Position -> ShowS)
-> (Position -> FilePath) -> ([Position] -> ShowS) -> Show Position
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Position] -> ShowS
$cshowList :: [Position] -> ShowS
show :: Position -> FilePath
$cshow :: Position -> FilePath
showsPrec :: Int -> Position -> ShowS
$cshowsPrec :: Int -> Position -> ShowS
Show, Position -> Position -> Bool
(Position -> Position -> Bool)
-> (Position -> Position -> Bool) -> Eq Position
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Position -> Position -> Bool
$c/= :: Position -> Position -> Bool
== :: Position -> Position -> Bool
$c== :: Position -> Position -> Bool
Eq, (forall x. Position -> Rep Position x)
-> (forall x. Rep Position x -> Position) -> Generic Position
forall x. Rep Position x -> Position
forall x. Position -> Rep Position x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Position x -> Position
$cfrom :: forall x. Position -> Rep Position x
Generic)
instance Ord Position where
Position (Int, Int)
b1 (Int, Int)
e1 FilePath
_ compare :: Position -> Position -> Ordering
`compare` Position (Int, Int)
b2 (Int, Int)
e2 FilePath
_ = ((Int, Int)
b1, (Int, Int)
e1) ((Int, Int), (Int, Int)) -> ((Int, Int), (Int, Int)) -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` ((Int, Int)
b2, (Int, Int)
e2)
instance Pretty Position where
pretty :: Position -> Doc ann
pretty (Position (Int
bl, Int
bc) (Int
el, Int
ec) FilePath
f) = FilePath -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty FilePath
f Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
at Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Int -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Int
bl Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
colon Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Int -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Int
bc Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
dash Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Int -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Int
el Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
colon Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Int -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Int
ec
where
at :: Doc ann
at = FilePath -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty @String FilePath
"@"
dash :: Doc ann
dash = FilePath -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty @String FilePath
"-"
instance Hashable Position
instance Default Position where
def :: Position
def = (Int, Int) -> (Int, Int) -> FilePath -> Position
Position (Int
1, Int
1) (Int
1, Int
1) FilePath
"<no-file>"
#ifdef USE_AESON
instance ToJSON Position where
toJSON :: Position -> Value
toJSON (Position (Int
bl, Int
bc) (Int
el, Int
ec) FilePath
file) =
[Pair] -> Value
object [ Text
"beginning" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Pair] -> Value
object [ Text
"line" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Int
bl, Text
"column" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Int
bc ]
, Text
"end" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Pair] -> Value
object [ Text
"line" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Int
el, Text
"column" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Int
ec ]
, Text
"file" Text -> FilePath -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= FilePath
file
]
#endif