{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeApplications #-}

-- |
-- Module      : Error.Diagnose.Diagnostic
-- Description : Defines location information as a simple record.
-- Copyright   : (c) Mesabloo, 2021-2022
-- License     : BSD3
-- Stability   : experimental
-- Portability : Portable
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)

-- import Text.PrettyPrint.ANSI.Leijen (Pretty(..), text, colon, int)

-- | Contains information about the location of something.
--
--   It is best used in a datatype like:
--
--   > data Located a
--   >   = a :@ Position
--   >   deriving (Show, Eq, Ord, Functor, Traversable)
--
--   Columns are specified in amount of Unicode codepoints from the beginning of the line.
--   Lines and columns start at 1.
data Position = Position
  { -- | The beginning line and column of the span.
    Position -> (Int, Int)
begin :: (Int, Int),
    -- | The end line and column of the span.
    Position -> (Int, Int)
end :: (Int, Int),
    -- | The file this position spans in.
    Position -> FilePath
file :: FilePath
  }
  deriving (Int -> Position -> ShowS
[Position] -> ShowS
Position -> FilePath
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
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, Eq Position
Position -> Position -> Bool
Position -> Position -> Ordering
Position -> Position -> Position
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
min :: Position -> Position -> Position
$cmin :: Position -> Position -> Position
max :: Position -> Position -> Position
$cmax :: Position -> Position -> Position
>= :: Position -> Position -> Bool
$c>= :: Position -> Position -> Bool
> :: Position -> Position -> Bool
$c> :: Position -> Position -> Bool
<= :: Position -> Position -> Bool
$c<= :: Position -> Position -> Bool
< :: Position -> Position -> Bool
$c< :: Position -> Position -> Bool
compare :: Position -> Position -> Ordering
$ccompare :: Position -> Position -> Ordering
Ord, 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 Pretty Position where
  pretty :: forall ann. Position -> Doc ann
pretty (Position (Int
bl, Int
bc) (Int
el, Int
ec) FilePath
f) = forall a ann. Pretty a => a -> Doc ann
pretty FilePath
f forall a. Semigroup a => a -> a -> a
<> forall {ann}. Doc ann
at forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty Int
bl forall a. Semigroup a => a -> a -> a
<> forall {ann}. Doc ann
colon forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty Int
bc forall a. Semigroup a => a -> a -> a
<> forall {ann}. Doc ann
dash forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty Int
el forall a. Semigroup a => a -> a -> a
<> forall {ann}. Doc ann
colon forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty Int
ec
    where
      at :: Doc ann
at = forall a ann. Pretty a => a -> Doc ann
pretty @String FilePath
"@"
      dash :: Doc ann
dash = 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 [ Key
"beginning" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> Value
object [ Key
"line" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Int
bl, Key
"column" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Int
bc ]
           , Key
"end" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> Value
object [ Key
"line" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Int
el, Key
"column" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Int
ec ]
           , Key
"file" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= FilePath
file
           ]
#endif