{----

Monadic parser combinators which incorporate lexing. Includes
combinator for offside rule.

----}

module LexingOff where

import Control.Monad.State
import Control.Monad.Reader
import MonParserOff

--
-- Combinators for parsing a language
--
spaces :: Parser ()
spaces = do many1 (sat isSpace); return () where
    isSpace x = x == ' ' || x == '\n' || x == '\t'

comment :: Parser ()
comment = do string "--"; many' (sat (/= '\n')); return ()

bigComment :: Parser ()
bigComment = do 
    bracket (string "{-") (many' (bigComment +++ notEndComment)) (string "-}")
    return () 
  where
    notEndComment = do sat (/= '-') +++ (do char '-'; sat (/= '}')); return ()

junk :: Parser ()
junk = do 
    local (\_ -> (0, -1)) $ many' (spaces +++ comment +++ bigComment) 
    return ()

parse :: Parser a -> Parser a
parse p = do junk; p

token :: Parser a -> Parser a
token p = do v <- p; junk; return v

natural :: Parser Int
natural = token nat

integer :: Parser Int
integer = token int

symbol :: String -> Parser String
symbol x = token (string x)

identifier :: [String] -> Parser String
identifier ks = token (do x <- first ident; if not (elem x ks) then return x else mzero)


off :: Parser a -> Parser a
off p = do
    (dl, dc) <- ask
    ((l, c), _) <- get
    if c == dc then local (\_ -> (l, dc)) p else mzero

many1_offside :: Parser a -> Parser [a]
many1_offside p = do
    (pos, _) <- get
    local (\_ -> pos) $ many1' (do{ symbol ";"; p} +++ off p)