Lexer.hs

{-# LANGUAGE FlexibleContexts #-}

module Lexer ( tokenize, token, tokenEq, tokenChar, tokenString
             , BaseToken, BaseLexer, BaseParser
             ) where

import Control.Applicative
import Control.Monad.Identity
import Text.Parsec hiding (token)
import qualified Text.Parsec as Parsec (token)

type BaseToken tok = (SourcePos, tok)
type BaseLexer p tok = p tok
type BaseParser tok a = Parsec [tok] () a

tokenize :: (Monad m) => ParsecT s u m tok -> ParsecT s u m (BaseToken tok)
tokenize = ((,) <$> getPosition <*>)

token :: (Show t, Stream s Identity (BaseToken t)) => (t -> Maybe a) -> Parsec s u a
token match = Parsec.token (show . snd) fst (match . snd)

tokenEq :: (Eq t, Show t, Stream s Identity (BaseToken t)) => t -> Parsec s u t
tokenEq t = token match
    where
      match t1 | t1 == t = Just t1
               | otherwise = Nothing

tokenChar :: (Stream s m Char) => a -> Char -> ParsecT s u m a
tokenChar tok c = char c >> return tok

tokenString :: (Stream s m Char) => a -> String -> ParsecT s u m a
tokenString tok s = string s >> return tok