{- |
Module      :  Text.ParserCombinators.Parsec.Char
Copyright   :  (c) Daan Leijen 1999-2001
License     :  BSD-style (see the file LICENSE)

Maintainer  :  Christian Maeder <chr.maeder@web.de>
Stability   :  provisional
Portability :  portable

Commonly used character parsers
-}

module Text.ParserCombinators.Parsec.Char
  ( CharParser
  , alphaNum
  , anyChar
  , char
  , digit
  , hexDigit
  , letter
  , lower
  , newline
  , noneOf
  , octDigit
  , oneOf
  , satisfy
  , space
  , spaces
  , string
  , tab
  , upper
  ) where

import Data.Char

import Text.ParserCombinators.Parsec.Pos (updatePosChar, updatePosString)
import Text.ParserCombinators.Parsec.Prim

{- ---------------------------------------------------------
Type of character parsers
--------------------------------------------------------- -}
type CharParser st a = GenParser Char st a

{- ---------------------------------------------------------
Character parsers
--------------------------------------------------------- -}

{- | @oneOf cs@ succeeds if the current character is in the supplied
list of characters @cs@. Returns the parsed character. See also
'satisfy'.

>   vowel  = oneOf "aeiou" -}
oneOf :: [Char] -> CharParser st Char
oneOf :: [Char] -> CharParser st Char
oneOf [Char]
cs = (Char -> Bool) -> CharParser st Char
forall st. (Char -> Bool) -> CharParser st Char
satisfy (Char -> [Char] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char]
cs)

{- | As the dual of 'oneOf', @noneOf cs@ succeeds if the current
character /not/ in the supplied list of characters @cs@. Returns the
parsed character.

>  consonant = noneOf "aeiou" -}
noneOf :: [Char] -> CharParser st Char
noneOf :: [Char] -> CharParser st Char
noneOf [Char]
cs = (Char -> Bool) -> CharParser st Char
forall st. (Char -> Bool) -> CharParser st Char
satisfy (Char -> [Char] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Char]
cs)

-- | Skips /zero/ or more white space characters. See also 'skipMany'.
spaces :: CharParser st ()
spaces :: CharParser st ()
spaces = GenParser Char st Char -> CharParser st ()
forall tok st a. GenParser tok st a -> GenParser tok st ()
skipMany GenParser Char st Char
forall st. CharParser st Char
space CharParser st () -> [Char] -> CharParser st ()
forall tok st a. GenParser tok st a -> [Char] -> GenParser tok st a
<?> [Char]
"white space"

{- | Parses a white space character (any character which satisfies 'isSpace')
Returns the parsed character. -}
space :: CharParser st Char
space :: CharParser st Char
space = (Char -> Bool) -> CharParser st Char
forall st. (Char -> Bool) -> CharParser st Char
satisfy Char -> Bool
isSpace CharParser st Char -> [Char] -> CharParser st Char
forall tok st a. GenParser tok st a -> [Char] -> GenParser tok st a
<?> [Char]
"space"

