{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
module ByteString.Parser.Fast
(
Parser, ParserM(..), parseOnly,
ParseError(..), ErrorItem(..), ueof, ufail, parseError,
decimal, num, hnum, onum, frac, scientific,
satisfy, anyChar, char, anyWord8, word8, string, quotedString,
takeN, dropN, remaining, charTakeWhile, charTakeWhile1, ByteString.Parser.Fast.takeWhile, takeWhile1, skipWhile,
parseYMD, parseDTime, timestamp, rfc3339,
wlex, pFold,
isLower, getOctal, getInt
) where
import Control.Applicative
import Control.Monad
import Control.Monad.Codensity (Codensity, lowerCodensity)
import Control.Monad.Trans.Class (lift)
import Data.AffineSpace ((.+^), (.-^))
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8
import qualified Data.ByteString.Lex.Fractional as L
import Data.Semigroup
import Data.Set (Set)
import qualified Data.Set as S
import Data.Thyme
import Data.Word
import Lens.Micro
import Prelude
newtype ParserM a
= Parser {
forall a.
ParserM a
-> forall r.
ByteString -> (ParseError -> r) -> (ByteString -> a -> r) -> r
runParser :: forall r. BS.ByteString
-> (ParseError -> r)
-> (BS.ByteString -> a -> r)
-> r
} deriving forall a b. a -> ParserM b -> ParserM a
forall a b. (a -> b) -> ParserM a -> ParserM b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> ParserM b -> ParserM a
$c<$ :: forall a b. a -> ParserM b -> ParserM a
fmap :: forall a b. (a -> b) -> ParserM a -> ParserM b
$cfmap :: forall a b. (a -> b) -> ParserM a -> ParserM b
Functor
type Parser = Codensity ParserM
instance Applicative ParserM where
pure :: forall a. a -> ParserM a
pure a
a = forall a.
(forall r.
ByteString -> (ParseError -> r) -> (ByteString -> a -> r) -> r)
-> ParserM a
Parser forall a b. (a -> b) -> a -> b
$ \ByteString
b ParseError -> r
_ ByteString -> a -> r
s -> ByteString -> a -> r
s ByteString
b a
a
{-# INLINE pure #-}
Parser forall r.
ByteString
-> (ParseError -> r) -> (ByteString -> (a -> b) -> r) -> r
pf <*> :: forall a b. ParserM (a -> b) -> ParserM a -> ParserM b
<*> Parser forall r.
ByteString -> (ParseError -> r) -> (ByteString -> a -> r) -> r
px = forall a.
(forall r.
ByteString -> (ParseError -> r) -> (ByteString -> a -> r) -> r)
-> ParserM a
Parser forall a b. (a -> b) -> a -> b
$ \ByteString
input ParseError -> r
failure ByteString -> b -> r
success ->
let succ' :: ByteString -> (a -> b) -> r
succ' ByteString
input' a -> b
f = forall r.
ByteString -> (ParseError -> r) -> (ByteString -> a -> r) -> r
px ByteString
input' ParseError -> r
failure (\ByteString
i a
a -> ByteString -> b -> r
success ByteString
i (a -> b
f a
a))
in forall r.
ByteString
-> (ParseError -> r) -> (ByteString -> (a -> b) -> r) -> r
pf ByteString
input ParseError -> r
failure ByteString -> (a -> b) -> r
succ'
{-# INLINE (<*>) #-}
instance Alternative ParserM where
empty :: forall a. ParserM a
empty = forall a.
(forall r.
ByteString -> (ParseError -> r) -> (ByteString -> a -> r) -> r)
-> ParserM a
Parser (\ByteString
_ ParseError -> r
failure ByteString -> a -> r
_ -> ParseError -> r
failure forall a. Monoid a => a
mempty)
{-# INLINE empty #-}
Parser forall r.
ByteString -> (ParseError -> r) -> (ByteString -> a -> r) -> r
a <|> :: forall a. ParserM a -> ParserM a -> ParserM a
<|> Parser forall r.
ByteString -> (ParseError -> r) -> (ByteString -> a -> r) -> r
b = forall a.
(forall r.
ByteString -> (ParseError -> r) -> (ByteString -> a -> r) -> r)
-> ParserM a
Parser forall a b. (a -> b) -> a -> b
$ \ByteString
input ParseError -> r
failure ByteString -> a -> r
success -> forall r.
ByteString -> (ParseError -> r) -> (ByteString -> a -> r) -> r
a ByteString
input (\ParseError
rr -> forall r.
ByteString -> (ParseError -> r) -> (ByteString -> a -> r) -> r
b ByteString
input (ParseError -> r
failure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => a -> a -> a
mappend ParseError
rr) ByteString -> a -> r
success) ByteString -> a -> r
success
{-# INLINE (<|>) #-}
instance Monad ParserM where
ParserM a
m >>= :: forall a b. ParserM a -> (a -> ParserM b) -> ParserM b
>>= a -> ParserM b
k = forall a.
(forall r.
ByteString -> (ParseError -> r) -> (ByteString -> a -> r) -> r)
-> ParserM a
Parser forall a b. (a -> b) -> a -> b
$ \ByteString
input ParseError -> r
failure ByteString -> b -> r
success ->
let succ' :: ByteString -> a -> r
succ' ByteString
input' a
a = forall a.
ParserM a
-> forall r.
ByteString -> (ParseError -> r) -> (ByteString -> a -> r) -> r
runParser (a -> ParserM b
k a
a) ByteString
input' ParseError -> r
failure ByteString -> b -> r
success
in forall a.
ParserM a
-> forall r.
ByteString -> (ParseError -> r) -> (ByteString -> a -> r) -> r
runParser ParserM a
m ByteString
input ParseError -> r
failure ByteString -> a -> r
succ'
{-# INLINE (>>=) #-}
instance MonadFail ParserM where
fail :: forall a. String -> ParserM a
fail String
s = forall a.
(forall r.
ByteString -> (ParseError -> r) -> (ByteString -> a -> r) -> r)
-> ParserM a
Parser forall a b. (a -> b) -> a -> b
$ \ByteString
_ ParseError -> r
failure ByteString -> a -> r
_ -> ParseError -> r
failure (String -> ParseError
ufail String
s)
instance MonadPlus ParserM
data ErrorItem
= Tokens BS.ByteString
| Label String
deriving (Int -> ErrorItem -> ShowS
[ErrorItem] -> ShowS
ErrorItem -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ErrorItem] -> ShowS
$cshowList :: [ErrorItem] -> ShowS
show :: ErrorItem -> String
$cshow :: ErrorItem -> String
showsPrec :: Int -> ErrorItem -> ShowS
$cshowsPrec :: Int -> ErrorItem -> ShowS
Show, ErrorItem -> ErrorItem -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ErrorItem -> ErrorItem -> Bool
$c/= :: ErrorItem -> ErrorItem -> Bool
== :: ErrorItem -> ErrorItem -> Bool
$c== :: ErrorItem -> ErrorItem -> Bool
Eq, Eq ErrorItem
ErrorItem -> ErrorItem -> Bool
ErrorItem -> ErrorItem -> Ordering
ErrorItem -> ErrorItem -> ErrorItem
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ErrorItem -> ErrorItem -> ErrorItem
$cmin :: ErrorItem -> ErrorItem -> ErrorItem
max :: ErrorItem -> ErrorItem -> ErrorItem
$cmax :: ErrorItem -> ErrorItem -> ErrorItem
>= :: ErrorItem -> ErrorItem -> Bool
$c>= :: ErrorItem -> ErrorItem -> Bool
> :: ErrorItem -> ErrorItem -> Bool
$c> :: ErrorItem -> ErrorItem -> Bool
<= :: ErrorItem -> ErrorItem -> Bool
$c<= :: ErrorItem -> ErrorItem -> Bool
< :: ErrorItem -> ErrorItem -> Bool
$c< :: ErrorItem -> ErrorItem -> Bool
compare :: ErrorItem -> ErrorItem -> Ordering
$ccompare :: ErrorItem -> ErrorItem -> Ordering
Ord)
data ParseError
= ParseError
{ ParseError -> Set ErrorItem
errorUnexpected :: !(Set ErrorItem)
, ParseError -> Set ErrorItem
errorExpected :: !(Set ErrorItem)
} deriving (Int -> ParseError -> ShowS
[ParseError] -> ShowS
ParseError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ParseError] -> ShowS
$cshowList :: [ParseError] -> ShowS
show :: ParseError -> String
$cshow :: ParseError -> String
showsPrec :: Int -> ParseError -> ShowS
$cshowsPrec :: Int -> ParseError -> ShowS
Show, ParseError -> ParseError -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ParseError -> ParseError -> Bool
$c/= :: ParseError -> ParseError -> Bool
== :: ParseError -> ParseError -> Bool
$c== :: ParseError -> ParseError -> Bool
Eq)
instance Semigroup ParseError where
<> :: ParseError -> ParseError -> ParseError
(<>) (ParseError Set ErrorItem
u1 Set ErrorItem
e1) (ParseError Set ErrorItem
u2 Set ErrorItem
e2) = Set ErrorItem -> Set ErrorItem -> ParseError
ParseError (forall a. Monoid a => a -> a -> a
mappend Set ErrorItem
u1 Set ErrorItem
u2) (forall a. Monoid a => a -> a -> a
mappend Set ErrorItem
e1 Set ErrorItem
e2)
instance Monoid ParseError where
mempty :: ParseError
mempty = Set ErrorItem -> Set ErrorItem -> ParseError
ParseError forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty
mappend :: ParseError -> ParseError -> ParseError
mappend = forall a. Semigroup a => a -> a -> a
(<>)
ueof :: ParseError
ueof :: ParseError
ueof = Set ErrorItem -> Set ErrorItem -> ParseError
ParseError (forall a. a -> Set a
S.singleton (String -> ErrorItem
Label String
"end of input")) forall a. Monoid a => a
mempty
ufail :: String
-> ParseError
ufail :: String -> ParseError
ufail String
s = Set ErrorItem -> Set ErrorItem -> ParseError
ParseError (forall a. a -> Set a
S.singleton (String -> ErrorItem
Label String
s)) forall a. Monoid a => a
mempty
parseError :: BS8.ByteString
-> BS8.ByteString
-> ParseError
parseError :: ByteString -> ByteString -> ParseError
parseError ByteString
un ByteString
ex = Set ErrorItem -> Set ErrorItem -> ParseError
ParseError (forall a. a -> Set a
S.singleton (ByteString -> ErrorItem
Tokens ByteString
un)) (forall a. a -> Set a
S.singleton (ByteString -> ErrorItem
Tokens ByteString
ex))
wlex :: (BS.ByteString -> Maybe (a, BS.ByteString)) -> Parser a
wlex :: forall a. (ByteString -> Maybe (a, ByteString)) -> Parser a
wlex ByteString -> Maybe (a, ByteString)
p = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a.
(forall r.
ByteString -> (ParseError -> r) -> (ByteString -> a -> r) -> r)
-> ParserM a
Parser forall a b. (a -> b) -> a -> b
$ \ByteString
i ParseError -> r
failure ByteString -> a -> r
success -> case ByteString -> Maybe (a, ByteString)
p ByteString
i of
Maybe (a, ByteString)
Nothing -> ParseError -> r
failure forall a. Monoid a => a
mempty
Just (a
a, ByteString
i') -> ByteString -> a -> r
success ByteString
i' a
a
{-# INLINABLE wlex #-}
getInt :: BS.ByteString -> Int
getInt :: ByteString -> Int
getInt = forall a. (a -> Word8 -> a) -> a -> ByteString -> a
BS.foldl' (\Int
acc Word8
n -> Int
acc forall a. Num a => a -> a -> a
* Int
10 forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8
n forall a. Num a => a -> a -> a
- Word8
0x30)) Int
0
{-# INLINE getInt #-}
getOctal :: BS.ByteString -> Int
getOctal :: ByteString -> Int
getOctal = forall a. (a -> Word8 -> a) -> a -> ByteString -> a
BS.foldl' (\Int
acc Word8
n -> Int
acc forall a. Num a => a -> a -> a
* Int
8 forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8
n forall a. Num a => a -> a -> a
- Word8
0x30)) Int
0
{-# INLINE getOctal #-}
isDigit :: Word8 -> Bool
isDigit :: Word8 -> Bool
isDigit !Word8
x = Word8
x forall a. Ord a => a -> a -> Bool
>= Word8
0x30 Bool -> Bool -> Bool
&& Word8
x forall a. Ord a => a -> a -> Bool
<= Word8
0x39
{-# INLINE isDigit #-}
isHexa :: Word8 -> Bool
isHexa :: Word8 -> Bool
isHexa !Word8
x = (Word8
x forall a. Ord a => a -> a -> Bool
>= Word8
0x30 Bool -> Bool -> Bool
&& Word8
x forall a. Ord a => a -> a -> Bool
<= Word8
0x39)
Bool -> Bool -> Bool
|| (Word8
x forall a. Ord a => a -> a -> Bool
>= Word8
0x41 Bool -> Bool -> Bool
&& Word8
x forall a. Ord a => a -> a -> Bool
<= Word8
0x46)
Bool -> Bool -> Bool
|| (Word8
x forall a. Ord a => a -> a -> Bool
>= Word8
0x61 Bool -> Bool -> Bool
&& Word8
x forall a. Ord a => a -> a -> Bool
<= Word8
0x66)
{-# INLINE isHexa #-}
hexToNum :: Num n => Word8 -> n
hexToNum :: forall n. Num n => Word8 -> n
hexToNum Word8
x | Word8
x forall a. Ord a => a -> a -> Bool
>= Word8
0x30 Bool -> Bool -> Bool
&& Word8
x forall a. Ord a => a -> a -> Bool
<= Word8
0x39 = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
x forall a. Num a => a -> a -> a
- n
0x30
| Word8
x forall a. Ord a => a -> a -> Bool
>= Word8
0x41 Bool -> Bool -> Bool
&& Word8
x forall a. Ord a => a -> a -> Bool
<= Word8
0x46 = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
x forall a. Num a => a -> a -> a
- n
0x37
| Word8
x forall a. Ord a => a -> a -> Bool
>= Word8
0x61 Bool -> Bool -> Bool
&& Word8
x forall a. Ord a => a -> a -> Bool
<= Word8
0x66 = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
x forall a. Num a => a -> a -> a
- n
0x57
| Bool
otherwise = n
0
{-# INLINABLE hexToNum #-}
isUpper :: Word8 -> Bool
isUpper :: Word8 -> Bool
isUpper !Word8
x = Word8
x forall a. Ord a => a -> a -> Bool
>= Word8
0x41 Bool -> Bool -> Bool
&& Word8
x forall a. Ord a => a -> a -> Bool
<= Word8
0x5a
{-# INLINE isUpper #-}
isLower :: Word8 -> Bool
isLower :: Word8 -> Bool
isLower !Word8
x = Word8
x forall a. Ord a => a -> a -> Bool
>= Word8
0x61 Bool -> Bool -> Bool
&& Word8
x forall a. Ord a => a -> a -> Bool
<= Word8
0x7a
{-# INLINE isLower #-}
decimal :: Parser Int
decimal :: Parser Int
decimal = ByteString -> Int
getInt forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word8 -> Bool) -> Parser ByteString
takeWhile1 Word8 -> Bool
isDigit
{-# INLINE decimal #-}
num :: Num n => Parser n
num :: forall n. Num n => Parser n
num = forall a. (a -> Word8 -> a) -> a -> ByteString -> a
BS.foldl' (\n
acc Word8
n -> n
acc forall a. Num a => a -> a -> a
* n
10 forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8
n forall a. Num a => a -> a -> a
- Word8
0x30)) n
0 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word8 -> Bool) -> Parser ByteString
takeWhile1 Word8 -> Bool
isDigit
{-# INLINABLE num #-}
hnum :: Num n => Parser n
hnum :: forall n. Num n => Parser n
hnum = forall a. (a -> Word8 -> a) -> a -> ByteString -> a
BS.foldl' (\n
acc Word8
n -> n
acc forall a. Num a => a -> a -> a
* n
16 forall a. Num a => a -> a -> a
+ forall n. Num n => Word8 -> n
hexToNum Word8
n) n
0 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word8 -> Bool) -> Parser ByteString
takeWhile1 Word8 -> Bool
isHexa
{-# INLINABLE hnum #-}
onum :: Num n => Parser n
onum :: forall n. Num n => Parser n
onum = forall a. (a -> Word8 -> a) -> a -> ByteString -> a
BS.foldl' (\n
acc Word8
n -> n
acc forall a. Num a => a -> a -> a
* n
8 forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8
n forall a. Num a => a -> a -> a
- Word8
0x30)) n
0 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word8 -> Bool) -> Parser ByteString
takeWhile1 Word8 -> Bool
isDigit
{-# INLINABLE onum #-}
frac :: Fractional a => Parser a
frac :: forall a. Fractional a => Parser a
frac = forall a. (ByteString -> Maybe (a, ByteString)) -> Parser a
wlex (forall a.
Num a =>
(ByteString -> Maybe (a, ByteString))
-> ByteString -> Maybe (a, ByteString)
L.readSigned forall a. Fractional a => ByteString -> Maybe (a, ByteString)
L.readDecimal)
{-# INLINABLE frac #-}
takeN :: Int -> Parser BS.ByteString
takeN :: Int -> Parser ByteString
takeN Int
n = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a.
(forall r.
ByteString -> (ParseError -> r) -> (ByteString -> a -> r) -> r)
-> ParserM a
Parser forall a b. (a -> b) -> a -> b
$ \ByteString
input ParseError -> r
failure ByteString -> ByteString -> r
success
-> if ByteString -> Int
BS.length ByteString
input forall a. Ord a => a -> a -> Bool
< Int
n
then ParseError -> r
failure ParseError
ueof
else let (ByteString
a,ByteString
rest) = Int -> ByteString -> (ByteString, ByteString)
BS.splitAt Int
n ByteString
input
in ByteString -> ByteString -> r
success ByteString
rest ByteString
a
dropN :: Int -> Parser ()
dropN :: Int -> Parser ()
dropN Int
n = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a.
(forall r.
ByteString -> (ParseError -> r) -> (ByteString -> a -> r) -> r)
-> ParserM a
Parser forall a b. (a -> b) -> a -> b
$ \ByteString
input ParseError -> r
failure ByteString -> () -> r
success
-> if ByteString -> Int
BS.length ByteString
input forall a. Ord a => a -> a -> Bool
< Int
n
then ParseError -> r
failure ParseError
ueof
else ByteString -> () -> r
success (Int -> ByteString -> ByteString
BS.drop Int
n ByteString
input) ()
anyChar :: Parser Char
anyChar :: Parser Char
anyChar = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a.
(forall r.
ByteString -> (ParseError -> r) -> (ByteString -> a -> r) -> r)
-> ParserM a
Parser forall a b. (a -> b) -> a -> b
$ \ByteString
input ParseError -> r
failure ByteString -> Char -> r
success -> if ByteString -> Bool
BS.null ByteString
input then ParseError -> r
failure ParseError
ueof else ByteString -> Char -> r
success (HasCallStack => ByteString -> ByteString
BS8.tail ByteString
input) (ByteString -> Char
BS8.head ByteString
input)
{-# INLINE anyChar #-}
char :: Char -> Parser ()
char :: Char -> Parser ()
char Char
c = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a.
(forall r.
ByteString -> (ParseError -> r) -> (ByteString -> a -> r) -> r)
-> ParserM a
Parser forall a b. (a -> b) -> a -> b
$ \ByteString
input ParseError -> r
failure ByteString -> () -> r
success -> if ByteString -> Bool
BS.null ByteString
input then ParseError -> r
failure ParseError
ueof else if ByteString -> Char
BS8.head ByteString
input forall a. Eq a => a -> a -> Bool
== Char
c then ByteString -> () -> r
success (HasCallStack => ByteString -> ByteString
BS.tail ByteString
input) () else ParseError -> r
failure (ByteString -> ByteString -> ParseError
parseError (Int -> ByteString -> ByteString
BS8.take Int
1 ByteString
input) (Char -> ByteString
BS8.singleton Char
c))
{-# INLINE char #-}
anyWord8 :: Parser Word8
anyWord8 :: Parser Word8
anyWord8 = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a.
(forall r.
ByteString -> (ParseError -> r) -> (ByteString -> a -> r) -> r)
-> ParserM a
Parser forall a b. (a -> b) -> a -> b
$ \ByteString
input ParseError -> r
failure ByteString -> Word8 -> r
success -> if ByteString -> Bool
BS.null ByteString
input then ParseError -> r
failure ParseError
ueof else ByteString -> Word8 -> r
success (HasCallStack => ByteString -> ByteString
BS.tail ByteString
input) (HasCallStack => ByteString -> Word8
BS.head ByteString
input)
{-# INLINE anyWord8 #-}
word8 :: Word8 -> Parser ()
word8 :: Word8 -> Parser ()
word8 Word8
c = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a.
(forall r.
ByteString -> (ParseError -> r) -> (ByteString -> a -> r) -> r)
-> ParserM a
Parser forall a b. (a -> b) -> a -> b
$ \ByteString
input ParseError -> r
failure ByteString -> () -> r
success -> if ByteString -> Bool
BS.null ByteString
input then ParseError -> r
failure ParseError
ueof else if HasCallStack => ByteString -> Word8
BS.head ByteString
input forall a. Eq a => a -> a -> Bool
== Word8
c then ByteString -> () -> r
success (HasCallStack => ByteString -> ByteString
BS.tail ByteString
input) () else ParseError -> r
failure (ByteString -> ByteString -> ParseError
parseError (Int -> ByteString -> ByteString
BS.take Int
1 ByteString
input) (Word8 -> ByteString
BS.singleton Word8
c))
{-# INLINE word8 #-}
satisfy :: (Char -> Bool) -> Parser Char
satisfy :: (Char -> Bool) -> Parser Char
satisfy Char -> Bool
p = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a.
(forall r.
ByteString -> (ParseError -> r) -> (ByteString -> a -> r) -> r)
-> ParserM a
Parser forall a b. (a -> b) -> a -> b
$ \ByteString
input ParseError -> r
failure ByteString -> Char -> r
success ->
if ByteString -> Bool
BS.null ByteString
input
then ParseError -> r
failure ParseError
ueof
else let c :: Char
c = ByteString -> Char
BS8.head ByteString
input
in if Char -> Bool
p Char
c
then ByteString -> Char -> r
success (HasCallStack => ByteString -> ByteString
BS.tail ByteString
input) Char
c
else ParseError -> r
failure (ByteString -> ByteString -> ParseError
parseError (Int -> ByteString -> ByteString
BS8.take Int
1 ByteString
input) (Char -> ByteString
BS8.singleton Char
c))
string :: BS.ByteString -> Parser ()
string :: ByteString -> Parser ()
string ByteString
s = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a.
(forall r.
ByteString -> (ParseError -> r) -> (ByteString -> a -> r) -> r)
-> ParserM a
Parser forall a b. (a -> b) -> a -> b
$ \ByteString
input ParseError -> r
failure ByteString -> () -> r
success
-> if ByteString
s ByteString -> ByteString -> Bool
`BS.isPrefixOf` ByteString
input
then ByteString -> () -> r
success (Int -> ByteString -> ByteString
BS.drop (ByteString -> Int
BS.length ByteString
s) ByteString
input) ()
else ParseError -> r
failure (ByteString -> ByteString -> ParseError
parseError (Int -> ByteString -> ByteString
BS.take (ByteString -> Int
BS.length ByteString
s) ByteString
input) ByteString
s)
quotedString :: Parser BS.ByteString
quotedString :: Parser ByteString
quotedString = Char -> Parser ()
char Char
'"' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString
go forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser ()
char Char
'"'
where
go :: Parser ByteString
go = [ByteString] -> ByteString
BS.concat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Parser ByteString
normal forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString
escaped)
normal :: Parser ByteString
normal = (Char -> Bool) -> Parser ByteString
charTakeWhile1 (\Char
x -> Char
x forall a. Eq a => a -> a -> Bool
/= Char
'"' Bool -> Bool -> Bool
&& Char
x forall a. Eq a => a -> a -> Bool
/= Char
'\\')
escaped :: Parser ByteString
escaped = do
Char -> Parser ()
char Char
'\\'
Char
c <- Parser Char
anyChar
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Char
c of
Char
'r' -> Char -> ByteString
BS8.singleton Char
'\r'
Char
'n' -> Char -> ByteString
BS8.singleton Char
'\n'
Char
't' -> Char -> ByteString
BS8.singleton Char
'\t'
Char
'a' -> Char -> ByteString
BS8.singleton Char
'\a'
Char
'b' -> Char -> ByteString
BS8.singleton Char
'\b'
Char
'"' -> Char -> ByteString
BS8.singleton Char
'"'
Char
_ -> String -> ByteString
BS8.pack [Char
'\\',Char
c]
scientific :: Parser Double
scientific :: Parser Double
scientific = (Int, Double) -> Double
finalize forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Word8 -> a) -> a -> ByteString -> a
BS.foldl' forall {a} {b} {a}.
(Num b, Num a, Integral a) =>
(a, b) -> a -> (a, b)
step (Int
0,Double
0) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word8 -> Bool) -> Parser ByteString
takeWhile1 (\Word8
n -> Word8 -> Bool
isDigit Word8
n Bool -> Bool -> Bool
|| Word8
n forall a. Eq a => a -> a -> Bool
== Word8
0x2e)
where
finalize :: (Int, Double) -> Double
finalize :: (Int, Double) -> Double
finalize (!Int
n,!Double
x) = if Double
x forall a. Eq a => a -> a -> Bool
== Double
0
then forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n
else forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n forall a. Fractional a => a -> a -> a
/ Double
x
step :: (a, b) -> a -> (a, b)
step (!a
n,!b
x) !a
v = if a
v forall a. Eq a => a -> a -> Bool
== a
0x2e
then (a
n,b
1)
else (a
n forall a. Num a => a -> a -> a
* a
10 forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral (a
v forall a. Num a => a -> a -> a
- a
0x30), b
x forall a. Num a => a -> a -> a
* b
10)
{-# INLINE scientific #-}
charTakeWhile1 :: (Char -> Bool) -> Parser BS.ByteString
charTakeWhile1 :: (Char -> Bool) -> Parser ByteString
charTakeWhile1 Char -> Bool
prd = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a.
(forall r.
ByteString -> (ParseError -> r) -> (ByteString -> a -> r) -> r)
-> ParserM a
Parser forall a b. (a -> b) -> a -> b
$ \ByteString
s ParseError -> r
failure ByteString -> ByteString -> r
success ->
case (Char -> Bool) -> ByteString -> (ByteString, ByteString)
BS8.span Char -> Bool
prd ByteString
s of
(ByteString
a,ByteString
b) -> if ByteString -> Bool
BS.null ByteString
a then ParseError -> r
failure (Set ErrorItem -> Set ErrorItem -> ParseError
ParseError (forall a. a -> Set a
S.singleton (ByteString -> ErrorItem
Tokens (Int -> ByteString -> ByteString
BS.take Int
1 ByteString
s))) forall a. Monoid a => a
mempty) else ByteString -> ByteString -> r
success ByteString
b ByteString
a
{-# INLINE charTakeWhile1 #-}
takeWhile1 :: (Word8 -> Bool) -> Parser BS.ByteString
takeWhile1 :: (Word8 -> Bool) -> Parser ByteString
takeWhile1 Word8 -> Bool
prd = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a.
(forall r.
ByteString -> (ParseError -> r) -> (ByteString -> a -> r) -> r)
-> ParserM a
Parser forall a b. (a -> b) -> a -> b
$ \ByteString
s ParseError -> r
failure ByteString -> ByteString -> r
success ->
case (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
BS.span Word8 -> Bool
prd ByteString
s of
(ByteString
a,ByteString
b) -> if ByteString -> Bool
BS.null ByteString
a then ParseError -> r
failure (Set ErrorItem -> Set ErrorItem -> ParseError
ParseError (forall a. a -> Set a
S.singleton (ByteString -> ErrorItem
Tokens (Int -> ByteString -> ByteString
BS.take Int
1 ByteString
s))) forall a. Monoid a => a
mempty) else ByteString -> ByteString -> r
success ByteString
b ByteString
a
{-# INLINE takeWhile1 #-}
charTakeWhile :: (Char -> Bool) -> Parser BS.ByteString
charTakeWhile :: (Char -> Bool) -> Parser ByteString
charTakeWhile Char -> Bool
prd = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a.
(forall r.
ByteString -> (ParseError -> r) -> (ByteString -> a -> r) -> r)
-> ParserM a
Parser forall a b. (a -> b) -> a -> b
$ \ByteString
s ParseError -> r
_ ByteString -> ByteString -> r
success ->
case (Char -> Bool) -> ByteString -> (ByteString, ByteString)
BS8.span Char -> Bool
prd ByteString
s of
(ByteString
a,ByteString
b) -> ByteString -> ByteString -> r
success ByteString
b ByteString
a
{-# INLINE charTakeWhile #-}
takeWhile :: (Word8 -> Bool) -> Parser BS.ByteString
takeWhile :: (Word8 -> Bool) -> Parser ByteString
takeWhile Word8 -> Bool
prd = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a.
(forall r.
ByteString -> (ParseError -> r) -> (ByteString -> a -> r) -> r)
-> ParserM a
Parser forall a b. (a -> b) -> a -> b
$ \ByteString
s ParseError -> r
_ ByteString -> ByteString -> r
success ->
case (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
BS.span Word8 -> Bool
prd ByteString
s of
(ByteString
a,ByteString
b) -> ByteString -> ByteString -> r
success ByteString
b ByteString
a
{-# INLINE takeWhile #-}
skipWhile :: (Word8 -> Bool) -> Parser ()
skipWhile :: (Word8 -> Bool) -> Parser ()
skipWhile Word8 -> Bool
prd = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a.
(forall r.
ByteString -> (ParseError -> r) -> (ByteString -> a -> r) -> r)
-> ParserM a
Parser forall a b. (a -> b) -> a -> b
$ \ByteString
s ParseError -> r
_ ByteString -> () -> r
success -> ByteString -> () -> r
success ((Word8 -> Bool) -> ByteString -> ByteString
BS.dropWhile Word8 -> Bool
prd ByteString
s) ()
{-# INLINE skipWhile #-}
parseOnly :: Parser a -> BS.ByteString -> Either ParseError a
parseOnly :: forall a. Parser a -> ByteString -> Either ParseError a
parseOnly Parser a
prs ByteString
s = case forall (f :: * -> *) a. Applicative f => Codensity f a -> f a
lowerCodensity Parser a
prs of
Parser forall r.
ByteString -> (ParseError -> r) -> (ByteString -> a -> r) -> r
p -> forall r.
ByteString -> (ParseError -> r) -> (ByteString -> a -> r) -> r
p ByteString
s forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ \ByteString
b a
a -> if ByteString -> Bool
BS.null ByteString
b
then forall a b. b -> Either a b
Right a
a
else forall a b. a -> Either a b
Left (Set ErrorItem -> Set ErrorItem -> ParseError
ParseError (forall a. a -> Set a
S.singleton (ByteString -> ErrorItem
Tokens (Int -> ByteString -> ByteString
BS.take Int
1 ByteString
b))) forall a. Monoid a => a
mempty)
remaining :: Parser BS.ByteString
remaining :: Parser ByteString
remaining = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a.
(forall r.
ByteString -> (ParseError -> r) -> (ByteString -> a -> r) -> r)
-> ParserM a
Parser forall a b. (a -> b) -> a -> b
$ \ByteString
input ParseError -> r
_ ByteString -> ByteString -> r
success -> ByteString -> ByteString -> r
success ByteString
BS.empty ByteString
input
parseYMD :: Parser Day
parseYMD :: Parser Day
parseYMD = do
!Int
y <- Parser Int
decimal forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser ()
char Char
'-'
!Int
m <- Parser Int
decimal forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser ()
char Char
'-'
!Int
d <- Parser Int
decimal
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! Int -> Int -> Int -> Day
fromGregorian Int
y Int
m Int
d
parseDTime :: Parser DiffTime
parseDTime :: Parser DiffTime
parseDTime = do
!Int
h <- Parser Int
decimal forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser ()
char Char
':'
!Int
mi <- Parser Int
decimal forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser ()
char Char
':'
!Double
s <- Parser Double
scientific
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall n t. (Real n, TimeDiff t) => n -> t
fromSeconds forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
h forall a. Num a => a -> a -> a
* Int
3600 forall a. Num a => a -> a -> a
+ Int
mi forall a. Num a => a -> a -> a
* Int
60 :: Int) forall a. Num a => a -> a -> a
+ Double
s
timestamp :: Parser UTCTime
timestamp :: Parser UTCTime
timestamp = do
!Day
day <- Parser Day
parseYMD forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser ()
char Char
'+'
!DiffTime
difftime <- Parser DiffTime
parseDTime forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser ()
char Char
'+'
let !tm :: UTCTime
tm = Day -> DiffTime -> UTCTime
UTCTime Day
day DiffTime
difftime
!ByteString
tz <- (Word8 -> Bool) -> Parser ByteString
takeWhile1 Word8 -> Bool
isUpper
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! case ByteString
tz of
ByteString
"CEST" -> UTCTime
tm forall p. AffineSpace p => p -> Diff p -> p
.-^ forall n t. (Real n, TimeDiff t) => n -> t
fromSeconds (Int
7200 :: Int)
ByteString
"CET" -> UTCTime
tm forall p. AffineSpace p => p -> Diff p -> p
.-^ forall n t. (Real n, TimeDiff t) => n -> t
fromSeconds (Int
3600 :: Int)
ByteString
_ -> UTCTime
tm
rfc3339 :: Parser UTCTime
rfc3339 :: Parser UTCTime
rfc3339 = do
!Day
day <- Parser Day
parseYMD forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser ()
char Char
'T'
!DiffTime
difftime <- Parser DiffTime
parseDTime
!Char
o <- Parser Char
anyChar
let !tm :: UTCTime
tm = Day -> DiffTime -> UTCTime
UTCTime Day
day DiffTime
difftime
suboffset :: Diff UTCTime -> UTCTime
suboffset = (UTCTime
tm forall p. AffineSpace p => p -> Diff p -> p
.-^)
addoffset :: Diff UTCTime -> UTCTime
addoffset = (UTCTime
tm forall p. AffineSpace p => p -> Diff p -> p
.+^)
getOffset :: Codensity ParserM NominalDiffTime
getOffset = do
Int
h <- Parser Int
decimal
Char -> Parser ()
char Char
':'
Int
m <- Parser Int
decimal
forall (m :: * -> *) a. Monad m => a -> m a
return (forall n t. (Real n, TimeDiff t) => n -> t
fromSeconds (Int
hforall a. Num a => a -> a -> a
*Int
3600 forall a. Num a => a -> a -> a
+ Int
mforall a. Num a => a -> a -> a
*Int
60))
case Char
o of
Char
'Z' -> forall (m :: * -> *) a. Monad m => a -> m a
return UTCTime
tm
Char
'+' -> NominalDiffTime -> UTCTime
suboffset forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Codensity ParserM NominalDiffTime
getOffset
Char
'-' -> NominalDiffTime -> UTCTime
addoffset forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Codensity ParserM NominalDiffTime
getOffset
Char
_ -> forall (f :: * -> *) a. Alternative f => f a
empty
pFold :: Parser a -> SimpleFold BS.ByteString a
pFold :: forall a. Parser a -> SimpleFold ByteString a
pFold Parser a
p = forall s a. (s -> a) -> SimpleGetter s a
to (forall a. Parser a -> ByteString -> Either ParseError a
parseOnly Parser a
p) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b b'. Traversal (Either a b) (Either a b') b b'
_Right