{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
module Web.Rep.Internal.FlatParse
(
runParserMaybe,
runParserEither,
runParser_,
runParser,
Parser,
Result (..),
isWhitespace,
ws_,
ws,
wss,
nota,
isa,
sq,
dq,
wrappedDq,
wrappedSq,
wrappedQ,
wrappedQNoGuard,
eq,
sep,
bracketed,
bracketedSB,
wrapped,
digit,
digits,
int,
double,
minus,
signed,
byteStringOf',
comma,
)
where
import Data.Bool
import Data.ByteString (ByteString)
import Data.Char hiding (isDigit)
import FlatParse.Basic hiding (cut, take)
import GHC.Exts
import Prelude hiding (replicate)
runParserMaybe :: Parser e a -> ByteString -> Maybe a
runParserMaybe :: forall e a. Parser e a -> ByteString -> Maybe a
runParserMaybe Parser e a
p ByteString
b = case Parser e a -> ByteString -> Result e a
forall e a. Parser e a -> ByteString -> Result e a
runParser Parser e a
p ByteString
b of
OK a
r ByteString
_ -> a -> Maybe a
forall a. a -> Maybe a
Just a
r
Result e a
Fail -> Maybe a
forall a. Maybe a
Nothing
Err e
_ -> Maybe a
forall a. Maybe a
Nothing
runParserEither :: (IsString e) => Parser e a -> ByteString -> Either e a
runParserEither :: forall e a. IsString e => Parser e a -> ByteString -> Either e a
runParserEither Parser e a
p ByteString
bs = case Parser e a -> ByteString -> Result e a
forall e a. Parser e a -> ByteString -> Result e a
runParser Parser e a
p ByteString
bs of
Err e
e -> e -> Either e a
forall a b. a -> Either a b
Left e
e
OK a
a ByteString
_ -> a -> Either e a
forall a b. b -> Either a b
Right a
a
Result e a
Fail -> e -> Either e a
forall a b. a -> Either a b
Left e
"uncaught parse error"
runParser_ :: Parser String a -> ByteString -> a
runParser_ :: forall a. Parser String a -> ByteString -> a
runParser_ Parser String a
p ByteString
bs = case Parser String a -> ByteString -> Result String a
forall e a. Parser e a -> ByteString -> Result e a
runParser Parser String a
p ByteString
bs of
Err String
e -> String -> a
forall a. HasCallStack => String -> a
error String
e
OK a
a ByteString
"" -> a
a
OK a
_ ByteString
_ -> String -> a
forall a. HasCallStack => String -> a
error String
"leftovers"
Result String a
Fail -> String -> a
forall a. HasCallStack => String -> a
error String
"uncaught parse error"
ws_ :: Parser e ()
ws_ :: forall e. Parser e ()
ws_ =
$( switch
[|
case _ of
" " -> ws_
"\n" -> ws_
"\t" -> ws_
"\r" -> ws_
"\f" -> ws_
_ -> pure ()
|]
)
{-# INLINE ws_ #-}
isWhitespace :: Char -> Bool
isWhitespace :: Char -> Bool
isWhitespace Char
' ' = Bool
True
isWhitespace Char
'\x0a' = Bool
True
isWhitespace Char
'\x09' = Bool
True
isWhitespace Char
'\x0c' = Bool
True
isWhitespace Char
'\x0d' = Bool
True
isWhitespace Char
_ = Bool
False
{-# INLINE isWhitespace #-}
ws :: Parser e Char
ws :: forall e. Parser e Char
ws = (Char -> Bool) -> ParserT PureMode e Char
forall (st :: ZeroBitType) e. (Char -> Bool) -> ParserT st e Char
satisfy Char -> Bool
isWhitespace
wss :: Parser e ByteString
wss :: forall e. Parser e ByteString
wss = ParserT PureMode e String -> ParserT PureMode e ByteString
forall (st :: ZeroBitType) e a.
ParserT st e a -> ParserT st e ByteString
byteStringOf (ParserT PureMode e String -> ParserT PureMode e ByteString)
-> ParserT PureMode e String -> ParserT PureMode e ByteString
forall a b. (a -> b) -> a -> b
$ ParserT PureMode e Char -> ParserT PureMode e String
forall a. ParserT PureMode e a -> ParserT PureMode e [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some ParserT PureMode e Char
forall e. Parser e Char
ws
sq :: ParserT st e ()
sq :: forall (st :: ZeroBitType) e. ParserT st e ()
sq = $(char '\'')
dq :: ParserT st e ()
dq :: forall (st :: ZeroBitType) e. ParserT st e ()
dq = $(char '"')
nota :: Char -> Parser e ByteString
nota :: forall e. Char -> Parser e ByteString
nota Char
c = ParserT PureMode e ()
-> (() -> Span -> ParserT PureMode e ByteString)
-> ParserT PureMode e ByteString
forall (st :: ZeroBitType) e a b.
ParserT st e a -> (a -> Span -> ParserT st e b) -> ParserT st e b
withSpan (ParserT PureMode e Char -> ParserT PureMode e ()
forall (st :: ZeroBitType) e a. ParserT st e a -> ParserT st e ()
skipMany ((Char -> Bool) -> ParserT PureMode e Char
forall (st :: ZeroBitType) e. (Char -> Bool) -> ParserT st e Char
satisfy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
c))) (\() Span
s -> Span -> ParserT PureMode e ByteString
forall (st :: ZeroBitType) e. Span -> ParserT st e ByteString
unsafeSpanToByteString Span
s)
{-# INLINE nota #-}
isa :: (Char -> Bool) -> Parser e ByteString
isa :: forall e. (Char -> Bool) -> Parser e ByteString
isa Char -> Bool
p = ParserT PureMode e ()
-> (() -> Span -> ParserT PureMode e ByteString)
-> ParserT PureMode e ByteString
forall (st :: ZeroBitType) e a b.
ParserT st e a -> (a -> Span -> ParserT st e b) -> ParserT st e b
withSpan (ParserT PureMode e Char -> ParserT PureMode e ()
forall (st :: ZeroBitType) e a. ParserT st e a -> ParserT st e ()
skipMany ((Char -> Bool) -> ParserT PureMode e Char
forall (st :: ZeroBitType) e. (Char -> Bool) -> ParserT st e Char
satisfy Char -> Bool
p)) (\() Span
s -> Span -> ParserT PureMode e ByteString
forall (st :: ZeroBitType) e. Span -> ParserT st e ByteString
unsafeSpanToByteString Span
s)
{-# INLINE isa #-}
byteStringOf' :: Parser e a -> Parser e ByteString
byteStringOf' :: forall e a. Parser e a -> Parser e ByteString
byteStringOf' Parser e a
p = Parser e a
-> (a -> Span -> ParserT PureMode e ByteString)
-> ParserT PureMode e ByteString
forall (st :: ZeroBitType) e a b.
ParserT st e a -> (a -> Span -> ParserT st e b) -> ParserT st e b
withSpan Parser e a
p (\a
_ Span
s -> Span -> ParserT PureMode e ByteString
forall (st :: ZeroBitType) e. Span -> ParserT st e ByteString
unsafeSpanToByteString Span
s)
{-# INLINE byteStringOf' #-}
wrappedSq :: Parser b ByteString
wrappedSq :: forall e. Parser e ByteString
wrappedSq = $(char '\'') ParserT PureMode b ()
-> ParserT PureMode b ByteString -> ParserT PureMode b ByteString
forall a b.
ParserT PureMode b a
-> ParserT PureMode b b -> ParserT PureMode b b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Char -> ParserT PureMode b ByteString
forall e. Char -> Parser e ByteString
nota Char
'\'' ParserT PureMode b ByteString
-> ParserT PureMode b () -> ParserT PureMode b ByteString
forall a b.
ParserT PureMode b a
-> ParserT PureMode b b -> ParserT PureMode b a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* $(char '\'')
{-# INLINE wrappedSq #-}
wrappedDq :: Parser b ByteString
wrappedDq :: forall e. Parser e ByteString
wrappedDq = $(char '"') ParserT PureMode b ()
-> ParserT PureMode b ByteString -> ParserT PureMode b ByteString
forall a b.
ParserT PureMode b a
-> ParserT PureMode b b -> ParserT PureMode b b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Char -> ParserT PureMode b ByteString
forall e. Char -> Parser e ByteString
nota Char
'"' ParserT PureMode b ByteString
-> ParserT PureMode b () -> ParserT PureMode b ByteString
forall a b.
ParserT PureMode b a
-> ParserT PureMode b b -> ParserT PureMode b a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* $(char '"')
{-# INLINE wrappedDq #-}
wrappedQ :: Parser e ByteString
wrappedQ :: forall e. Parser e ByteString
wrappedQ =
Parser e ByteString
forall e. Parser e ByteString
wrappedDq
Parser e ByteString -> Parser e ByteString -> Parser e ByteString
forall (st :: ZeroBitType) e a.
ParserT st e a -> ParserT st e a -> ParserT st e a
<|> Parser e ByteString
forall e. Parser e ByteString
wrappedSq
{-# INLINE wrappedQ #-}
wrappedQNoGuard :: Parser e a -> Parser e a
wrappedQNoGuard :: forall e a. Parser e a -> Parser e a
wrappedQNoGuard Parser e a
p = Parser e () -> Parser e a -> Parser e a
forall e a. Parser e () -> Parser e a -> Parser e a
wrapped Parser e ()
forall (st :: ZeroBitType) e. ParserT st e ()
dq Parser e a
p Parser e a -> Parser e a -> Parser e a
forall (st :: ZeroBitType) e a.
ParserT st e a -> ParserT st e a -> ParserT st e a
<|> Parser e () -> Parser e a -> Parser e a
forall e a. Parser e () -> Parser e a -> Parser e a
wrapped Parser e ()
forall (st :: ZeroBitType) e. ParserT st e ()
sq Parser e a
p
eq :: Parser e ()
eq :: forall e. Parser e ()
eq = Parser e ()
forall e. Parser e ()
ws_ Parser e () -> Parser e () -> Parser e ()
forall a b.
ParserT PureMode e a
-> ParserT PureMode e b -> ParserT PureMode e b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> $(char '=') Parser e () -> Parser e () -> Parser e ()
forall a b.
ParserT PureMode e a
-> ParserT PureMode e b -> ParserT PureMode e a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser e ()
forall e. Parser e ()
ws_
{-# INLINE eq #-}
sep :: Parser e s -> Parser e a -> Parser e [a]
sep :: forall e s a. Parser e s -> Parser e a -> Parser e [a]
sep Parser e s
s Parser e a
p = (:) (a -> [a] -> [a]) -> Parser e a -> ParserT PureMode e ([a] -> [a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser e a
p ParserT PureMode e ([a] -> [a])
-> ParserT PureMode e [a] -> ParserT PureMode e [a]
forall a b.
ParserT PureMode e (a -> b)
-> ParserT PureMode e a -> ParserT PureMode e b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser e a -> ParserT PureMode e [a]
forall a. ParserT PureMode e a -> ParserT PureMode e [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Parser e s
s Parser e s -> Parser e a -> Parser e a
forall a b.
ParserT PureMode e a
-> ParserT PureMode e b -> ParserT PureMode e b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser e a
p)
bracketed :: Parser e b -> Parser e b -> Parser e a -> Parser e a
bracketed :: forall e b a. Parser e b -> Parser e b -> Parser e a -> Parser e a
bracketed Parser e b
o Parser e b
c Parser e a
p = Parser e b
o Parser e b -> Parser e a -> Parser e a
forall a b.
ParserT PureMode e a
-> ParserT PureMode e b -> ParserT PureMode e b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser e a
p Parser e a -> Parser e b -> Parser e a
forall a b.
ParserT PureMode e a
-> ParserT PureMode e b -> ParserT PureMode e a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser e b
c
{-# INLINE bracketed #-}
bracketedSB :: Parser e [Char]
bracketedSB :: forall e. Parser e String
bracketedSB = Parser e () -> Parser e () -> Parser e String -> Parser e String
forall e b a. Parser e b -> Parser e b -> Parser e a -> Parser e a
bracketed $(char '[') $(char ']') (ParserT PureMode e Char -> Parser e String
forall a. ParserT PureMode e a -> ParserT PureMode e [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many ((Char -> Bool) -> ParserT PureMode e Char
forall (st :: ZeroBitType) e. (Char -> Bool) -> ParserT st e Char
satisfy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
']')))
wrapped :: Parser e () -> Parser e a -> Parser e a
wrapped :: forall e a. Parser e () -> Parser e a -> Parser e a
wrapped Parser e ()
x Parser e a
p = Parser e () -> Parser e () -> Parser e a -> Parser e a
forall e b a. Parser e b -> Parser e b -> Parser e a -> Parser e a
bracketed Parser e ()
x Parser e ()
x Parser e a
p
{-# INLINE wrapped #-}
digit :: Parser e Int
digit :: forall e. Parser e Int
digit = (\Char
c -> Char -> Int
ord Char
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'0') (Char -> Int) -> ParserT PureMode e Char -> ParserT PureMode e Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> ParserT PureMode e Char
forall (st :: ZeroBitType) e. (Char -> Bool) -> ParserT st e Char
satisfyAscii Char -> Bool
isDigit
int :: Parser e Int
int :: forall e. Parser e Int
int = do
(Int
place, Int
n) <- (Int -> (Int, Int) -> (Int, Int))
-> Parser e Int
-> ParserT PureMode e (Int, Int)
-> ParserT PureMode e (Int, Int)
forall a b (st :: ZeroBitType) e.
(a -> b -> b) -> ParserT st e a -> ParserT st e b -> ParserT st e b
chainr (\Int
n (!Int
place, !Int
acc) -> (Int
place Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
10, Int
acc Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
place Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
n)) Parser e Int
forall e. Parser e Int
digit ((Int, Int) -> ParserT PureMode e (Int, Int)
forall a. a -> ParserT PureMode e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
1, Int
0))
case Int
place of
Int
1 -> Parser e Int
forall a. ParserT PureMode e a
forall (f :: * -> *) a. Alternative f => f a
empty
Int
_ -> Int -> Parser e Int
forall a. a -> ParserT PureMode e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
n
digits :: Parser e (Int, Int)
digits :: forall e. Parser e (Int, Int)
digits = do
(Int
place, Int
n) <- (Int -> (Int, Int) -> (Int, Int))
-> ParserT PureMode e Int
-> Parser e (Int, Int)
-> Parser e (Int, Int)
forall a b (st :: ZeroBitType) e.
(a -> b -> b) -> ParserT st e a -> ParserT st e b -> ParserT st e b
chainr (\Int
n (!Int
place, !Int
acc) -> (Int
place Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
10, Int
acc Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
place Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
n)) ParserT PureMode e Int
forall e. Parser e Int
digit ((Int, Int) -> Parser e (Int, Int)
forall a. a -> ParserT PureMode e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
1, Int
0))
case Int
place of
Int
1 -> Parser e (Int, Int)
forall a. ParserT PureMode e a
forall (f :: * -> *) a. Alternative f => f a
empty
Int
_ -> (Int, Int) -> Parser e (Int, Int)
forall a. a -> ParserT PureMode e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
place, Int
n)
double :: Parser e Double
double :: forall e. Parser e Double
double = do
(Int
placel, Int
nl) <- Parser e (Int, Int)
forall e. Parser e (Int, Int)
digits
Parser e (Int, Int)
-> ((Int, Int) -> Parser e Double)
-> Parser e Double
-> Parser e Double
forall (st :: ZeroBitType) e a r.
ParserT st e a
-> (a -> ParserT st e r) -> ParserT st e r -> ParserT st e r
withOption
($(char '.') ParserT PureMode e () -> Parser e (Int, Int) -> Parser e (Int, Int)
forall a b.
ParserT PureMode e a
-> ParserT PureMode e b -> ParserT PureMode e b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser e (Int, Int)
forall e. Parser e (Int, Int)
digits)
( \(Int
placer, Int
nr) ->
case Int
placel of
Int
1 -> Parser e Double
forall a. ParserT PureMode e a
forall (f :: * -> *) a. Alternative f => f a
empty
Int
_ -> Double -> Parser e Double
forall a. a -> ParserT PureMode e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Double -> Parser e Double) -> Double -> Parser e Double
forall a b. (a -> b) -> a -> b
$ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nl Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nr Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
placer
)
( case Int
placel of
Int
1 -> Parser e Double
forall a. ParserT PureMode e a
forall (f :: * -> *) a. Alternative f => f a
empty
Int
_ -> Double -> Parser e Double
forall a. a -> ParserT PureMode e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Double -> Parser e Double) -> Double -> Parser e Double
forall a b. (a -> b) -> a -> b
$ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nl
)
minus :: Parser e ()
minus :: forall e. Parser e ()
minus = $(char '-') ParserT PureMode e ()
-> ParserT PureMode e () -> ParserT PureMode e ()
forall (st :: ZeroBitType) e a.
ParserT st e a -> ParserT st e a -> ParserT st e a
<|> ByteString -> ParserT PureMode e ()
forall (st :: ZeroBitType) e. ByteString -> ParserT st e ()
byteString ByteString
"¯"
signed :: (Num b) => Parser e b -> Parser e b
signed :: forall b e. Num b => Parser e b -> Parser e b
signed Parser e b
p = do
Maybe ()
m <- ParserT PureMode e () -> ParserT PureMode e (Maybe ())
forall (st :: ZeroBitType) e a.
ParserT st e a -> ParserT st e (Maybe a)
optional ParserT PureMode e ()
forall e. Parser e ()
minus
case Maybe ()
m of
Maybe ()
Nothing -> Parser e b
p
Just () -> b -> b
forall a. Num a => a -> a
negate (b -> b) -> Parser e b -> Parser e b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser e b
p
comma :: Parser e ()
comma :: forall e. Parser e ()
comma = $(char ',')