module Annotations.BoundsParser
(
Symbol(..), collapse,
P, satisfy, pToken, getPos
) where
import Annotations.Bounds
import qualified Text.Parsec as P
import qualified Text.Parsec.Pos as P
class Symbol s where
unparse :: s -> String
symbolSize :: s -> Int
symbolSize = length . unparse
instance Symbol s => Symbol [s] where
unparse = concatMap unparse
symbolSize = sum . fmap symbolSize
collapse :: Symbol s => (s -> Bool) -> [s] -> [(s, Bounds)]
collapse space ts = collapse' (0, symbolSize lefts) space rest
where
(lefts, rest) = span space ts
collapse' :: Symbol s => Range -> (s -> Bool) -> [s] -> [(s, Bounds)]
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 left right)
type P s = P.ParsecT [(s, Bounds)] Range
getPos :: Monad m => P s m Range
getPos = P.getState
satisfy :: (Monad m, Symbol s) => (s -> Bool) -> P s m s
satisfy ok = do
let pos _ (_, bounds) _ = P.newPos "" 0 (fst (rightMargin bounds) + 1)
let match x@(tok, _)
| ok tok = Just x
| otherwise = Nothing
(tok, bounds) <- P.tokenPrim (unparse . fst) pos match
P.setState (rightMargin bounds)
return tok
pToken :: (Monad m, Symbol s, Eq s) => s -> P s m s
pToken = satisfy . (==)