{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
-- | Source position and span information
--
--   Mostly taken from purescript's SourcePos definition.
module Source.Span
( Span(..)
, point
, spanFromSrcLoc
, Pos(..)
, line_
, column_
, HasSpan(..)
) where

import           Control.DeepSeq (NFData)
import           Data.Aeson ((.:), (.=))
import qualified Data.Aeson as A
import           Data.Hashable (Hashable)
import           GHC.Generics (Generic)
import           GHC.Stack (SrcLoc (..))

-- | A Span of position information
data Span = Span
  { Span -> Pos
start :: {-# UNPACK #-} !Pos
  , Span -> Pos
end   :: {-# UNPACK #-} !Pos
  }
  deriving (Span -> Span -> Bool
(Span -> Span -> Bool) -> (Span -> Span -> Bool) -> Eq Span
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Span -> Span -> Bool
$c/= :: Span -> Span -> Bool
== :: Span -> Span -> Bool
$c== :: Span -> Span -> Bool
Eq, Eq Span
Eq Span
-> (Span -> Span -> Ordering)
-> (Span -> Span -> Bool)
-> (Span -> Span -> Bool)
-> (Span -> Span -> Bool)
-> (Span -> Span -> Bool)
-> (Span -> Span -> Span)
-> (Span -> Span -> Span)
-> Ord Span
Span -> Span -> Bool
Span -> Span -> Ordering
Span -> Span -> Span
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 :: Span -> Span -> Span
$cmin :: Span -> Span -> Span
max :: Span -> Span -> Span
$cmax :: Span -> Span -> Span
>= :: Span -> Span -> Bool
$c>= :: Span -> Span -> Bool
> :: Span -> Span -> Bool
$c> :: Span -> Span -> Bool
<= :: Span -> Span -> Bool
$c<= :: Span -> Span -> Bool
< :: Span -> Span -> Bool
$c< :: Span -> Span -> Bool
compare :: Span -> Span -> Ordering
$ccompare :: Span -> Span -> Ordering
Ord, (forall x. Span -> Rep Span x)
-> (forall x. Rep Span x -> Span) -> Generic Span
forall x. Rep Span x -> Span
forall x. Span -> Rep Span x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Span x -> Span
$cfrom :: forall x. Span -> Rep Span x
Generic, Int -> Span -> ShowS
[Span] -> ShowS
Span -> String
(Int -> Span -> ShowS)
-> (Span -> String) -> ([Span] -> ShowS) -> Show Span
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Span] -> ShowS
$cshowList :: [Span] -> ShowS
show :: Span -> String
$cshow :: Span -> String
showsPrec :: Int -> Span -> ShowS
$cshowsPrec :: Int -> Span -> ShowS
Show)

instance Hashable Span
instance NFData   Span

instance Semigroup Span where
  Span Pos
start1 Pos
end1 <> :: Span -> Span -> Span
<> Span Pos
start2 Pos
end2 = Pos -> Pos -> Span
Span (Pos -> Pos -> Pos
forall a. Ord a => a -> a -> a
min Pos
start1 Pos
start2) (Pos -> Pos -> Pos
forall a. Ord a => a -> a -> a
max Pos
end1 Pos
end2)

instance A.ToJSON Span where
  toJSON :: Span -> Value
toJSON Span
s = [Pair] -> Value
A.object
    [ Key
"start" Key -> Pos -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Span -> Pos
start Span
s
    , Key
"end"   Key -> Pos -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Span -> Pos
end   Span
s
    ]

instance A.FromJSON Span where
  parseJSON :: Value -> Parser Span
parseJSON = String -> (Object -> Parser Span) -> Value -> Parser Span
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"Span" ((Object -> Parser Span) -> Value -> Parser Span)
-> (Object -> Parser Span) -> Value -> Parser Span
forall a b. (a -> b) -> a -> b
$ \Object
o -> Pos -> Pos -> Span
Span
    (Pos -> Pos -> Span) -> Parser Pos -> Parser (Pos -> Span)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Pos
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"start"
    Parser (Pos -> Span) -> Parser Pos -> Parser Span
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Pos
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"end"

-- | Construct a Span with a given value for both its start and end positions.
point :: Pos -> Span
point :: Pos -> Span
point Pos
p = Pos -> Pos -> Span
Span Pos
p Pos
p

spanFromSrcLoc :: SrcLoc -> Span
spanFromSrcLoc :: SrcLoc -> Span
spanFromSrcLoc SrcLoc
s = Pos -> Pos -> Span
Span (Int -> Int -> Pos
Pos (SrcLoc -> Int
srcLocStartLine SrcLoc
s) (SrcLoc -> Int
srcLocStartCol SrcLoc
s)) (Int -> Int -> Pos
Pos (SrcLoc -> Int
srcLocEndLine SrcLoc
s) (SrcLoc -> Int
srcLocEndCol SrcLoc
s))


-- | Source position information.
-- The 'Pos' values associated with ASTs returned from tree-sitter
-- 'Unmarshal' instances are zero-indexed. Unless you are displaying
-- span information to a user, you should write your code assuming
-- zero-indexing.
data Pos = Pos
  { Pos -> Int
line   :: {-# UNPACK #-} !Int
  , Pos -> Int
column :: {-# UNPACK #-} !Int
  }
  deriving (Pos -> Pos -> Bool
(Pos -> Pos -> Bool) -> (Pos -> Pos -> Bool) -> Eq Pos
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Pos -> Pos -> Bool
$c/= :: Pos -> Pos -> Bool
== :: Pos -> Pos -> Bool
$c== :: Pos -> Pos -> Bool
Eq, Eq Pos
Eq Pos
-> (Pos -> Pos -> Ordering)
-> (Pos -> Pos -> Bool)
-> (Pos -> Pos -> Bool)
-> (Pos -> Pos -> Bool)
-> (Pos -> Pos -> Bool)
-> (Pos -> Pos -> Pos)
-> (Pos -> Pos -> Pos)
-> Ord Pos
Pos -> Pos -> Bool
Pos -> Pos -> Ordering
Pos -> Pos -> Pos
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 :: Pos -> Pos -> Pos
$cmin :: Pos -> Pos -> Pos
max :: Pos -> Pos -> Pos
$cmax :: Pos -> Pos -> Pos
>= :: Pos -> Pos -> Bool
$c>= :: Pos -> Pos -> Bool
> :: Pos -> Pos -> Bool
$c> :: Pos -> Pos -> Bool
<= :: Pos -> Pos -> Bool
$c<= :: Pos -> Pos -> Bool
< :: Pos -> Pos -> Bool
$c< :: Pos -> Pos -> Bool
compare :: Pos -> Pos -> Ordering
$ccompare :: Pos -> Pos -> Ordering
Ord, (forall x. Pos -> Rep Pos x)
-> (forall x. Rep Pos x -> Pos) -> Generic Pos
forall x. Rep Pos x -> Pos
forall x. Pos -> Rep Pos x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Pos x -> Pos
$cfrom :: forall x. Pos -> Rep Pos x
Generic, Int -> Pos -> ShowS
[Pos] -> ShowS
Pos -> String
(Int -> Pos -> ShowS)
-> (Pos -> String) -> ([Pos] -> ShowS) -> Show Pos
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Pos] -> ShowS
$cshowList :: [Pos] -> ShowS
show :: Pos -> String
$cshow :: Pos -> String
showsPrec :: Int -> Pos -> ShowS
$cshowsPrec :: Int -> Pos -> ShowS
Show)

instance Hashable Pos
instance NFData   Pos

instance A.ToJSON Pos where
  toJSON :: Pos -> Value
toJSON Pos
p = [Int] -> Value
forall a. ToJSON a => a -> Value
A.toJSON
    [ Pos -> Int
line   Pos
p
    , Pos -> Int
column Pos
p
    ]

instance A.FromJSON Pos where
  parseJSON :: Value -> Parser Pos
parseJSON Value
arr = do
    [ Int
line, Int
col ] <- Value -> Parser [Int]
forall a. FromJSON a => Value -> Parser a
A.parseJSON Value
arr
    Pos -> Parser Pos
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pos -> Parser Pos) -> Pos -> Parser Pos
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Pos
Pos Int
line Int
col

line_, column_ :: Lens' Pos Int
line_ :: Lens' Pos Int
line_   = (Pos -> Int) -> (Pos -> Int -> Pos) -> Lens' Pos Int
forall s a. (s -> a) -> (s -> a -> s) -> Lens' s a
lens Pos -> Int
line   (\Pos
p Int
l -> Pos
p { line :: Int
line   = Int
l })
column_ :: Lens' Pos Int
column_ = (Pos -> Int) -> (Pos -> Int -> Pos) -> Lens' Pos Int
forall s a. (s -> a) -> (s -> a -> s) -> Lens' s a
lens Pos -> Int
column (\Pos
p Int
l -> Pos
p { column :: Int
column = Int
l })


-- | "Classy-fields" interface for data types that have spans.
class HasSpan a where
  span_ :: Lens' a Span

  start_ :: Lens' a Pos
  start_ = (Span -> f Span) -> a -> f a
forall a. HasSpan a => Lens' a Span
span_((Span -> f Span) -> a -> f a)
-> ((Pos -> f Pos) -> Span -> f Span) -> (Pos -> f Pos) -> a -> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Pos -> f Pos) -> Span -> f Span
forall a. HasSpan a => Lens' a Pos
start_
  {-# INLINE start_ #-}

  end_ :: Lens' a Pos
  end_ = (Span -> f Span) -> a -> f a
forall a. HasSpan a => Lens' a Span
span_((Span -> f Span) -> a -> f a)
-> ((Pos -> f Pos) -> Span -> f Span) -> (Pos -> f Pos) -> a -> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Pos -> f Pos) -> Span -> f Span
forall a. HasSpan a => Lens' a Pos
end_
  {-# INLINE end_ #-}

instance HasSpan Span where
  span_ :: Lens' Span Span
span_  = (Span -> f Span) -> Span -> f Span
forall a. a -> a
id
  {-# INLINE span_ #-}

  start_ :: Lens' Span Pos
start_ = (Span -> Pos) -> (Span -> Pos -> Span) -> Lens' Span Pos
forall s a. (s -> a) -> (s -> a -> s) -> Lens' s a
lens Span -> Pos
start (\Span
s Pos
t -> Span
s { start :: Pos
start = Pos
t })
  {-# INLINE start_ #-}

  end_ :: Lens' Span Pos
end_   = (Span -> Pos) -> (Span -> Pos -> Span) -> Lens' Span Pos
forall s a. (s -> a) -> (s -> a -> s) -> Lens' s a
lens Span -> Pos
end   (\Span
s Pos
t -> Span
s { end :: Pos
end   = Pos
t })
  {-# INLINE end_ #-}


type Lens' s a = forall f . Functor f => (a -> f a) -> (s -> f s)

lens :: (s -> a) -> (s -> a -> s) -> Lens' s a
lens :: forall s a. (s -> a) -> (s -> a -> s) -> Lens' s a
lens s -> a
get s -> a -> s
put a -> f a
afa s
s = (a -> s) -> f a -> f s
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (s -> a -> s
put s
s) (a -> f a
afa (s -> a
get s
s))
{-# INLINE lens #-}