Position.hs

{-# 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 {lcpLine :: !Int, lcpColumn :: !Int, lcpPos :: !Int}
  deriving (Eq, 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 l c _) (LineColPos l' c' _) =
    compare l l' `mappend` compare c c'

instance ToJSON LineColPos where
  -- this generates a Value
  toJSON (LineColPos line col p) =
    object ["line" .= line, "column" .= col, "pos" .= p]

#if MIN_VERSION_aeson(0,10,0)
  -- this encodes directly to a bytestring Builder
  toEncoding (LineColPos line col p) =
    pairs ("line" .= line <> "column" .= col <> "pos" .= p)
#endif

instance FromJSON LineColPos where
  parseJSON = withObject "LineColPos" $ \v ->
    LineColPos
      <$> v .: "line"
      <*> v .: "column"
      <*> v .: "pos"

data Region = Region {rgStart :: !LineColPos, rgEnd :: !LineColPos}
  deriving (Eq, Show, Generic)

-- Ord instance defined explicitly for clarity.
instance Ord Region where
  compare (Region s e) (Region s' e') =
    compare s s' `mappend` compare e e'

instance ToJSON Region
instance FromJSON Region

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

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

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

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

-- | Whether the first region ends before the second region ends
beforeEnd :: Region -> Region -> Bool
beforeEnd (Region _ (LineColPos _ _ p)) (Region _ (LineColPos _ _ p')) = p < 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 _ (LineColPos l _ _)) (Region _ (LineColPos l' _ _)) = l <= 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 lr rr = case (rgEnd lr, rgStart rr) of
  (_, LineColPos 0 0 0) -> lr
  (LineColPos l c _, LineColPos l' c' _)
    | l' > l || (l' == l && c' > c) -> lr
    | otherwise -> Region (rgStart lr) (rgStart rr)