{-# LANGUAGE FlexibleContexts #-} module Hcompta.Lib.Parsec where import qualified Data.Char import qualified Data.List import qualified Text.Parsec as R import Text.Parsec (Stream, ParsecT, (<|>), ()) -- * Combinators -- | Like 'Text.Parsec.choice' but with 'Text.Parsec.try' on each case. choice_try :: Stream s m t => [ParsecT s u m a] -> ParsecT s u m a choice_try = Data.List.foldr (\a -> (<|>) (R.try a)) R.parserZero -- choice_try = R.choice . Data.List.map R.try -- | Like 'Text.Parsec.sepBy' but without parsing an ending separator. many_separated :: Stream s m t => ParsecT s u m a -> ParsecT s u m b -> ParsecT s u m [a] many_separated p sep = many1_separated p sep <|> return [] -- | Like 'Text.Parsec.sepBy1' but without parsing an ending separator. many1_separated :: Stream s m t => ParsecT s u m a -> ParsecT s u m b -> ParsecT s u m [a] many1_separated p sep = do x <- p xs <- R.many (R.try (sep >> p)) return $ x:xs -- (:) <$> p <*> R.many (R.try (sep >> p)) -- | Make a 'Text.Parsec.ParsecT' also return its user state. and_state :: Stream s m t => ParsecT s u m a -> ParsecT s u m (a, u) and_state p = do a <- p s <- R.getState return (a, s) -- * Numbers -- | Return the 'Integer' obtained by multiplying the given digits -- with the power of the given base respective to their rank. integer_of_digits :: Integer -- ^ Base. -> [Char] -- ^ Digits (MUST be recognised by 'Data.Char.digitToInt'). -> Integer integer_of_digits base = Data.List.foldl (\x d -> base*x + toInteger (Data.Char.digitToInt d)) 0 decimal :: Stream s m Char => ParsecT s u m Integer decimal = integer 10 R.digit hexadecimal :: Stream s m Char => ParsecT s u m Integer hexadecimal = R.oneOf "xX" >> integer 16 R.hexDigit octal :: Stream s m Char => ParsecT s u m Integer octal = R.oneOf "oO" >> integer 8 R.octDigit -- | Parse an 'Integer'. integer :: Stream s m t => Integer -> ParsecT s u m Char -> ParsecT s u m Integer integer base digit = do digits <- R.many1 digit let n = integer_of_digits base digits seq n (return n) -- * Whites -- | Return 'True' if and only if the given 'Char' is an horizontal space. is_space_horizontal :: Char -> Bool is_space_horizontal c = c /= '\n' && c /= '\r' && Data.Char.isSpace c space_horizontal :: Stream s m Char => ParsecT s u m Char {-# INLINEABLE space_horizontal #-} space_horizontal = R.satisfy is_space_horizontal "horizontal-space" new_line :: Stream s m Char => ParsecT s u m () {-# INLINEABLE new_line #-} new_line = ((R.try (R.string "\r\n") <|> R.try (R.string "\n")) >> return ()) "newline"