{----
 - Positional.hs - a specialization of GParser that tracks source position
 ----
 - Author: Jesse Rudolph <jesse.rudolph@gmail.com>
 - See LICENSE for licensing details
 ----------------------------------------------------------------- -}

module Language.Noodle.Parsing.Positional
    ( getSt
    , putSt
    , modSt
    , startPos
    , getPos
    , incPos
    , incLine
    , Position
    , PosParser
    , module Language.Noodle.Parsing.Generic) where
import Language.Noodle.Parsing.Generic hiding (getSt,putSt,modSt)
import qualified Language.Noodle.Parsing.Generic as P (getSt,putSt,modSt)

type Position = (Int,Int,Int) -- (AbsPos,LinePos,LineNum)
type PosSt a = (Position,a)
type PosParser st tok res = GParser (PosSt st) tok res


-- replace our state primatives so that they go around the position closure

getSt :: PosParser st tok st
getSt = do (_,st) <- P.getSt
           return st

putSt :: st -> PosParser st tok ()
putSt st = do (pos,_) <- P.getSt
              P.putSt (pos,st)

modSt :: (st -> st) -> PosParser st tok ()
modSt f = do st <- getSt
             putSt (f st)

-- position functions

startPos :: Position
startPos = (1,1,1)

getPos :: PosParser st tok Position
getPos = do (pos,_) <- P.getSt
            return pos

-- do not export
putPos :: Position -> PosParser st tok ()
putPos npos = do st <- getSt
                 P.putSt (npos,st)

incPos :: PosParser st tok ()
incPos = do (ab,rel,lin) <- getPos
            putPos (ab+1,rel+1,lin) -- incriment absolute and line-relative position

incLine :: PosParser st tok ()
incLine = do (ab,_,lin) <- getPos
             putPos (ab+1,1,lin+1) -- incriment absolute position and line, reset line relative position to 1