-- | Types and utility functions for expression text selections.
module Annotations.Bounds
  ( -- * Symbols
    Symbol(..), collapse,
    -- * Types
    Range
  , Bounds(..), innerRange, outerRange, leftMargin, rightMargin
    -- * Membership predicates
  , posInRange, rangeInRange, rangeInBounds, rangesInBounds, distRange
  ) where


-- | Symbols form input for parsers. Minimal complete definition: 'unparse'.
class Symbol s where
  -- | Unparses a symbol, converting it back to text.
  unparse :: s -> String

  -- | Yields the size of a symbol. Default implementation is @length . unparse@.
  symbolSize :: s -> Int
  symbolSize = length . unparse

instance Symbol s => Symbol [s] where
  unparse = concatMap unparse
  symbolSize = sum . fmap symbolSize
  
-- | Given a predicate that tells what tokens to discard, keeps only the 
--   meaningful tokens and couples them with position information.
collapse :: Symbol s => (s -> Bool) -> [s] -> [(s, Bounds s)]
collapse space ts = collapse' (0, symbolSize lefts) space rest
  where
    (lefts, rest) = span space ts

collapse' :: Symbol s => Range -> (s -> Bool) -> [s] -> [(s, Bounds s)]
collapse' _ _ [] = []
collapse' left space (t:ts) = new : collapse' right space rest
  where
    (_, leftInner)  = left
    rightInner      = leftInner   + symbolSize t
    rightOuter      = rightInner  + symbolSize rights
    right           = (rightInner, rightOuter)
    (rights, rest)  = span space ts
    new             = (t, Bounds [t] [])

-- | A simple textual selection: starting offset and ending offset,
-- respectively. Offsets are 0-based.
type  Range         = (Int, Int)  -- left, right

-- | A structural selection expressed as a textual selection. The margins
-- indicate the whitespace directly around the selected structure.
data  Bounds  s      = Bounds 
  { source :: [s] 
  , previous :: [s]
  }
  deriving (Eq, Show)

leftMargin :: Bounds s -> Range  
leftMargin (Bounds s bs) = (length bs, length bs)

rightMargin :: Bounds s -> Range
rightMargin (Bounds s bs) = (length bs + length s, length bs + length s)

-- | A @Bounds@' inner range does not include the whitespace around the selected structure.
innerRange :: Symbol s => Bounds s -> Range
innerRange b@(Bounds src _) = (left, right)
  where (_, left) = leftMargin b
        (right, _) = rightMargin b

-- | A @Bounds@' outer range includes the whitespace around the selected structure.
outerRange :: Symbol s => Bounds s -> Range
outerRange b@(Bounds src _) = (left, right)
  where (_, left) = leftMargin b
        (right, _) = rightMargin b


-- | Tells whether the offset falls within the given range.
posInRange :: Int -> Range -> Bool
posInRange pos (left, right) = left <= pos && pos <= right

-- | Tells whether the first range is enclosed by the second range.
rangeInRange :: Range -> Range -> Bool
rangeInRange (left, right) range = left `posInRange` range && right `posInRange` range

-- | A range is within certain bounds if its left offset is within the bounds' 
-- left margin and its right offset is within the bounds' right margin.
rangeInBounds :: Symbol s => Range -> Bounds s -> Bool
rangeInBounds (l, r) b =
  l `posInRange` leftMargin  b &&
  r `posInRange` rightMargin b

-- | @rangesInBounds b@ yields all those ranges @r@ for which
-- @rangeInBounds r b@.
rangesInBounds :: Symbol s => Bounds s -> [Range]
rangesInBounds b = [ (l, r) | l <- [ol..il], r <- [ir..or] ]
  where (ol, il) = leftMargin b
        (ir, or) = rightMargin b

-- | A measure for the dissimilarity between two ranges.
-- 
--   @distRange (l1, r1) (l2, r2) = |l1 - l2| + |r1 - r2|@
distRange :: Range -> Range -> Int
distRange (l1, r1) (l2, r2) = abs (l1 - l2) + abs (r1 - r2)