{-# LANGUAGE RankNTypes #-}

-- | Commonly used character-oriented combinators.

module Text.Cassette.Char where

import Control.Category ((.))
import Data.Char
import Prelude hiding ((.))
import Text.Cassette.Combinator
import Text.Cassette.Prim

-- | Succeeds if the current character is in the supplied list of characters.
-- See also 'satisfy'.
--
-- > vowel = oneOf "aeiou"
oneOf :: [Char] -> PP Char
oneOf :: [Char] -> PP Char
oneOf [Char]
xs = (Char -> Bool) -> PP Char
satisfy (Char -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char]
xs)

-- | Dual of 'oneOf'.
noneOf :: [Char] -> PP Char
noneOf :: [Char] -> PP Char
noneOf [Char]
xs = (Char -> Bool) -> PP Char
satisfy (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Char -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char]
xs))

-- | The 'satisfy' combinator, but unset.
skip :: (Char -> Bool) -> Char -> PP0
skip :: (Char -> Bool) -> Char -> PP0
skip Char -> Bool
p Char
x = Char -> PP Char -> PP0
forall a. a -> PP a -> PP0
unset Char
x (PP Char -> PP0) -> PP Char -> PP0
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> PP Char
satisfy Char -> Bool
p

-- The next three combinators take their specification from the
-- invertible-syntax package.

-- | 'skipSpace' marks a position where whitespace is allowed to occur. It
-- accepts arbitrary space while parsing, and produces no space while printing.
skipSpace :: PP0
skipSpace :: PP0
skipSpace = [Char] -> PP [Char] -> PP0
forall a. a -> PP a -> PP0
unset [Char]
"" (PP [Char] -> PP0) -> PP [Char] -> PP0
forall a b. (a -> b) -> a -> b
$ PP Char -> PP [Char]
forall a. PP a -> PP [a]
many ((Char -> Bool) -> PP Char
satisfy Char -> Bool
isSpace)

-- | 'optSpace' marks a position where whitespace is desired to occur. It
-- accepts arbitrary space while parsing, and produces a single space character
-- while printing.
optSpace :: PP0
optSpace :: PP0
optSpace = [Char] -> PP [Char] -> PP0
forall a. a -> PP a -> PP0
unset [Char]
" " (PP [Char] -> PP0) -> PP [Char] -> PP0
forall a b. (a -> b) -> a -> b
$ PP Char -> PP [Char]
forall a. PP a -> PP [a]
many ((Char -> Bool) -> PP Char
satisfy Char -> Bool
isSpace)

-- | 'sepSpace' marks a position where whitespace is required to occur. It
-- requires one or more space characters while parsing, and produces a single
-- space character while printing.
sepSpace :: PP0
sepSpace :: PP0
sepSpace = K7 Tr r r
PP0
space K7 Tr r r -> K7 Tr r r -> K7 Tr r r
forall b c a. K7 Tr b c -> K7 Tr a b -> K7 Tr a c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. K7 Tr r r
PP0
skipSpace

-- | A single space character (\' \').
space :: PP0
space :: PP0
space = Char -> PP0
char Char
' '

-- | A single newline character (\'\\n\').
newline :: PP0
newline :: PP0
newline = Char -> PP0
char Char
'\n'

-- | A single tab character (\'\\t\').
tab :: PP0
tab :: PP0
tab = Char -> PP0
char Char
'\t'

upper, lower, alphaNum, letter, digit, hexDigit, octDigit, anyChar :: PP Char

-- | An upper-case Unicode character.
upper :: PP Char
upper = (Char -> Bool) -> PP Char
satisfy Char -> Bool
isUpper

-- | A lower-case Unicode character.
lower :: PP Char
lower = (Char -> Bool) -> PP Char
satisfy Char -> Bool
isLower

-- | An alphabetic or numeric Unicode character.
alphaNum :: PP Char
alphaNum = (Char -> Bool) -> PP Char
satisfy Char -> Bool
isAlphaNum

-- | An alphabetic Unicode character.
letter :: PP Char
letter = (Char -> Bool) -> PP Char
satisfy Char -> Bool
isAlpha

-- | An ASCII digit.
digit :: PP Char
digit = (Char -> Bool) -> PP Char
satisfy Char -> Bool
isDigit

-- | An ASCII hexadecimal digit.
hexDigit :: PP Char
hexDigit = (Char -> Bool) -> PP Char
satisfy Char -> Bool
isHexDigit

-- | An ASCII octal digit.
octDigit :: PP Char
octDigit = (Char -> Bool) -> PP Char
satisfy Char -> Bool
isOctDigit

-- | Any character.
anyChar :: PP Char
anyChar = (Char -> Bool) -> PP Char
satisfy (Bool -> Char -> Bool
forall a b. a -> b -> a
const Bool
True)

-- | A specific character.
char :: Char -> PP0
char :: Char -> PP0
char Char
x = [Char] -> PP0
string [Char
x]