{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE UnboxedTuples #-}
module Data.Bencode.Decode
(
Parser
, decode
, decodeMaybe
, string
, stringEq
, text
, textEq
, integer
, int
, intEq
, int64
, int32
, int16
, int8
, word
, word64
, word32
, word16
, word8
, list
, index
, elem
, list'
, Elems
, dict
, field
, field'
, dict'
, Fields
, value
, fail
, mapMaybe
, mapOrFail
) where
import Prelude hiding (elem, fail)
import Control.Applicative
import Control.Monad hiding (fail)
import Control.Monad.ST
import Control.Monad.Trans.Class
import Control.Monad.Trans.Reader
import Control.Monad.Trans.State.Strict
import Data.Int
import Data.Word
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as BC
import qualified Data.Foldable as F
import qualified Data.IntSet as IS
import qualified Data.Map as M
import qualified Data.Primitive.Array as A
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Data.Vector as V
import qualified Data.Vector.Mutable as VM
import qualified GHC.Exts as X
import Data.Bencode.Type (Value(..))
import qualified Data.Bencode.Util as Util
import qualified Data.Bencode.AST as AST
newtype ParseResult a = ParseResult { forall a. ParseResult a -> Either String a
unParseResult :: Either String a }
deriving (forall a b. a -> ParseResult b -> ParseResult a
forall a b. (a -> b) -> ParseResult a -> ParseResult 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 -> ParseResult b -> ParseResult a
$c<$ :: forall a b. a -> ParseResult b -> ParseResult a
fmap :: forall a b. (a -> b) -> ParseResult a -> ParseResult b
$cfmap :: forall a b. (a -> b) -> ParseResult a -> ParseResult b
Functor, Functor ParseResult
forall a. a -> ParseResult a
forall a b. ParseResult a -> ParseResult b -> ParseResult a
forall a b. ParseResult a -> ParseResult b -> ParseResult b
forall a b. ParseResult (a -> b) -> ParseResult a -> ParseResult b
forall a b c.
(a -> b -> c) -> ParseResult a -> ParseResult b -> ParseResult c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b. ParseResult a -> ParseResult b -> ParseResult a
$c<* :: forall a b. ParseResult a -> ParseResult b -> ParseResult a
*> :: forall a b. ParseResult a -> ParseResult b -> ParseResult b
$c*> :: forall a b. ParseResult a -> ParseResult b -> ParseResult b
liftA2 :: forall a b c.
(a -> b -> c) -> ParseResult a -> ParseResult b -> ParseResult c
$cliftA2 :: forall a b c.
(a -> b -> c) -> ParseResult a -> ParseResult b -> ParseResult c
<*> :: forall a b. ParseResult (a -> b) -> ParseResult a -> ParseResult b
$c<*> :: forall a b. ParseResult (a -> b) -> ParseResult a -> ParseResult b
pure :: forall a. a -> ParseResult a
$cpure :: forall a. a -> ParseResult a
Applicative, Applicative ParseResult
forall a. a -> ParseResult a
forall a b. ParseResult a -> ParseResult b -> ParseResult b
forall a b. ParseResult a -> (a -> ParseResult b) -> ParseResult b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> ParseResult a
$creturn :: forall a. a -> ParseResult a
>> :: forall a b. ParseResult a -> ParseResult b -> ParseResult b
$c>> :: forall a b. ParseResult a -> ParseResult b -> ParseResult b
>>= :: forall a b. ParseResult a -> (a -> ParseResult b) -> ParseResult b
$c>>= :: forall a b. ParseResult a -> (a -> ParseResult b) -> ParseResult b
Monad)
failResult :: String -> ParseResult a
failResult :: forall a. String -> ParseResult a
failResult = forall a. Either String a -> ParseResult a
ParseResult forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left
{-# INLINE failResult #-}
instance Alternative ParseResult where
empty :: forall a. ParseResult a
empty = forall a. String -> ParseResult a
failResult String
"Alternative.empty"
ParseResult a
l <|> :: forall a. ParseResult a -> ParseResult a -> ParseResult a
<|> ParseResult a
r = forall a. Either String a -> ParseResult a
ParseResult forall a b. (a -> b) -> a -> b
$ forall a. ParseResult a -> Either String a
unParseResult ParseResult a
l forall a. Semigroup a => a -> a -> a
<> forall a. ParseResult a -> Either String a
unParseResult ParseResult a
r
instance MonadPlus ParseResult
newtype Parser a = Parser { forall a. Parser a -> ReaderT Value ParseResult a
runParser_ :: ReaderT AST.Value ParseResult a }
deriving (forall a b. a -> Parser b -> Parser a
forall a b. (a -> b) -> Parser a -> Parser 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 -> Parser b -> Parser a
$c<$ :: forall a b. a -> Parser b -> Parser a
fmap :: forall a b. (a -> b) -> Parser a -> Parser b
$cfmap :: forall a b. (a -> b) -> Parser a -> Parser b
Functor, Functor Parser
forall a. a -> Parser a
forall a b. Parser a -> Parser b -> Parser a
forall a b. Parser a -> Parser b -> Parser b
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall a b c. (a -> b -> c) -> Parser a -> Parser b -> Parser c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b. Parser a -> Parser b -> Parser a
$c<* :: forall a b. Parser a -> Parser b -> Parser a
*> :: forall a b. Parser a -> Parser b -> Parser b
$c*> :: forall a b. Parser a -> Parser b -> Parser b
liftA2 :: forall a b c. (a -> b -> c) -> Parser a -> Parser b -> Parser c
$cliftA2 :: forall a b c. (a -> b -> c) -> Parser a -> Parser b -> Parser c
<*> :: forall a b. Parser (a -> b) -> Parser a -> Parser b
$c<*> :: forall a b. Parser (a -> b) -> Parser a -> Parser b
pure :: forall a. a -> Parser a
$cpure :: forall a. a -> Parser a
Applicative, Applicative Parser
forall a. Parser a
forall a. Parser a -> Parser [a]
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *).
Applicative f
-> (forall a. f a)
-> (forall a. f a -> f a -> f a)
-> (forall a. f a -> f [a])
-> (forall a. f a -> f [a])
-> Alternative f
many :: forall a. Parser a -> Parser [a]
$cmany :: forall a. Parser a -> Parser [a]
some :: forall a. Parser a -> Parser [a]
$csome :: forall a. Parser a -> Parser [a]
<|> :: forall a. Parser a -> Parser a -> Parser a
$c<|> :: forall a. Parser a -> Parser a -> Parser a
empty :: forall a. Parser a
$cempty :: forall a. Parser a
Alternative, Applicative Parser
forall a. a -> Parser a
forall a b. Parser a -> Parser b -> Parser b
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> Parser a
$creturn :: forall a. a -> Parser a
>> :: forall a b. Parser a -> Parser b -> Parser b
$c>> :: forall a b. Parser a -> Parser b -> Parser b
>>= :: forall a b. Parser a -> (a -> Parser b) -> Parser b
$c>>= :: forall a b. Parser a -> (a -> Parser b) -> Parser b
Monad)
runParser :: Parser a -> AST.Value -> ParseResult a
runParser :: forall a. Parser a -> Value -> ParseResult a
runParser = forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Parser a -> ReaderT Value ParseResult a
runParser_
{-# INLINE runParser #-}
liftP :: ParseResult a -> Parser a
liftP :: forall a. ParseResult a -> Parser a
liftP = forall a. ReaderT Value ParseResult a -> Parser a
Parser forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
{-# INLINE liftP #-}
failParser :: String -> Parser a
failParser :: forall a. String -> Parser a
failParser = forall a. ParseResult a -> Parser a
liftP forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. String -> ParseResult a
failResult
{-# INLINE failParser #-}
decode :: Parser a -> B.ByteString -> Either String a
decode :: forall a. Parser a -> ByteString -> Either String a
decode Parser a
p ByteString
s = ByteString -> Either String Value
AST.parseOnly ByteString
s forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. ParseResult a -> Either String a
unParseResult forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Parser a -> Value -> ParseResult a
runParser Parser a
p
decodeMaybe :: Parser a -> B.ByteString -> Maybe a
decodeMaybe :: forall a. Parser a -> ByteString -> Maybe a
decodeMaybe Parser a
p = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Parser a -> ByteString -> Either String a
decode Parser a
p
errTypeMismatch :: String -> AST.Value -> ParseResult a
errTypeMismatch :: forall a. String -> Value -> ParseResult a
errTypeMismatch String
a Value
b = forall a. String -> ParseResult a
failResult forall a b. (a -> b) -> a -> b
$ String
"TypeMismatch " forall a. [a] -> [a] -> [a]
++ String
a forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ String
b'
where
b' :: String
b' = case Value
b of
AST.String ByteString
_ -> String
"String"
AST.Integer ByteString
_ -> String
"Integer"
AST.List Array Value
_ -> String
"List"
AST.Dict Array KeyValue
_ -> String
"Dict"
stringDirect :: Parser B.ByteString
stringDirect :: Parser ByteString
stringDirect = forall a. ReaderT Value ParseResult a -> Parser a
Parser forall a b. (a -> b) -> a -> b
$ forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \Value
v -> case Value
v of
AST.String ByteString
s -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
s
Value
_ -> forall a. String -> Value -> ParseResult a
errTypeMismatch String
"String" Value
v
{-# INLINE stringDirect #-}
integerDirect :: Parser B.ByteString
integerDirect :: Parser ByteString
integerDirect = forall a. ReaderT Value ParseResult a -> Parser a
Parser forall a b. (a -> b) -> a -> b
$ forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \Value
v -> case Value
v of
AST.Integer ByteString
s -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
s
Value
_ -> forall a. String -> Value -> ParseResult a
errTypeMismatch String
"Integer" Value
v
{-# INLINE integerDirect #-}
listDirect :: Parser (A.Array AST.Value)
listDirect :: Parser (Array Value)
listDirect = forall a. ReaderT Value ParseResult a -> Parser a
Parser forall a b. (a -> b) -> a -> b
$ forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \Value
v -> case Value
v of
AST.List Array Value
a -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Array Value
a
Value
_ -> forall a. String -> Value -> ParseResult a
errTypeMismatch String
"List" Value
v
{-# INLINE listDirect #-}
dictDirect :: Parser (A.Array AST.KeyValue)
dictDirect :: Parser (Array KeyValue)
dictDirect = forall a. ReaderT Value ParseResult a -> Parser a
Parser forall a b. (a -> b) -> a -> b
$ forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \Value
v -> case Value
v of
AST.Dict Array KeyValue
a -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Array KeyValue
a
Value
_ -> forall a. String -> Value -> ParseResult a
errTypeMismatch String
"Dict" Value
v
{-# INLINE dictDirect #-}
string :: Parser B.ByteString
string :: Parser ByteString
string = Parser ByteString
stringDirect
{-# INLINE string #-}
integer :: Parser Integer
integer :: Parser Integer
integer = ByteString -> Integer
toI forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Parser ByteString
integerDirect
where
toI :: ByteString -> Integer
toI ByteString
s = case ByteString -> Maybe (Integer, ByteString)
BC.readInteger ByteString
s of
Maybe (Integer, ByteString)
Nothing -> forall a. HasCallStack => String -> a
error String
"Data.Bencode.Decode.integer: should not happen"
Just (Integer
i,ByteString
_) -> Integer
i
{-# INLINE integer #-}
list :: Parser a -> Parser (V.Vector a)
list :: forall a. Parser a -> Parser (Vector a)
list Parser a
p = Parser (Array Value)
listDirect forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. ParseResult a -> Parser a
liftP forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b.
(a -> ParseResult b) -> Array a -> ParseResult (Vector b)
traverseAToV (forall a. Parser a -> Value -> ParseResult a
runParser Parser a
p)
{-# INLINE list #-}
traverseAToV :: (a -> ParseResult b) -> A.Array a -> ParseResult (V.Vector b)
traverseAToV :: forall a b.
(a -> ParseResult b) -> Array a -> ParseResult (Vector b)
traverseAToV a -> ParseResult b
f Array a
a = forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ do
let n :: Int
n = forall a. Array a -> Int
A.sizeofArray Array a
a
MVector (PrimState (ST s)) b
v <- forall (m :: * -> *) a.
PrimMonad m =>
Int -> m (MVector (PrimState m) a)
VM.new Int
n
let loop :: Int -> ST s (Maybe String)
loop Int
i | Int
i forall a. Eq a => a -> a -> Bool
== Int
n = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
loop Int
i = case a -> ParseResult b
f (forall a. Array a -> Int -> a
A.indexArray Array a
a Int
i) of
ParseResult (Left String
e) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. a -> Maybe a
Just String
e)
ParseResult (Right b
x) -> forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> a -> m ()
VM.write MVector (PrimState (ST s)) b
v Int
i b
x forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Int -> ST s (Maybe String)
loop (Int
iforall a. Num a => a -> a -> a
+Int
1)
Maybe String
res <- Int -> ST s (Maybe String)
loop Int
0
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> m (Vector a)
V.unsafeFreeze MVector (PrimState (ST s)) b
v) (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. String -> ParseResult a
failResult) Maybe String
res
{-# INLINABLE traverseAToV #-}
dict :: Parser a -> Parser (M.Map B.ByteString a)
dict :: forall a. Parser a -> Parser (Map ByteString a)
dict Parser a
p =
Parser (Array KeyValue)
dictDirect forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. ParseResult a -> Parser a
liftP forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall k a. [(k, a)] -> Map k a
M.fromDistinctAscList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse KeyValue -> ParseResult (ByteString, a)
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList
where
f :: KeyValue -> ParseResult (ByteString, a)
f (AST.KeyValue ByteString
k Value
v) = (,) ByteString
k forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Parser a -> Value -> ParseResult a
runParser Parser a
p Value
v
{-# INLINE dict #-}
stringEq :: B.ByteString -> Parser ()
stringEq :: ByteString -> Parser ()
stringEq ByteString
s = Parser ByteString
stringDirect forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ByteString
s' ->
if ByteString
s forall a. Eq a => a -> a -> Bool
== ByteString
s'
then forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
else forall a. String -> Parser a
failParser forall a b. (a -> b) -> a -> b
$ String
"StringNotEq " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show ByteString
s forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show ByteString
s'
{-# INLINE stringEq #-}
text :: Parser T.Text
text :: Parser Text
text =
Parser ByteString
stringDirect forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const (forall a. String -> Parser a
failParser String
"UTF8DecodeFailure")) forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either UnicodeException Text
T.decodeUtf8'
{-# INLINE text #-}
textEq :: T.Text -> Parser ()
textEq :: Text -> Parser ()
textEq Text
t = Parser Text
text forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Text
t' ->
if Text
t forall a. Eq a => a -> a -> Bool
== Text
t'
then forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
else forall a. String -> Parser a
failParser forall a b. (a -> b) -> a -> b
$ String
"TextNotEq " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Text
t forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Text
t'
{-# INLINE textEq #-}
int :: Parser Int
int :: Parser Int
int = Parser ByteString
integerDirect forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a. String -> Parser a
failParser String
"IntOutOfBounds") forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe Int
go
where
go :: ByteString -> Maybe Int
go ByteString
s = case ByteString -> Maybe (Char, ByteString)
BC.uncons ByteString
s of
Just (Char
'-', ByteString
s') -> Bool -> ByteString -> Maybe Int
Util.readKnownNaturalAsInt Bool
True ByteString
s'
Maybe (Char, ByteString)
_ -> Bool -> ByteString -> Maybe Int
Util.readKnownNaturalAsInt Bool
False ByteString
s
{-# INLINE int #-}
intEq :: Int -> Parser ()
intEq :: Int -> Parser ()
intEq Int
i = Parser Int
int forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Int
i' ->
if Int
i forall a. Eq a => a -> a -> Bool
== Int
i'
then forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
else forall a. String -> Parser a
failParser forall a b. (a -> b) -> a -> b
$ String
"IntNotEq " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
i forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
i'
{-# INLINE intEq #-}
word :: Parser Word
word :: Parser Word
word = Parser ByteString
integerDirect forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a. String -> Parser a
failParser String
"WordOutOfBounds") forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe Word
go
where
go :: ByteString -> Maybe Word
go ByteString
s = case ByteString -> Maybe (Char, ByteString)
BC.uncons ByteString
s of
Just (Char
'-',ByteString
_) -> forall a. Maybe a
Nothing
Maybe (Char, ByteString)
_ -> ByteString -> Maybe Word
Util.readKnownNaturalAsWord ByteString
s
{-# INLINE word #-}
value :: Parser Value
value :: Parser Value
value = ByteString -> Value
String forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString
string
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Integer -> Value
Integer forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Integer
integer
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Vector Value -> Value
List forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Parser a -> Parser (Vector a)
list Parser Value
value
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Map ByteString Value -> Value
Dict forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Parser a -> Parser (Map ByteString a)
dict Parser Value
value
fail :: String -> Parser a
fail :: forall a. String -> Parser a
fail = forall a. String -> Parser a
failParser forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"Fail: " forall a. [a] -> [a] -> [a]
++ )
{-# INLINE fail #-}
field :: B.ByteString -> Parser a -> Parser a
field :: forall a. ByteString -> Parser a -> Parser a
field ByteString
k Parser a
p = do
Array KeyValue
a <- Parser (Array KeyValue)
dictDirect
case ByteString -> Array KeyValue -> (# (# #) | (# Int#, Value #) #)
binarySearch ByteString
k Array KeyValue
a of
(# (# #)
_ | #) -> forall a. String -> Parser a
failParser forall a b. (a -> b) -> a -> b
$ String
"KeyNotFound " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show ByteString
k
(# | (# Int#
_, Value
x #) #) -> forall a. ParseResult a -> Parser a
liftP forall a b. (a -> b) -> a -> b
$ forall a. Parser a -> Value -> ParseResult a
runParser Parser a
p Value
x
{-# INLINE field #-}
field' :: B.ByteString -> Parser a -> Fields a
field' :: forall a. ByteString -> Parser a -> Fields a
field' ByteString
k Parser a
p = forall a.
ReaderT (Array KeyValue) (StateT IntSet ParseResult) a -> Fields a
Fields forall a b. (a -> b) -> a -> b
$ forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \Array KeyValue
a -> case ByteString -> Array KeyValue -> (# (# #) | (# Int#, Value #) #)
binarySearch ByteString
k Array KeyValue
a of
(# (# #)
_ | #) -> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. String -> ParseResult a
failResult forall a b. (a -> b) -> a -> b
$ String
"KeyNotFound " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show ByteString
k
(# | (# Int#
i#, Value
v #) #) -> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall a. Parser a -> Value -> ParseResult a
runParser Parser a
p Value
v) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify' (Int -> IntSet -> IntSet
IS.insert (Int# -> Int
X.I# Int#
i#))
{-# INLINE field' #-}
dict' :: Fields a -> Parser a
dict' :: forall a. Fields a -> Parser a
dict' Fields a
fs = do
Array KeyValue
a <- Parser (Array KeyValue)
dictDirect
forall a. ParseResult a -> Parser a
liftP forall a b. (a -> b) -> a -> b
$ do
(a
v, IntSet
is) <- forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (forall a.
Fields a -> ReaderT (Array KeyValue) (StateT IntSet ParseResult) a
runFields Fields a
fs) Array KeyValue
a) IntSet
IS.empty
if IntSet -> Int
IS.size IntSet
is forall a. Eq a => a -> a -> Bool
== forall a. Array a -> Int
A.sizeofArray Array KeyValue
a
then forall (f :: * -> *) a. Applicative f => a -> f a
pure a
v
else let i :: Int
i = forall a. [a] -> a
head forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (Int -> IntSet -> Bool
`IS.notMember` IntSet
is) [Int
0..]
AST.KeyValue ByteString
k Value
_ = forall a. Array a -> Int -> a
A.indexArray Array KeyValue
a Int
i
in forall a. String -> ParseResult a
failResult forall a b. (a -> b) -> a -> b
$ String
"UnrecognizedKey " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show ByteString
k
{-# INLINE dict' #-}
newtype Fields a = Fields
{ forall a.
Fields a -> ReaderT (Array KeyValue) (StateT IntSet ParseResult) a
runFields ::
ReaderT (A.Array AST.KeyValue) (StateT IS.IntSet ParseResult) a
} deriving (forall a b. a -> Fields b -> Fields a
forall a b. (a -> b) -> Fields a -> Fields 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 -> Fields b -> Fields a
$c<$ :: forall a b. a -> Fields b -> Fields a
fmap :: forall a b. (a -> b) -> Fields a -> Fields b
$cfmap :: forall a b. (a -> b) -> Fields a -> Fields b
Functor, Functor Fields
forall a. a -> Fields a
forall a b. Fields a -> Fields b -> Fields a
forall a b. Fields a -> Fields b -> Fields b
forall a b. Fields (a -> b) -> Fields a -> Fields b
forall a b c. (a -> b -> c) -> Fields a -> Fields b -> Fields c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b. Fields a -> Fields b -> Fields a
$c<* :: forall a b. Fields a -> Fields b -> Fields a
*> :: forall a b. Fields a -> Fields b -> Fields b
$c*> :: forall a b. Fields a -> Fields b -> Fields b
liftA2 :: forall a b c. (a -> b -> c) -> Fields a -> Fields b -> Fields c
$cliftA2 :: forall a b c. (a -> b -> c) -> Fields a -> Fields b -> Fields c
<*> :: forall a b. Fields (a -> b) -> Fields a -> Fields b
$c<*> :: forall a b. Fields (a -> b) -> Fields a -> Fields b
pure :: forall a. a -> Fields a
$cpure :: forall a. a -> Fields a
Applicative, Applicative Fields
forall a. Fields a
forall a. Fields a -> Fields [a]
forall a. Fields a -> Fields a -> Fields a
forall (f :: * -> *).
Applicative f
-> (forall a. f a)
-> (forall a. f a -> f a -> f a)
-> (forall a. f a -> f [a])
-> (forall a. f a -> f [a])
-> Alternative f
many :: forall a. Fields a -> Fields [a]
$cmany :: forall a. Fields a -> Fields [a]
some :: forall a. Fields a -> Fields [a]
$csome :: forall a. Fields a -> Fields [a]
<|> :: forall a. Fields a -> Fields a -> Fields a
$c<|> :: forall a. Fields a -> Fields a -> Fields a
empty :: forall a. Fields a
$cempty :: forall a. Fields a
Alternative, Applicative Fields
forall a. a -> Fields a
forall a b. Fields a -> Fields b -> Fields b
forall a b. Fields a -> (a -> Fields b) -> Fields b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> Fields a
$creturn :: forall a. a -> Fields a
>> :: forall a b. Fields a -> Fields b -> Fields b
$c>> :: forall a b. Fields a -> Fields b -> Fields b
>>= :: forall a b. Fields a -> (a -> Fields b) -> Fields b
$c>>= :: forall a b. Fields a -> (a -> Fields b) -> Fields b
Monad)
index :: Int -> Parser a -> Parser a
index :: forall a. Int -> Parser a -> Parser a
index Int
i Parser a
_ | Int
i forall a. Ord a => a -> a -> Bool
< Int
0 = forall a. String -> Parser a
failParser String
"IndexOutOfBounds"
index Int
i Parser a
p = do
Array Value
a <- Parser (Array Value)
listDirect
if Int
i forall a. Ord a => a -> a -> Bool
< forall a. Array a -> Int
A.sizeofArray Array Value
a
then forall a. ParseResult a -> Parser a
liftP forall a b. (a -> b) -> a -> b
$ forall a. Parser a -> Value -> ParseResult a
runParser Parser a
p (forall a. Array a -> Int -> a
A.indexArray Array Value
a Int
i)
else forall a. String -> Parser a
failParser String
"IndexOutOfBounds"
{-# INLINE index #-}
elem :: Parser a -> Elems a
elem :: forall a. Parser a -> Elems a
elem Parser a
p = forall a.
ReaderT (Array Value) (StateT Int ParseResult) a -> Elems a
Elems forall a b. (a -> b) -> a -> b
$ forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \Array Value
a -> do
Int
i <- forall (m :: * -> *) s. Monad m => StateT s m s
get
if Int
i forall a. Ord a => a -> a -> Bool
< forall a. Array a -> Int
A.sizeofArray Array Value
a
then forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall a. Parser a -> Value -> ParseResult a
runParser Parser a
p (forall a. Array a -> Int -> a
A.indexArray Array Value
a Int
i)) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put forall a b. (a -> b) -> a -> b
$! Int
iforall a. Num a => a -> a -> a
+Int
1)
else forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. String -> ParseResult a
failResult String
"ListElemsExhausted"
{-# INLINE elem #-}
list' :: Elems a -> Parser a
list' :: forall a. Elems a -> Parser a
list' Elems a
es = do
Array Value
a <- Parser (Array Value)
listDirect
forall a. ParseResult a -> Parser a
liftP forall a b. (a -> b) -> a -> b
$ do
(a
x, Int
i) <- forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (forall a.
Elems a -> ReaderT (Array Value) (StateT Int ParseResult) a
runElems Elems a
es) Array Value
a) Int
0
if Int
i forall a. Eq a => a -> a -> Bool
== forall a. Array a -> Int
A.sizeofArray Array Value
a
then forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
else forall a. String -> ParseResult a
failResult forall a b. (a -> b) -> a -> b
$ String
"ListElemsLeft"
{-# INLINE list' #-}
newtype Elems a = Elems
{ forall a.
Elems a -> ReaderT (Array Value) (StateT Int ParseResult) a
runElems :: ReaderT (A.Array AST.Value) (StateT Int ParseResult) a
} deriving (forall a b. a -> Elems b -> Elems a
forall a b. (a -> b) -> Elems a -> Elems 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 -> Elems b -> Elems a
$c<$ :: forall a b. a -> Elems b -> Elems a
fmap :: forall a b. (a -> b) -> Elems a -> Elems b
$cfmap :: forall a b. (a -> b) -> Elems a -> Elems b
Functor, Functor Elems
forall a. a -> Elems a
forall a b. Elems a -> Elems b -> Elems a
forall a b. Elems a -> Elems b -> Elems b
forall a b. Elems (a -> b) -> Elems a -> Elems b
forall a b c. (a -> b -> c) -> Elems a -> Elems b -> Elems c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b. Elems a -> Elems b -> Elems a
$c<* :: forall a b. Elems a -> Elems b -> Elems a
*> :: forall a b. Elems a -> Elems b -> Elems b
$c*> :: forall a b. Elems a -> Elems b -> Elems b
liftA2 :: forall a b c. (a -> b -> c) -> Elems a -> Elems b -> Elems c
$cliftA2 :: forall a b c. (a -> b -> c) -> Elems a -> Elems b -> Elems c
<*> :: forall a b. Elems (a -> b) -> Elems a -> Elems b
$c<*> :: forall a b. Elems (a -> b) -> Elems a -> Elems b
pure :: forall a. a -> Elems a
$cpure :: forall a. a -> Elems a
Applicative, Applicative Elems
forall a. Elems a
forall a. Elems a -> Elems [a]
forall a. Elems a -> Elems a -> Elems a
forall (f :: * -> *).
Applicative f
-> (forall a. f a)
-> (forall a. f a -> f a -> f a)
-> (forall a. f a -> f [a])
-> (forall a. f a -> f [a])
-> Alternative f
many :: forall a. Elems a -> Elems [a]
$cmany :: forall a. Elems a -> Elems [a]
some :: forall a. Elems a -> Elems [a]
$csome :: forall a. Elems a -> Elems [a]
<|> :: forall a. Elems a -> Elems a -> Elems a
$c<|> :: forall a. Elems a -> Elems a -> Elems a
empty :: forall a. Elems a
$cempty :: forall a. Elems a
Alternative, Applicative Elems
forall a. a -> Elems a
forall a b. Elems a -> Elems b -> Elems b
forall a b. Elems a -> (a -> Elems b) -> Elems b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> Elems a
$creturn :: forall a. a -> Elems a
>> :: forall a b. Elems a -> Elems b -> Elems b
$c>> :: forall a b. Elems a -> Elems b -> Elems b
>>= :: forall a b. Elems a -> (a -> Elems b) -> Elems b
$c>>= :: forall a b. Elems a -> (a -> Elems b) -> Elems b
Monad)
int64 :: Parser Int64
int64 :: Parser Int64
int64 = Parser ByteString
integerDirect forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a. String -> Parser a
failParser String
"IntOutOfBounds") forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe Int64
go
where
go :: ByteString -> Maybe Int64
go ByteString
s = case ByteString -> Maybe (Char, ByteString)
BC.uncons ByteString
s of
Just (Char
'-', ByteString
s') -> Bool -> ByteString -> Maybe Int64
Util.readKnownNaturalAsInt64 Bool
True ByteString
s'
Maybe (Char, ByteString)
_ -> Bool -> ByteString -> Maybe Int64
Util.readKnownNaturalAsInt64 Bool
False ByteString
s
{-# INLINE int64 #-}
int32 :: Parser Int32
int32 :: Parser Int32
int32 = forall a. (Bounded a, Integral a) => Parser a
intL32
{-# INLINE int32 #-}
int16 :: Parser Int16
int16 :: Parser Int16
int16 = forall a. (Bounded a, Integral a) => Parser a
intL32
{-# INLINE int16 #-}
int8 :: Parser Int8
int8 :: Parser Int8
int8 = forall a. (Bounded a, Integral a) => Parser a
intL32
{-# INLINE int8 #-}
intL32 :: forall a. (Bounded a, Integral a) => Parser a
intL32 :: forall a. (Bounded a, Integral a) => Parser a
intL32 = Parser Int
int forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Int
i ->
if forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
minBound :: a) forall a. Ord a => a -> a -> Bool
<= Int
i Bool -> Bool -> Bool
&& Int
i forall a. Ord a => a -> a -> Bool
<= forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
maxBound :: a)
then forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$! forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i
else forall a. String -> Parser a
failParser String
"IntOutOfBounds"
{-# INLINE intL32 #-}
word64 :: Parser Word64
word64 :: Parser Word64
word64 = Parser ByteString
integerDirect forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a. String -> Parser a
failParser String
"WordOutOfBounds") forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe Word64
go
where
go :: ByteString -> Maybe Word64
go ByteString
s = case ByteString -> Maybe (Char, ByteString)
BC.uncons ByteString
s of
Just (Char
'-', ByteString
_) -> forall a. Maybe a
Nothing
Maybe (Char, ByteString)
_ -> ByteString -> Maybe Word64
Util.readKnownNaturalAsWord64 ByteString
s
{-# INLINE word64 #-}
word32 :: Parser Word32
word32 :: Parser Word32
word32 = forall a. (Bounded a, Integral a) => Parser a
wordL32
{-# INLINE word32 #-}
word16 :: Parser Word16
word16 :: Parser Word16
word16 = forall a. (Bounded a, Integral a) => Parser a
wordL32
{-# INLINE word16 #-}
word8 :: Parser Word8
word8 :: Parser Word8
word8 = forall a. (Bounded a, Integral a) => Parser a
wordL32
{-# INLINE word8 #-}
wordL32 :: forall a. (Bounded a, Integral a) => Parser a
wordL32 :: forall a. (Bounded a, Integral a) => Parser a
wordL32 = Parser Word
word forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Word
i ->
if forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
minBound :: a) forall a. Ord a => a -> a -> Bool
<= Word
i Bool -> Bool -> Bool
&& Word
i forall a. Ord a => a -> a -> Bool
<= forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
maxBound :: a)
then forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$! forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
i
else forall a. String -> Parser a
failParser String
"WordOutOfBounds"
{-# INLINE wordL32 #-}
mapMaybe :: (a -> Maybe b) -> Parser a -> Parser b
mapMaybe :: forall a b. (a -> Maybe b) -> Parser a -> Parser b
mapMaybe a -> Maybe b
f Parser a
p = Parser a
p forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall (f :: * -> *) a. Alternative f => f a
empty forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe b
f
{-# INLINE mapMaybe #-}
mapOrFail :: (a -> Either String b) -> Parser a -> Parser b
mapOrFail :: forall a b. (a -> Either String b) -> Parser a -> Parser b
mapOrFail a -> Either String b
f Parser a
p = Parser a
p forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. String -> Parser a
fail forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either String b
f
{-# INLINE mapOrFail #-}
binarySearch
:: B.ByteString
-> A.Array AST.KeyValue
-> (# (# #) | (# X.Int#, AST.Value #) #)
binarySearch :: ByteString -> Array KeyValue -> (# (# #) | (# Int#, Value #) #)
binarySearch ByteString
k Array KeyValue
a = Int -> Int -> (# (# #) | (# Int#, Value #) #)
go Int
0 (forall a. Array a -> Int
A.sizeofArray Array KeyValue
a)
where
go :: Int -> Int -> (# (# #) | (# Int#, Value #) #)
go Int
l Int
r | Int
l forall a. Eq a => a -> a -> Bool
== Int
r = (# (# #) | #)
go Int
l Int
r = case forall a. Ord a => a -> a -> Ordering
compare ByteString
k ByteString
k' of
Ordering
LT -> Int -> Int -> (# (# #) | (# Int#, Value #) #)
go Int
l Int
m
Ordering
EQ -> (# | (# case Int
m of X.I# Int#
m# -> Int#
m#, Value
v #) #)
Ordering
GT -> Int -> Int -> (# (# #) | (# Int#, Value #) #)
go (Int
mforall a. Num a => a -> a -> a
+Int
1) Int
r
where
m :: Int
m = forall a b. (Integral a, Num b) => a -> b
fromIntegral ((forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
lforall a. Num a => a -> a -> a
+Int
r) :: Word) forall a. Integral a => a -> a -> a
`div` Word
2) :: Int
AST.KeyValue ByteString
k' Value
v = forall a. Array a -> Int -> a
A.indexArray Array KeyValue
a Int
m
{-# INLINABLE binarySearch #-}