{-# 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
-- 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
(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