{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
module Text.Megaparsec.Byte
(
newline
, crlf
, eol
, tab
, space
, space1
, controlChar
, spaceChar
, upperChar
, lowerChar
, letterChar
, alphaNumChar
, printChar
, digitChar
, octDigitChar
, hexDigitChar
, asciiChar
, C.char
, char'
, C.anyChar
, C.notChar
, C.oneOf
, C.noneOf
, C.satisfy
, C.string
, C.string' )
where
import Control.Applicative
import Data.Char
import Data.Functor (void)
import Data.Maybe (fromMaybe)
import Data.Proxy
import Data.Word (Word8)
import Text.Megaparsec
import qualified Text.Megaparsec.Char as C
newline :: (MonadParsec e s m, Token s ~ Word8) => m (Token s)
newline = C.char 10
{-# INLINE newline #-}
crlf :: forall e s m. (MonadParsec e s m, Token s ~ Word8) => m (Tokens s)
crlf = C.string (tokensToChunk (Proxy :: Proxy s) [13,10])
{-# INLINE crlf #-}
eol :: forall e s m. (MonadParsec e s m, Token s ~ Word8) => m (Tokens s)
eol = (tokenToChunk (Proxy :: Proxy s) <$> newline)
<|> crlf
<?> "end of line"
{-# INLINE eol #-}
tab :: (MonadParsec e s m, Token s ~ Word8) => m (Token s)
tab = C.char 9
{-# INLINE tab #-}
space :: (MonadParsec e s m, Token s ~ Word8) => m ()
space = void $ takeWhileP (Just "white space") isSpace'
{-# INLINE space #-}
space1 :: (MonadParsec e s m, Token s ~ Word8) => m ()
space1 = void $ takeWhile1P (Just "white space") isSpace'
{-# INLINE space1 #-}
controlChar :: (MonadParsec e s m, Token s ~ Word8) => m (Token s)
controlChar = C.satisfy (isControl . toChar) <?> "control character"
{-# INLINE controlChar #-}
spaceChar :: (MonadParsec e s m, Token s ~ Word8) => m (Token s)
spaceChar = C.satisfy isSpace' <?> "white space"
{-# INLINE spaceChar #-}
upperChar :: (MonadParsec e s m, Token s ~ Word8) => m (Token s)
upperChar = C.satisfy (isUpper . toChar) <?> "uppercase letter"
{-# INLINE upperChar #-}
lowerChar :: (MonadParsec e s m, Token s ~ Word8) => m (Token s)
lowerChar = C.satisfy (isLower . toChar) <?> "lowercase letter"
{-# INLINE lowerChar #-}
letterChar :: (MonadParsec e s m, Token s ~ Word8) => m (Token s)
letterChar = C.satisfy (isLetter . toChar) <?> "letter"
{-# INLINE letterChar #-}
alphaNumChar :: (MonadParsec e s m, Token s ~ Word8) => m (Token s)
alphaNumChar = C.satisfy (isAlphaNum . toChar) <?> "alphanumeric character"
{-# INLINE alphaNumChar #-}
printChar :: (MonadParsec e s m, Token s ~ Word8) => m (Token s)
printChar = C.satisfy (isPrint . toChar) <?> "printable character"
{-# INLINE printChar #-}
digitChar :: (MonadParsec e s m, Token s ~ Word8) => m (Token s)
digitChar = C.satisfy isDigit' <?> "digit"
where
isDigit' x = x >= 48 && x <= 57
{-# INLINE digitChar #-}
octDigitChar :: (MonadParsec e s m, Token s ~ Word8) => m (Token s)
octDigitChar = C.satisfy isOctDigit' <?> "octal digit"
where
isOctDigit' x = x >= 48 && x <= 55
{-# INLINE octDigitChar #-}
hexDigitChar :: (MonadParsec e s m, Token s ~ Word8) => m (Token s)
hexDigitChar = C.satisfy (isHexDigit . toChar) <?> "hexadecimal digit"
{-# INLINE hexDigitChar #-}
asciiChar :: (MonadParsec e s m, Token s ~ Word8) => m (Token s)
asciiChar = C.satisfy (< 128) <?> "ASCII character"
{-# INLINE asciiChar #-}
char' :: (MonadParsec e s m, Token s ~ Word8) => Token s -> m (Token s)
char' c = choice
[ C.char c
, C.char (fromMaybe c (swapCase c)) ]
where
swapCase x
| isUpper g = fromChar (toLower g)
| isLower g = fromChar (toUpper g)
| otherwise = Nothing
where
g = toChar x
{-# INLINE char' #-}
isSpace' :: Word8 -> Bool
isSpace' x
| x >= 9 && x <= 13 = True
| x == 32 = True
| x == 160 = True
| otherwise = False
{-# INLINE isSpace' #-}
toChar :: Word8 -> Char
toChar = chr . fromIntegral
{-# INLINE toChar #-}
fromChar :: Char -> Maybe Word8
fromChar x = let p = ord x in
if p > 0xff
then Nothing
else Just (fromIntegral p)
{-# INLINE fromChar #-}