gistfile1.hs

{-# LANGUAGE FlexibleContexts, NoMonomorphismRestriction, ViewPatterns,
             FlexibleInstances, MultiParamTypeClasses #-}
{-# OPTIONS_GHC -Wall #-}


-- | Lexer/Parsec interface
module Text.Parsec.LTok where


import Language.Lua.Lexer
import Language.Lua.Token

import Text.Parsec hiding (satisfy)
import Text.Parsec.Indentation


newtype LTok' = LTok' [LTok]

instance Monad m => Stream LTok' m (LToken, Indentation) where
    uncons (LTok' ((t, Right (AlexPn _ _ c)) : rest)) = return (Just ((t, c), LTok' rest))
    uncons (LTok' ((_, Left _) : _))                  = return Nothing
    uncons (LTok' [])                                 = return Nothing


-- | This parser succeeds whenever the given predicate returns true when called with
-- parsed `LTok`. Same as 'Text.Parsec.Char.satisfy'.
satisfy :: Stream (IndentStream LTok') m LToken => (LToken -> Bool) -> ParsecT (IndentStream LTok') u m LToken
satisfy f = tokenPrim show nextPos tokeq
  where
    nextPos :: SourcePos -> LToken -> IndentStream LTok' -> SourcePos
    nextPos pos _ (tokenStream -> LTok' ((_, Right (AlexPn _ l c)) : _)) = setSourceColumn (setSourceLine pos l) c
    nextPos pos _ (tokenStream -> LTok' ((_, Left _) : _))               = pos -- TODO: ??
    nextPos pos _ (tokenStream -> LTok' [])                              = pos

    tokeq :: LToken -> Maybe LToken
    tokeq t = if f t then Just t else Nothing


-- | Parses given `LToken`.
tok :: Stream (IndentStream LTok') m LToken => LToken -> ParsecT (IndentStream LTok') u m LToken
tok t = satisfy (== t) <?> show t


-- | Parses a `LTokIdent`.
anyIdent :: Stream (IndentStream LTok') m LToken => ParsecT (IndentStream LTok') u m LToken
anyIdent = satisfy p <?> "ident"
  where
    p LTokIdent{} = True
    p _           = False


-- | Parses a `LTokNum`.
anyNum :: Stream (IndentStream LTok') m LToken => ParsecT (IndentStream LTok') u m LToken
anyNum = satisfy p <?> "number"
  where
    p LTokNum{} = True
    p _         = False


-- | Parses a `LTokSLit`.
string :: Stream (IndentStream LTok') m LToken => ParsecT (IndentStream LTok') u m LToken
string = satisfy p <?> "string"
  where
    p LTokSLit{} = True
    p _          = False