{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}

-- | Reimplements the LineColPos from `uu-parsinglib`, and adds some more functions related to
-- positioning.
module GLua.Position where

import Data.Aeson
import GHC.Generics (Generic)

data LineColPos = LineColPos {LineColPos -> Int
lcpLine :: !Int, LineColPos -> Int
lcpColumn :: !Int, LineColPos -> Int
lcpPos :: !Int}
  deriving (LineColPos -> LineColPos -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LineColPos -> LineColPos -> Bool
$c/= :: LineColPos -> LineColPos -> Bool
== :: LineColPos -> LineColPos -> Bool
$c== :: LineColPos -> LineColPos -> Bool
Eq, Int -> LineColPos -> ShowS
[LineColPos] -> ShowS
LineColPos -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LineColPos] -> ShowS
$cshowList :: [LineColPos] -> ShowS
show :: LineColPos -> String
$cshow :: LineColPos -> String
showsPrec :: Int -> LineColPos -> ShowS
$cshowsPrec :: Int -> LineColPos -> ShowS
Show)

-- The order depends on line and column, not the position, though this should not make a difference
-- when both LineColPoses are from the same file.
instance Ord LineColPos where
  compare :: LineColPos -> LineColPos -> Ordering
compare (LineColPos Int
l Int
c Int
_) (LineColPos Int
l' Int
c' Int
_) =
    forall a. Ord a => a -> a -> Ordering
compare Int
l Int
l' forall a. Monoid a => a -> a -> a
`mappend` forall a. Ord a => a -> a -> Ordering
compare Int
c Int
c'

instance ToJSON LineColPos where
  -- this generates a Value
  toJSON :: LineColPos -> Value
toJSON (LineColPos Int
line Int
col Int
p) =
    [Pair] -> Value
object [Key
"line" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int
line, Key
"column" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int
col, Key
"pos" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int
p]

#if MIN_VERSION_aeson(0,10,0)
  -- this encodes directly to a bytestring Builder
  toEncoding :: LineColPos -> Encoding
toEncoding (LineColPos Int
line Int
col Int
p) =
    Series -> Encoding
pairs (Key
"line" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int
line forall a. Semigroup a => a -> a -> a
<> Key
"column" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int
col forall a. Semigroup a => a -> a -> a
<> Key
"pos" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int
p)
#endif

instance FromJSON LineColPos where
  parseJSON :: Value -> Parser LineColPos
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"LineColPos" forall a b. (a -> b) -> a -> b
$ \Object
v ->
    Int -> Int -> Int -> LineColPos
LineColPos
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"line"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"column"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"pos"

data Region = Region {Region -> LineColPos
rgStart :: !LineColPos, Region -> LineColPos
rgEnd :: !LineColPos}
  deriving (Region -> Region -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Region -> Region -> Bool
$c/= :: Region -> Region -> Bool
== :: Region -> Region -> Bool
$c== :: Region -> Region -> Bool
Eq, Int -> Region -> ShowS
[Region] -> ShowS
Region -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Region] -> ShowS
$cshowList :: [Region] -> ShowS
show :: Region -> String
$cshow :: Region -> String
showsPrec :: Int -> Region -> ShowS
$cshowsPrec :: Int -> Region -> ShowS
Show, forall x. Rep Region x -> Region
forall x. Region -> Rep Region x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Region x -> Region
$cfrom :: forall x. Region -> Rep Region x
Generic)

-- Ord instance defined explicitly for clarity.
instance Ord Region where
  compare :: Region -> Region -> Ordering
compare (Region LineColPos
s LineColPos
e) (Region LineColPos
s' LineColPos
e') =
    forall a. Ord a => a -> a -> Ordering
compare LineColPos
s LineColPos
s' forall a. Monoid a => a -> a -> a
`mappend` forall a. Ord a => a -> a -> Ordering
compare LineColPos
e LineColPos
e'

instance ToJSON Region
instance FromJSON Region

-- | An empty region from position 0 to position 0.
emptyRg :: Region
emptyRg :: Region
emptyRg = LineColPos -> LineColPos -> Region
Region (Int -> Int -> Int -> LineColPos
LineColPos Int
0 Int
0 Int
0) (Int -> Int -> Int -> LineColPos
LineColPos Int
0 Int
0 Int
0)

-- | Hack: Chooses left region if it is not 'emptyRg', and the right region if it is.
rgOr :: Region -> Region -> Region
rgOr :: Region -> Region -> Region
rgOr Region
l Region
r
  | Region
l forall a. Eq a => a -> a -> Bool
== Region
emptyRg = Region
r
  | Bool
otherwise = Region
l

-- | Whether the first region ends strictly before the second region starts
before :: Region -> Region -> Bool
before :: Region -> Region -> Bool
before (Region LineColPos
_ (LineColPos Int
_ Int
_ Int
p)) (Region (LineColPos Int
_ Int
_ Int
p') LineColPos
_) = Int
p forall a. Ord a => a -> a -> Bool
< Int
p'

-- | Whether the first region ends before or on the same line as the second region starts
beforeOrOnLine :: Region -> Region -> Bool
beforeOrOnLine :: Region -> Region -> Bool
beforeOrOnLine (Region LineColPos
_ (LineColPos Int
l Int
_ Int
_)) (Region (LineColPos Int
l' Int
_ Int
_) LineColPos
_) = Int
l forall a. Ord a => a -> a -> Bool
<= Int
l'

-- | Whether the first region ends before the second region ends
beforeEnd :: Region -> Region -> Bool
beforeEnd :: Region -> Region -> Bool
beforeEnd (Region LineColPos
_ (LineColPos Int
_ Int
_ Int
p)) (Region LineColPos
_ (LineColPos Int
_ Int
_ Int
p')) = Int
p forall a. Ord a => a -> a -> Bool
< Int
p'

-- | Whether the first region ends before or on the same line as the END of the second region
beforeEndLine :: Region -> Region -> Bool
beforeEndLine :: Region -> Region -> Bool
beforeEndLine (Region LineColPos
_ (LineColPos Int
l Int
_ Int
_)) (Region LineColPos
_ (LineColPos Int
l' Int
_ Int
_)) = Int
l forall a. Ord a => a -> a -> Bool
<= Int
l'

-- | Returns a region that starts at the start of the first region
-- and ends BEFORE the start of the second region
upto :: Region -> Region -> Region
upto :: Region -> Region -> Region
upto Region
lr Region
rr = case (Region -> LineColPos
rgEnd Region
lr, Region -> LineColPos
rgStart Region
rr) of
  (LineColPos
_, LineColPos Int
0 Int
0 Int
0) -> Region
lr
  (LineColPos Int
l Int
c Int
_, LineColPos Int
l' Int
c' Int
_)
    | Int
l' forall a. Ord a => a -> a -> Bool
> Int
l Bool -> Bool -> Bool
|| (Int
l' forall a. Eq a => a -> a -> Bool
== Int
l Bool -> Bool -> Bool
&& Int
c' forall a. Ord a => a -> a -> Bool
> Int
c) -> Region
lr
    | Bool
otherwise -> LineColPos -> LineColPos -> Region
Region (Region -> LineColPos
rgStart Region
lr) (Region -> LineColPos
rgStart Region
rr)