Extra.hs

{-# LANGUAGE FlexibleContexts #-}
module Text.Parsec.Extra
  (
    eol
  , digit
  , natural
  , integer
  , caseInsensitiveChar
  , caseInsensitiveString
  , parseM
  ) where


import           Control.Applicative    ((<$>),(<*>),(<*),(*>),pure)
import           Control.Monad.Error    (ErrorType,MonadError,throwError)
import           Data.Char              (toLower,toUpper)
import           Data.List              (foldl')
import           Text.Parsec.Prim       ((<|>),(<?>),parse)
import           Text.Parsec.Combinator (many1,option)
import qualified Text.Parsec.Char as Char
import           Text.Parsec.Char       (char)
import           Text.Parsec.String     (GenParser)
import           Text.Parsec.Error      (ParseError)


-- | Parse \"end of line\": one of \"\\n\", \"\\r\\n\", or \"\\r\".
eol :: GenParser Char state ()
eol = (char '\n' <|> (char '\r' >> option '\n' (char '\n'))) >> return ()

-- | A decimal digit.
digit :: (Integral a) => GenParser Char state a
digit = fromIntegral . (\ c -> fromEnum c - fromEnum '0') <$> Char.digit

-- | A natural (i.e. non-negative integer) number, in decimal notation.
natural :: (Integral a) => GenParser Char state a
natural = (foldl' (\ a b -> a * 10 + b) 0 <$> many1 digit)
  <?> "nonnegative decimal integer"

-- | An integer number, in decimal notation (possibly prefixed with \"-\").
integer :: (Integral a) => GenParser Char state a
integer = (option id (char '-' *> pure negate) <*> natural)
  <?> "decimal integer"

-- | Parse the given character, or the same character in another case
-- (upper or lower).
caseInsensitiveChar :: Char -> GenParser Char state Char
caseInsensitiveChar c = do
  char (toLower c) <|> char (toUpper c)
  return c

-- | Parse the given string, but with any combination of upper and lower case
-- characters.
caseInsensitiveString :: String -> GenParser Char state String
caseInsensitiveString = sequence . map caseInsensitiveChar

-- | Parsing function. Uses the 'MonadError' class to throw a monadic error
-- when parsing fails. (Useful in a stack of monad transformers from the
-- transformers package <http://hackage.haskell.org/package/transformers>.)
parseM :: (MonadError m) =>
  (ParseError -> ErrorType m) -> GenParser t () a -> String -> [t] -> m a
parseM injectParseError p s = either (throwError . injectParseError) return . parse p s