{-# LANGUAGE TypeOperators #-}

-- | Provides position information in 'Parsec' parsers that work on 'Symbol' streams.
module BoundsParser (Range, contains, Bounds(..), getLeftBounds, getRightBounds, mkBounds) where

import Token

import qualified Text.Parsec as P
import qualified Text.Parsec.Pos as PP

-- Invariant: Parsec position equals left side of outer range.
-- Maybe later: Parsec position equals left side of inner range? Will yield nicer error messages, but is troublesome for first token.

-- Some types

-- | A text selection: (start, end), 0-relative. The size of a range is defined as @end - start@.
type Range = (Int, Int)

-- | Bounds of a subexpression. The outer bounds exclude whitespace while the inner bounds don't.
data Bounds = Bounds { outerBounds :: Range, innerBounds :: Range }
  deriving (Eq, Show)

-- | Check whether the second range completely contains the first range.
contains :: Range -> Range -> Bool
contains (outer0, outer1) (inner0, inner1) = outer0 <= inner0 && inner1 <= outer1

-- -- | Provides search hints for bound annotations based on a query range.
-- searchRange :: Range -> Bounds -> SearchHint
-- searchRange query bounds
--   | outerBounds bounds `contains` query &&
--       query `contains` innerBounds bounds   = Here
--   | innerBounds bounds `contains` query     = Down
--   | otherwise                               = Skip

-- -- | Given a parser that produces a tree, annotate the result with bounds if necessary.
-- mark :: (Symbol t, Show t, P.Stream s m t) =>
--   P.ParsecT s u m (WithBounds f `Either` f (WithBounds f)) -> P.ParsecT s u m (WithBounds f)
-- mark p = do
--   leftBounds <- getLeftBounds
--   eith <- p
--   case eith of
--     Left wf   -> return wf
--     Right fwf -> do
--       rightBounds <- getRightBounds
--       (return . InF . CompF) (mkBounds leftBounds rightBounds, fwf)

-- | Yields the left outer and left inner bound of the to be parser subexpression.
getLeftBounds :: (Show t, P.Stream s m t, Symbol t) => P.ParsecT s u m (Int, Int)
getLeftBounds = do
  leftOuter <- getOffset
  Just la <- lookAhead1
  let leftInner = leftOuter + spaceBeforeSize la
  return (leftOuter, leftInner)

-- | Yields the right inner and right outer bound of the just parsed subexpression.
getRightBounds :: (Show t, P.Stream s m t, Symbol t) => P.ParsecT s u m (Int, Int)
getRightBounds = do
  rightInner <- getOffset
  mla <- lookAhead1
  let rightOuter = case mla of
        Nothing -> rightInner
        Just la -> rightInner + spaceBeforeSize la
  return (rightInner, rightOuter)

-- | Creates a 'Bounds' object from the results of 'getLeftBounds' and 'getRightBounds'.
mkBounds :: (Int, Int) -> (Int, Int) -> Bounds
mkBounds (leftOuter, leftInner) (rightInner, rightOuter) =
  Bounds (leftOuter, rightOuter) (leftInner, rightInner)

lookAhead1 :: (Show t, P.Stream s m t) => P.ParsecT s u m (Maybe t)
lookAhead1 = P.lookAhead (P.optionMaybe P.anyToken)

getOffset :: Monad m => P.ParsecT s u m Int
getOffset = (pred . PP.sourceColumn) `fmap` P.getPosition