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
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)
genitive :: Stream s m Token => ParsecT s u m Bool
genitive =
satisfy
(\t ->
case t of
Genitive _ hasS -> Just hasS
_ -> Nothing)
number :: Stream s m Token => ParsecT s u m Integer
number =
satisfy
(\t ->
case t of
Number _ t' -> Just t'
_ -> Nothing)
quoted :: Stream s m Token => ParsecT s u m Text
quoted =
satisfy
(\t ->
case t of
QuotedString _ t' -> Just t'
_ -> Nothing)
comma :: Stream s m Token => ParsecT s u m ()
comma =
satisfy
(\t ->
case t of
Comma _ -> Just ()
_ -> Nothing)
period :: Stream s m Token => ParsecT s u m ()
period =
satisfy
(\t ->
case t of
Period _ -> Just ()
_ -> Nothing)
strings :: Stream s m Token => [Text] -> ParsecT s u m ()
strings ss =
try (sequence_ (map string ss))
satisfy :: Stream s m Token => (Token -> Maybe a) -> ParsecT s u m a
satisfy f =
tokenPrim tokenString
tokenPosition
f
anyToken :: (Stream s m Token) => ParsecT s u m Token
anyToken = satisfy Just
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
tokenPosition :: SourcePos -> Token -> t -> SourcePos
tokenPosition pos t _ =
setSourceColumn (setSourceLine pos line) col
where (line,col) = tokenPos t
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 ())
eof :: (Stream s m Token) => ParsecT s u m ()
eof = notFollowedBy anyToken <?> "end of input"