Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
branch: master
Fetching contributors…

Cannot retrieve contributors at this time

129 lines (111 sloc) 3.624 kb
{-# LANGUAGE FlexibleContexts #-}
-- | Parser combinators.
module ACE.Combinators where
import ACE.Types.Tokens
import Data.Text (Text)
import qualified Data.Text as T
import Text.Parsec.Pos
import Text.Parsec.Prim
-- | Match a word with the given string.
string :: Stream s m Token => Text -> ParsecT s u m Text
string s =
satisfy
(\t ->
case t of
Word _ t' -> if t' == s then Just t' else Nothing
_ -> Nothing)
-- | Match a Saxon genitive.
genitive :: Stream s m Token => ParsecT s u m Bool
genitive =
satisfy
(\t ->
case t of
Genitive _ hasS -> Just hasS
_ -> Nothing)
-- | Match a word with the given string.
number :: Stream s m Token => ParsecT s u m Integer
number =
satisfy
(\t ->
case t of
Number _ t' -> Just t'
_ -> Nothing)
-- | Quoted string.
quoted :: Stream s m Token => ParsecT s u m Text
quoted =
satisfy
(\t ->
case t of
QuotedString _ t' -> Just t'
_ -> Nothing)
-- | A comma.
comma :: Stream s m Token => ParsecT s u m ()
comma =
satisfy
(\t ->
case t of
Comma _ -> Just ()
_ -> Nothing)
-- | A period.
period :: Stream s m Token => ParsecT s u m ()
period =
satisfy
(\t ->
case t of
Period _ -> Just ()
_ -> Nothing)
-- | Try to match all the given strings, or none at all.
strings :: Stream s m Token => [Text] -> ParsecT s u m ()
strings ss =
try (sequence_ (map string ss))
-- | Satisfy the given predicate from the token stream.
satisfy :: Stream s m Token => (Token -> Maybe a) -> ParsecT s u m a
satisfy f =
tokenPrim tokenString
tokenPosition
f
-- | The parser @anyToken@ accepts any kind of token. It is for example
-- used to implement 'eof'. Returns the accepted token.
anyToken :: (Stream s m Token) => ParsecT s u m Token
anyToken = satisfy Just
-- | Make a string out of the token, for error message purposes.
tokenString :: Token -> [Char]
tokenString t =
case t of
Word _ w -> "word \"" ++ T.unpack w ++ "\""
QuotedString _ s -> "quotation \"" ++ T.unpack s ++ "\""
Period{} -> "period"
Comma{} -> "comma"
QuestionMark{} -> "question mark"
Genitive _ s ->
if s
then "genitive 's"
else "genitive '"
Number _ n -> "number: " ++ show n
-- | Update the position by the token.
tokenPosition :: SourcePos -> Token -> t -> SourcePos
tokenPosition pos t _ =
setSourceColumn (setSourceLine pos line) col
where (line,col) = tokenPos t
-- | @notFollowedBy p@ only succeeds when parser @p@ fails. This parser
-- does not consume any input. This parser can be used to implement the
-- \'longest match\' rule. For example, when recognizing keywords (for
-- example @let@), we want to make sure that a keyword is not followed
-- by a legal identifier character, in which case the keyword is
-- actually an identifier (for example @lets@). We can program this
-- behaviour as follows:
--
-- > keywordLet = try (do{ string "let"
-- > ; notFollowedBy alphaNum
-- > })
notFollowedBy :: (Stream s m Token) => ParsecT s u m Token -> ParsecT s u m ()
notFollowedBy p =
try ((do c <- try p
unexpected (tokenString c)) <|>
return ())
-- | This parser only succeeds at the end of the input. This is not a
-- primitive parser but it is defined using 'notFollowedBy'.
--
-- > eof = notFollowedBy anyToken <?> "end of input"
eof :: (Stream s m Token) => ParsecT s u m ()
eof = notFollowedBy anyToken <?> "end of input"
Jump to Line
Something went wrong with that request. Please try again.