-- | Parses a newline character (\'\\n\'). Returns a newline character.
newline :: CharParser st Char
newline :: CharParser st Char
newline = Char -> CharParser st Char
forall st. Char -> CharParser st Char
char Char
'\n' CharParser st Char -> [Char] -> CharParser st Char
forall tok st a. GenParser tok st a -> [Char] -> GenParser tok st a
<?> [Char]
"new-line"

-- | Parses a tab character (\'\\t\'). Returns a tab character.
tab :: CharParser st Char
tab :: CharParser st Char
tab = Char -> CharParser st Char
forall st. Char -> CharParser st Char
char Char
'\t' CharParser st Char -> [Char] -> CharParser st Char
forall tok st a. GenParser tok st a -> [Char] -> GenParser tok st a
<?> [Char]
"tab"

{- | Parses an upper case letter  according to 'isUpper'.
Returns the parsed character. -}
upper :: CharParser st Char
upper :: CharParser st Char
upper = (Char -> Bool) -> CharParser st Char
forall st. (Char -> Bool) -> CharParser st Char
satisfy Char -> Bool
isUpper CharParser st Char -> [Char] -> CharParser st Char
forall tok st a. GenParser tok st a -> [Char] -> GenParser tok st a
<?> [Char]
"uppercase letter"

{- | Parses a lower case character according to 'isLower'.
Returns the parsed character. -}
lower :: CharParser st Char
lower :: CharParser st Char
lower = (Char -> Bool) -> CharParser st Char
forall st. (Char -> Bool) -> CharParser st Char
satisfy Char -> Bool
isLower CharParser st Char -> [Char] -> CharParser st Char
forall tok st a. GenParser tok st a -> [Char] -> GenParser tok st a
<?> [Char]
"lowercase letter"

{- | Parses an alphabetic or numeric Unicode characters according to
'isAlphaNum'. Returns the parsed character. -}
alphaNum :: CharParser st Char
alphaNum :: CharParser st Char
alphaNum = (Char -> Bool) -> CharParser st Char
forall st. (Char -> Bool) -> CharParser st Char
satisfy Char -> Bool
isAlphaNum CharParser st Char -> [Char] -> CharParser st Char
forall tok st a. GenParser tok st a -> [Char] -> GenParser tok st a
<?> [Char]
"letter or digit"

{- | Parses an alphabetic Unicode characters according to 'isAlpha'.
Returns the parsed character. -}
letter :: CharParser st Char
letter :: CharParser st Char
letter = (Char -> Bool) -> CharParser st Char
forall st. (Char -> Bool) -> CharParser st Char
satisfy Char -> Bool
isAlpha CharParser st Char -> [Char] -> CharParser st Char
forall tok st a. GenParser tok st a -> [Char] -> GenParser tok st a
<?> [Char]
"letter"

{- | Parses a digit (\'0\' ... \'9\') according to 'isDigit'.
Returns the parsed character. -}
digit :: CharParser st Char
digit :: CharParser st Char
digit = (Char -> Bool) -> CharParser st Char
forall st. (Char -> Bool) -> CharParser st Char
satisfy Char -> Bool
isDigit CharParser st Char -> [Char] -> CharParser st Char
forall tok st a. GenParser tok st a -> [Char] -> GenParser tok st a
<?> [Char]
"digit"

{- | Parses a hexadecimal digit (a digit or a letter between \'a\' and
\'f\' or \'A\' and \'F\'). Returns the parsed character. -}
hexDigit :: CharParser st Char
hexDigit :: CharParser st Char
hexDigit = (Char -> Bool) -> CharParser st Char
forall st. (Char -> Bool) -> CharParser st Char
satisfy Char -> Bool
isHexDigit CharParser st Char -> [Char] -> CharParser st Char
forall tok st a. GenParser tok st a -> [Char] -> GenParser tok st a
<?> [Char]
"hexadecimal digit"

{- | Parses an octal digit (\'0\' ... \'7\') according to 'isOctDigit'.
Returns the parsed character. -}
octDigit :: CharParser st Char
octDigit :: CharParser st Char
octDigit = (Char -> Bool) -> CharParser st Char
forall st. (Char -> Bool) -> CharParser st Char
satisfy Char -> Bool
isOctDigit CharParser st Char -> [Char] -> CharParser st Char
forall tok st a. GenParser tok st a -> [Char] -> GenParser tok st a
<?> [Char]
"octal digit"

{- | @char c@ parses a single character @c@. Returns the parsed
character (i.e. @c@).

>  semiColon  = char ';' -}
char :: Char -> CharParser st Char
char :: Char -> CharParser st Char
char Char
c = (Char -> Bool) -> CharParser st Char
forall st. (Char -> Bool) -> CharParser st Char
satisfy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
c) CharParser st Char -> [Char] -> CharParser st Char
forall tok st a. GenParser tok st a -> [Char] -> GenParser tok st a
<?> [Char] -> [Char]
forall a. Show a => a -> [Char]
show [Char
c]

-- | This parser succeeds for any character. Returns the parsed character.
anyChar :: CharParser st Char
anyChar :: CharParser st Char
anyChar = (Char -> Bool) -> CharParser st Char
forall st. (Char -> Bool) -> CharParser st Char
satisfy (Bool -> Char -> Bool
forall a b. a -> b -> a
const Bool
True)

{- ---------------------------------------------------------
Primitive character parsers
--------------------------------------------------------- -}

{- | The parser @satisfy f@ succeeds for any character for which the
supplied function @f@ returns 'True'. Returns the character that is
actually parsed.

>  digit     = satisfy isDigit
>  oneOf cs  = satisfy (`elem` cs) -}
satisfy :: (Char -> Bool) -> CharParser st Char
satisfy :: (Char -> Bool) -> CharParser st Char
satisfy Char -> Bool
f = (Char -> [Char])
-> (SourcePos -> Char -> [Char] -> SourcePos)
-> (Char -> Maybe Char)
-> CharParser st Char
forall tok a st.
(tok -> [Char])
-> (SourcePos -> tok -> [tok] -> SourcePos)
-> (tok -> Maybe a)
-> GenParser tok st a
tokenPrim (\ Char
c -> [Char] -> [Char]
forall a. Show a => a -> [Char]
show [Char
c])
                                (\ SourcePos
pos Char
c [Char]
_ -> SourcePos -> Char -> SourcePos
updatePosChar SourcePos
pos Char
c)
                                (\ Char
c -> if Char -> Bool
f Char
c then Char -> Maybe Char
forall a. a -> Maybe a
Just Char
c else Maybe Char
forall a. Maybe a
Nothing)

{- | @string s@ parses a sequence of characters given by @s@. Returns
the parsed string (i.e. @s@).

>  divOrMod    =   string "div"
>              <|> string "mod" -}
string :: String -> CharParser st String
string :: [Char] -> CharParser st [Char]
string = ([Char] -> [Char])
-> (SourcePos -> [Char] -> SourcePos)
-> [Char]
-> CharParser st [Char]
forall tok st.
Eq tok =>
([tok] -> [Char])
-> (SourcePos -> [tok] -> SourcePos)
-> [tok]
-> GenParser tok st [tok]
tokens [Char] -> [Char]
forall a. Show a => a -> [Char]
show SourcePos -> [Char] -> SourcePos
updatePosString