{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Data.Bencode.AST
  ( Value(..)
  , KeyValue(..)
  , parseOnly
  ) where

import Data.Char (isDigit)
import Data.List (intercalate)
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as BC
import qualified Data.Primitive.Array as A

import Data.Bencode.Util (readKnownNaturalAsInt)

-- | The Bencode AST.
data Value
  = String  {-# UNPACK #-} !B.ByteString
  -- ^ Slice of the input @ByteString@.
  | Integer {-# UNPACK #-} !B.ByteString
  -- ^ Slice of the input @ByteString@, containing a valid integer. Parsing
  -- into an integral type is done later if required.
  | List    {-# UNPACK #-} !(A.Array Value)
  | Dict    {-# UNPACK #-} !(A.Array KeyValue)
  deriving (Value -> Value -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Value -> Value -> Bool
$c/= :: Value -> Value -> Bool
== :: Value -> Value -> Bool
$c== :: Value -> Value -> Bool
Eq, Int -> Value -> ShowS
[Value] -> ShowS
Value -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Value] -> ShowS
$cshowList :: [Value] -> ShowS
show :: Value -> String
$cshow :: Value -> String
showsPrec :: Int -> Value -> ShowS
$cshowsPrec :: Int -> Value -> ShowS
Show)

-- | A Bencode dict's key-value pair.
data KeyValue = KeyValue
  {-# UNPACK #-} !B.ByteString-- ^ Slice of the input @ByteString@.
  !Value
  deriving (KeyValue -> KeyValue -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: KeyValue -> KeyValue -> Bool
$c/= :: KeyValue -> KeyValue -> Bool
== :: KeyValue -> KeyValue -> Bool
$c== :: KeyValue -> KeyValue -> Bool
Eq, Int -> KeyValue -> ShowS
[KeyValue] -> ShowS
KeyValue -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [KeyValue] -> ShowS
$cshowList :: [KeyValue] -> ShowS
show :: KeyValue -> String
$cshow :: KeyValue -> String
showsPrec :: Int -> KeyValue -> ShowS
$cshowsPrec :: Int -> KeyValue -> ShowS
Show)

newtype Pos = Pos { Pos -> Int
unPos :: Int } deriving (Int -> Pos -> ShowS
[Pos] -> ShowS
Pos -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Pos] -> ShowS
$cshowList :: [Pos] -> ShowS
show :: Pos -> String
$cshow :: Pos -> String
showsPrec :: Int -> Pos -> ShowS
$cshowsPrec :: Int -> Pos -> ShowS
Show, Integer -> Pos
Pos -> Pos
Pos -> Pos -> Pos
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Pos
$cfromInteger :: Integer -> Pos
signum :: Pos -> Pos
$csignum :: Pos -> Pos
abs :: Pos -> Pos
$cabs :: Pos -> Pos
negate :: Pos -> Pos
$cnegate :: Pos -> Pos
* :: Pos -> Pos -> Pos
$c* :: Pos -> Pos -> Pos
- :: Pos -> Pos -> Pos
$c- :: Pos -> Pos -> Pos
+ :: Pos -> Pos -> Pos
$c+ :: Pos -> Pos -> Pos
Num)

-- | Either an error or the parsed value together with the unparsed
-- section of the input and number of bytes parsed.
type ParseOneResult = Either String (Value, B.ByteString, Int)

data Stack
  = SNil
  | SList {-# UNPACK #-} !Int ![Value] !Stack
  | SDict {-# UNPACK #-} !B.ByteString {-# UNPACK #-} !Int ![KeyValue] !Stack

-- | Parse one Bencode value from the given bytestring. Fails if the string is
-- not fully consumed.
parseOnly :: B.ByteString -> Either String Value
parseOnly :: ByteString -> Either String Value
parseOnly ByteString
s = case ByteString -> ParseOneResult
parseOne ByteString
s of
  Left String
e -> forall a b. a -> Either a b
Left String
e
  Right (Value
v, ByteString
s', Int
n) ->
    if ByteString -> Bool
B.null ByteString
s'
    then forall a b. b -> Either a b
Right Value
v
    else forall a. String -> Pos -> Either String a
errorAtPos String
"ExpectedEOF" (Int -> Pos
Pos Int
n)

-- | Parse one Bencode value from the given bytestring.
parseOne :: B.ByteString -> ParseOneResult
parseOne :: ByteString -> ParseOneResult
parseOne ByteString
s = case ByteString -> Maybe (Char, ByteString)
BC.uncons ByteString
s of
  Maybe (Char, ByteString)
Nothing -> forall a. Maybe Char -> Pos -> Either String a
errItem forall a. Maybe a
Nothing Pos
pos
  Just (Char
c,ByteString
s1) -> case Char
c of
    Char
_ | Char -> Bool
isDigit Char
c -> do
      (ByteString
str, ByteString
s2, Pos
pos2) <- ByteString -> Pos -> Either String (ByteString, ByteString, Pos)
parseString ByteString
s Pos
pos
      forall a b. b -> Either a b
Right (ByteString -> Value
String ByteString
str, ByteString
s2, Pos -> Int
unPos Pos
pos2)
    Char
'i' -> do
      (ByteString
i, ByteString
s2, Pos
pos2) <- ByteString -> Pos -> Either String (ByteString, ByteString, Pos)
parseInteger ByteString
s1 (Pos
posforall a. Num a => a -> a -> a
+Pos
1)
      forall a b. b -> Either a b
Right (ByteString -> Value
Integer ByteString
i, ByteString
s2, Pos -> Int
unPos Pos
pos2)
    Char
'l' -> Stack -> Int -> [Value] -> ByteString -> Pos -> ParseOneResult
parseList Stack
SNil Int
0 [] ByteString
s1 (Pos
posforall a. Num a => a -> a -> a
+Pos
1)
    Char
'd' -> Stack -> ByteString -> Pos -> ParseOneResult
parseDict Stack
SNil ByteString
s1 (Pos
posforall a. Num a => a -> a -> a
+Pos
1)
    Char
_   -> forall a. Maybe Char -> Pos -> Either String a
errItem (forall a. a -> Maybe a
Just Char
c) Pos
pos
  where
    pos :: Pos
pos = Int -> Pos
Pos Int
0

-- | Parse a Bencode list. After the \'l\' marker.
parseList :: Stack -> Int -> [Value] -> B.ByteString -> Pos -> ParseOneResult
parseList :: Stack -> Int -> [Value] -> ByteString -> Pos -> ParseOneResult
parseList Stack
stk !Int
n ![Value]
acc ByteString
s !Pos
pos = case ByteString -> Maybe (Char, ByteString)
BC.uncons ByteString
s of
  Maybe (Char, ByteString)
Nothing -> forall a. Maybe Char -> Pos -> Either String a
errItemOrEnd forall a. Maybe a
Nothing Pos
pos
  Just (Char
c,ByteString
s1) -> case Char
c of
    Char
_ | Char -> Bool
isDigit Char
c -> do
      (ByteString
str, ByteString
s2, Pos
pos2) <- ByteString -> Pos -> Either String (ByteString, ByteString, Pos)
parseString ByteString
s Pos
pos
      Stack -> Int -> [Value] -> ByteString -> Pos -> ParseOneResult
parseList Stack
stk (Int
nforall a. Num a => a -> a -> a
+Int
1) (ByteString -> Value
String ByteString
str forall a. a -> [a] -> [a]
: [Value]
acc) ByteString
s2 Pos
pos2
    Char
'i' -> do
      (ByteString
i, ByteString
s2, Pos
pos2) <- ByteString -> Pos -> Either String (ByteString, ByteString, Pos)
parseInteger ByteString
s1 (Pos
posforall a. Num a => a -> a -> a
+Pos
1)
      Stack -> Int -> [Value] -> ByteString -> Pos -> ParseOneResult
parseList Stack
stk (Int
nforall a. Num a => a -> a -> a
+Int
1) (ByteString -> Value
Integer ByteString
i forall a. a -> [a] -> [a]
: [Value]
acc) ByteString
s2 Pos
pos2
    Char
'l' -> Stack -> Int -> [Value] -> ByteString -> Pos -> ParseOneResult
parseList (Int -> [Value] -> Stack -> Stack
SList Int
n [Value]
acc Stack
stk) Int
0 [] ByteString
s1 (Pos
posforall a. Num a => a -> a -> a
+Pos
1)
    Char
'd' -> Stack -> ByteString -> Pos -> ParseOneResult
parseDict (Int -> [Value] -> Stack -> Stack
SList Int
n [Value]
acc Stack
stk) ByteString
s1 (Pos
posforall a. Num a => a -> a -> a
+Pos
1)
    Char
'e' -> Stack -> Value -> ByteString -> Pos -> ParseOneResult
resumeParse Stack
stk (Array Value -> Value
List (forall a. Int -> [a] -> Array a
arrayFromRevListN Int
n [Value]
acc)) ByteString
s1 (Pos
posforall a. Num a => a -> a -> a
+Pos
1)
    Char
_   -> forall a. Maybe Char -> Pos -> Either String a
errItemOrEnd (forall a. a -> Maybe a
Just Char
c) Pos
pos

-- | Parse a Bencode dict. After the \'d\' marker.
parseDict :: Stack -> B.ByteString -> Pos -> ParseOneResult
parseDict :: Stack -> ByteString -> Pos -> ParseOneResult
parseDict Stack
stk ByteString
s !Pos
pos = case ByteString -> Maybe (Char, ByteString)
BC.uncons ByteString
s of
  Maybe (Char, ByteString)
Nothing -> forall a. Maybe Char -> Pos -> Either String a
errStringOrEnd forall a. Maybe a
Nothing Pos
pos
  Just (Char
c1,ByteString
s1) -> case Char
c1 of
    Char
_ | Char -> Bool
isDigit Char
c1 -> do
      (ByteString
key, ByteString
s2, Pos
pos2) <- ByteString -> Pos -> Either String (ByteString, ByteString, Pos)
parseString ByteString
s Pos
pos
      case ByteString -> Maybe (Char, ByteString)
BC.uncons ByteString
s2 of
        Maybe (Char, ByteString)
Nothing -> forall a. Maybe Char -> Pos -> Either String a
errItem forall a. Maybe a
Nothing Pos
pos2
        Just (Char
c3,ByteString
s3) -> case Char
c3 of
          Char
_ | Char -> Bool
isDigit Char
c3 -> do
            (ByteString
str, ByteString
s4, Pos
pos4) <- ByteString -> Pos -> Either String (ByteString, ByteString, Pos)
parseString ByteString
s2 Pos
pos2
            ByteString
-> Stack
-> Int
-> [KeyValue]
-> ByteString
-> Pos
-> ParseOneResult
parseDict1 ByteString
key Stack
stk Int
1 [ByteString -> Value -> KeyValue
KeyValue ByteString
key (ByteString -> Value
String ByteString
str)] ByteString
s4 Pos
pos4
          Char
'i' -> do
            (ByteString
i, ByteString
s4, Pos
pos4) <- ByteString -> Pos -> Either String (ByteString, ByteString, Pos)
parseInteger ByteString
s3 (Pos
pos2forall a. Num a => a -> a -> a
+Pos
1)
            ByteString
-> Stack
-> Int
-> [KeyValue]
-> ByteString
-> Pos
-> ParseOneResult
parseDict1 ByteString
key Stack
stk Int
1 [ByteString -> Value -> KeyValue
KeyValue ByteString
key (ByteString -> Value
Integer ByteString
i)] ByteString
s4 Pos
pos4
          Char
'l' -> Stack -> Int -> [Value] -> ByteString -> Pos -> ParseOneResult
parseList (ByteString -> Int -> [KeyValue] -> Stack -> Stack
SDict ByteString
key Int
0 [] Stack
stk) Int
0 [] ByteString
s3 (Pos
pos2forall a. Num a => a -> a -> a
+Pos
1)
          Char
'd' -> Stack -> ByteString -> Pos -> ParseOneResult
parseDict (ByteString -> Int -> [KeyValue] -> Stack -> Stack
SDict ByteString
key Int
0 [] Stack
stk) ByteString
s3 (Pos
pos2forall a. Num a => a -> a -> a
+Pos
1)
          Char
_   -> forall a. Maybe Char -> Pos -> Either String a
errItem (forall a. a -> Maybe a
Just Char
c3) Pos
pos2
    Char
'e' -> Stack -> Value -> ByteString -> Pos -> ParseOneResult
resumeParse Stack
stk (Array KeyValue -> Value
Dict (forall a. Int -> [a] -> Array a
arrayFromRevListN Int
0 [])) ByteString
s1 (Pos
posforall a. Num a => a -> a -> a
+Pos
1)
    Char
_   -> forall a. Maybe Char -> Pos -> Either String a
errStringOrEnd (forall a. a -> Maybe a
Just Char
c1) Pos
pos

-- | Parse a Bencode dict. After the first key-value pair.
parseDict1 :: B.ByteString -> Stack -> Int -> [KeyValue] -> B.ByteString -> Pos
           -> ParseOneResult
parseDict1 :: ByteString
-> Stack
-> Int
-> [KeyValue]
-> ByteString
-> Pos
-> ParseOneResult
parseDict1 !ByteString
pkey Stack
stk !Int
n ![KeyValue]
acc ByteString
s !Pos
pos = case ByteString -> Maybe (Char, ByteString)
BC.uncons ByteString
s of
  Maybe (Char, ByteString)
Nothing -> forall a. Maybe Char -> Pos -> Either String a
errStringOrEnd forall a. Maybe a
Nothing Pos
pos
  Just (Char
c1,ByteString
s1) -> case Char
c1 of
    Char
_ | Char -> Bool
isDigit Char
c1 -> do
      (ByteString
key, ByteString
s2, Pos
pos2) <- ByteString -> Pos -> Either String (ByteString, ByteString, Pos)
parseString ByteString
s Pos
pos
      if ByteString
pkey forall a. Ord a => a -> a -> Bool
>= ByteString
key
      then forall a. ByteString -> ByteString -> Pos -> Either String a
errUnsortedKeys ByteString
pkey ByteString
key Pos
pos
      else case ByteString -> Maybe (Char, ByteString)
BC.uncons ByteString
s2 of
        Maybe (Char, ByteString)
Nothing -> forall a. Maybe Char -> Pos -> Either String a
errItem forall a. Maybe a
Nothing Pos
pos2
        Just (Char
c3,ByteString
s3) -> case Char
c3 of
          Char
_ | Char -> Bool
isDigit Char
c3 -> do
            (ByteString
str, ByteString
s4, Pos
pos4) <- ByteString -> Pos -> Either String (ByteString, ByteString, Pos)
parseString ByteString
s2 Pos
pos2
            ByteString
-> Stack
-> Int
-> [KeyValue]
-> ByteString
-> Pos
-> ParseOneResult
parseDict1 ByteString
key Stack
stk (Int
nforall a. Num a => a -> a -> a
+Int
1) (ByteString -> Value -> KeyValue
KeyValue ByteString
key (ByteString -> Value
String ByteString
str) forall a. a -> [a] -> [a]
: [KeyValue]
acc) ByteString
s4 Pos
pos4
          Char
'i' -> do
            (ByteString
i, ByteString
s4, Pos
pos4) <- ByteString -> Pos -> Either String (ByteString, ByteString, Pos)
parseInteger ByteString
s3 (Pos
pos2forall a. Num a => a -> a -> a
+Pos
1)
            ByteString
-> Stack
-> Int
-> [KeyValue]
-> ByteString
-> Pos
-> ParseOneResult
parseDict1 ByteString
key Stack
stk (Int
nforall a. Num a => a -> a -> a
+Int
1) (ByteString -> Value -> KeyValue
KeyValue ByteString
key (ByteString -> Value
Integer ByteString
i) forall a. a -> [a] -> [a]
: [KeyValue]
acc) ByteString
s4 Pos
pos4
          Char
'l' -> Stack -> Int -> [Value] -> ByteString -> Pos -> ParseOneResult
parseList (ByteString -> Int -> [KeyValue] -> Stack -> Stack
SDict ByteString
key Int
n [KeyValue]
acc Stack
stk) Int
0 [] ByteString
s3 (Pos
pos2forall a. Num a => a -> a -> a
+Pos
1)
          Char
'd' -> Stack -> ByteString -> Pos -> ParseOneResult
parseDict (ByteString -> Int -> [KeyValue] -> Stack -> Stack
SDict ByteString
key Int
n [KeyValue]
acc Stack
stk) ByteString
s3 (Pos
pos2forall a. Num a => a -> a -> a
+Pos
1)
          Char
_   -> forall a. Maybe Char -> Pos -> Either String a
errItem (forall a. a -> Maybe a
Just Char
c3) Pos
pos2
    Char
'e' -> Stack -> Value -> ByteString -> Pos -> ParseOneResult
resumeParse Stack
stk (Array KeyValue -> Value
Dict (forall a. Int -> [a] -> Array a
arrayFromRevListN Int
n [KeyValue]
acc)) ByteString
s1 (Pos
posforall a. Num a => a -> a -> a
+Pos
1)
    Char
_   -> forall a. Maybe Char -> Pos -> Either String a
errStringOrEnd (forall a. a -> Maybe a
Just Char
c1) Pos
pos

-- | Add the value to the previously incomplete value on the stack, and resume
-- parsing it.
resumeParse :: Stack -> Value -> B.ByteString -> Pos -> ParseOneResult
resumeParse :: Stack -> Value -> ByteString -> Pos -> ParseOneResult
resumeParse Stack
stk !Value
x ByteString
s !Pos
pos = case Stack
stk of
  Stack
SNil               -> forall a b. b -> Either a b
Right (Value
x, ByteString
s, Pos -> Int
unPos Pos
pos)
  SList Int
n [Value]
xs Stack
stk1    -> Stack -> Int -> [Value] -> ByteString -> Pos -> ParseOneResult
parseList Stack
stk1 (Int
nforall a. Num a => a -> a -> a
+Int
1) (Value
xforall a. a -> [a] -> [a]
:[Value]
xs) ByteString
s Pos
pos
  SDict ByteString
k Int
n [KeyValue]
acc Stack
stk1 -> ByteString
-> Stack
-> Int
-> [KeyValue]
-> ByteString
-> Pos
-> ParseOneResult
parseDict1 ByteString
k Stack
stk1 (Int
nforall a. Num a => a -> a -> a
+Int
1) (ByteString -> Value -> KeyValue
KeyValue ByteString
k Value
x forall a. a -> [a] -> [a]
: [KeyValue]
acc) ByteString
s Pos
pos
{-# INLINE resumeParse #-}

-- | Parse a Bencode integer. After the \'i\' to the \'e\'.
parseInteger :: B.ByteString -> Pos
             -> Either String (B.ByteString, B.ByteString, Pos)
parseInteger :: ByteString -> Pos -> Either String (ByteString, ByteString, Pos)
parseInteger ByteString
s !Pos
pos = case ByteString -> Maybe (Char, ByteString)
BC.uncons ByteString
s of
  Maybe (Char, ByteString)
Nothing -> forall a. Maybe Char -> Pos -> Either String a
errDigit forall a. Maybe a
Nothing Pos
pos
  Just (Char
c1,ByteString
s1) -> case Char
c1 of
    Char
'0' -> forall {a}.
a -> ByteString -> Pos -> Either String (a, ByteString, Pos)
end (Int -> ByteString -> ByteString
B.take Int
1 ByteString
s) ByteString
s1 (Pos
posforall a. Num a => a -> a -> a
+Pos
1)
    Char
'-' -> case (Char -> Bool) -> ByteString -> (ByteString, ByteString)
BC.span Char -> Bool
isDigit ByteString
s1 of
      (ByteString
x,ByteString
s2) -> case ByteString -> Maybe (Char, ByteString)
BC.uncons ByteString
x of
        Just (Char
c3,ByteString
_) | Char
c3 forall a. Eq a => a -> a -> Bool
/= Char
'0' ->
          let n :: Int
n = ByteString -> Int
B.length ByteString
x forall a. Num a => a -> a -> a
+ Int
1 in forall {a}.
a -> ByteString -> Pos -> Either String (a, ByteString, Pos)
end (Int -> ByteString -> ByteString
B.take Int
n ByteString
s) ByteString
s2 (Pos
pos forall a. Num a => a -> a -> a
+ Int -> Pos
Pos Int
n)
        Maybe (Char, ByteString)
_ -> forall a. Maybe Char -> Pos -> Either String a
errNZDigit (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst (ByteString -> Maybe (Char, ByteString)
BC.uncons ByteString
s2)) (Pos
posforall a. Num a => a -> a -> a
+Pos
1)
    Char
_ -> case (Char -> Bool) -> ByteString -> (ByteString, ByteString)
BC.span Char -> Bool
isDigit ByteString
s of
      (ByteString
x,ByteString
s2) -> if ByteString -> Bool
B.null ByteString
x
        then forall a. Maybe Char -> Pos -> Either String a
errDigitOrNeg (forall a. a -> Maybe a
Just Char
c1) Pos
pos
        else let n :: Int
n = ByteString -> Int
B.length ByteString
x in forall {a}.
a -> ByteString -> Pos -> Either String (a, ByteString, Pos)
end ByteString
x ByteString
s2 (Pos
pos forall a. Num a => a -> a -> a
+ Int -> Pos
Pos Int
n)
  where
    end :: a -> ByteString -> Pos -> Either String (a, ByteString, Pos)
end a
x ByteString
s' !Pos
pos' = case ByteString -> Maybe (Char, ByteString)
BC.uncons ByteString
s' of
      Maybe (Char, ByteString)
Nothing -> forall a. Maybe Char -> Pos -> Either String a
errEnd forall a. Maybe a
Nothing Pos
pos'
      Just (Char
c,ByteString
s'') -> case Char
c of
        Char
'e' -> forall a b. b -> Either a b
Right (a
x, ByteString
s'', Pos
pos'forall a. Num a => a -> a -> a
+Pos
1)
        Char
_   -> forall a. Maybe Char -> Pos -> Either String a
errEnd (forall a. a -> Maybe a
Just Char
c) Pos
pos'
{-# INLINE parseInteger #-}

-- | Parse a Bencode string. From the length count to the end of the string.
parseString :: B.ByteString -> Pos
            -> Either String (B.ByteString, B.ByteString, Pos)
parseString :: ByteString -> Pos -> Either String (ByteString, ByteString, Pos)
parseString ByteString
s !Pos
pos = case (Char -> Bool) -> ByteString -> (ByteString, ByteString)
BC.span Char -> Bool
isDigit ByteString
s of
  (ByteString
digs,ByteString
s1) -> case Bool -> ByteString -> Maybe Int
readKnownNaturalAsInt Bool
False ((Char -> Bool) -> ByteString -> ByteString
BC.dropWhile (forall a. Eq a => a -> a -> Bool
==Char
'0') ByteString
digs) of
    Maybe Int
Nothing -> forall a. Pos -> Either String a
errTooLargeStringLength Pos
pos
    Just Int
n ->
      let pos2 :: Pos
pos2 = Pos
pos forall a. Num a => a -> a -> a
+ Int -> Pos
Pos (ByteString -> Int
B.length ByteString
digs)
      in case ByteString -> Maybe (Char, ByteString)
BC.uncons ByteString
s1 of
          Maybe (Char, ByteString)
Nothing -> forall a. Maybe Char -> Pos -> Either String a
errColon forall a. Maybe a
Nothing Pos
pos2
          Just (Char
c3,ByteString
s3) -> case Char
c3 of
            Char
':' -> case Int -> ByteString -> (ByteString, ByteString)
B.splitAt Int
n ByteString
s3 of
              (ByteString
str,ByteString
s4) | ByteString -> Int
B.length ByteString
str forall a. Eq a => a -> a -> Bool
== Int
n -> forall a b. b -> Either a b
Right (ByteString
str, ByteString
s4, Pos
pos2 forall a. Num a => a -> a -> a
+ Pos
1 forall a. Num a => a -> a -> a
+ Int -> Pos
Pos Int
n)
              (ByteString, ByteString)
_ -> forall a. Pos -> Either String a
errTooLargeStringLength Pos
pos
            Char
_   -> forall a. Maybe Char -> Pos -> Either String a
errColon (forall a. a -> Maybe a
Just Char
c3) Pos
pos2
{-# INLINE parseString #-}

------------------------------
-- Error stuff

errorAtPos :: String -> Pos -> Either String a
errorAtPos :: forall a. String -> Pos -> Either String a
errorAtPos String
e (Pos Int
n) = forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String
"ParseErrorAt " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
n forall a. [a] -> [a] -> [a]
++ String
": " forall a. [a] -> [a] -> [a]
++ String
e

mismatch :: [String] -> Maybe Char -> Pos -> Either String a
mismatch :: forall a. [String] -> Maybe Char -> Pos -> Either String a
mismatch [String]
cs Maybe Char
c = forall a. String -> Pos -> Either String a
errorAtPos forall a b. (a -> b) -> a -> b
$
  String
"ExpectedOneOfButGot [" forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate String
"," [String]
cs forall a. [a] -> [a] -> [a]
++ String
"] " forall a. [a] -> [a] -> [a]
++ forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"EOF" forall a. Show a => a -> String
show Maybe Char
c

errItem, errItemOrEnd, errStringOrEnd, errEnd, errDigit, errNZDigit,
  errColon, errDigitOrNeg :: Maybe Char -> Pos -> Either String a
errItem :: forall a. Maybe Char -> Pos -> Either String a
errItem        = forall a. [String] -> Maybe Char -> Pos -> Either String a
mismatch [String
"Digit", forall a. Show a => a -> String
show Char
'i', forall a. Show a => a -> String
show Char
'l', forall a. Show a => a -> String
show Char
'd']
errItemOrEnd :: forall a. Maybe Char -> Pos -> Either String a
errItemOrEnd   = forall a. [String] -> Maybe Char -> Pos -> Either String a
mismatch [String
"Digit", forall a. Show a => a -> String
show Char
'i', forall a. Show a => a -> String
show Char
'l', forall a. Show a => a -> String
show Char
'd', forall a. Show a => a -> String
show Char
'e']
errStringOrEnd :: forall a. Maybe Char -> Pos -> Either String a
errStringOrEnd = forall a. [String] -> Maybe Char -> Pos -> Either String a
mismatch [String
"Digit", forall a. Show a => a -> String
show Char
'e']
errEnd :: forall a. Maybe Char -> Pos -> Either String a
errEnd         = forall a. [String] -> Maybe Char -> Pos -> Either String a
mismatch [forall a. Show a => a -> String
show Char
'e']
errDigit :: forall a. Maybe Char -> Pos -> Either String a
errDigit       = forall a. [String] -> Maybe Char -> Pos -> Either String a
mismatch [String
"Digit"]
errNZDigit :: forall a. Maybe Char -> Pos -> Either String a
errNZDigit     = forall a. [String] -> Maybe Char -> Pos -> Either String a
mismatch [String
"NonZeroDigit"]
errDigitOrNeg :: forall a. Maybe Char -> Pos -> Either String a
errDigitOrNeg  = forall a. [String] -> Maybe Char -> Pos -> Either String a
mismatch [String
"Digit", forall a. Show a => a -> String
show Char
'-']
errColon :: forall a. Maybe Char -> Pos -> Either String a
errColon       = forall a. [String] -> Maybe Char -> Pos -> Either String a
mismatch [forall a. Show a => a -> String
show Char
':']

errUnsortedKeys :: B.ByteString -> B.ByteString -> Pos -> Either String a
errUnsortedKeys :: forall a. ByteString -> ByteString -> Pos -> Either String a
errUnsortedKeys ByteString
pkey ByteString
key = forall a. String -> Pos -> Either String a
errorAtPos forall a b. (a -> b) -> a -> b
$
  String
"UnsortedKeys " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show ByteString
pkey forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show ByteString
key

errTooLargeStringLength :: Pos -> Either String a
errTooLargeStringLength :: forall a. Pos -> Either String a
errTooLargeStringLength = forall a. String -> Pos -> Either String a
errorAtPos String
"TooLargeStringLength"

------------------------------
-- Array

-- | Create an array from a list in reverse order.
arrayFromRevListN :: Int -> [a] -> A.Array a
arrayFromRevListN :: forall a. Int -> [a] -> Array a
arrayFromRevListN Int
n [a]
xs = forall a.
Int -> a -> (forall s. MutableArray s a -> ST s ()) -> Array a
A.createArray Int
n forall a. a
errorElement forall a b. (a -> b) -> a -> b
$ \MutableArray s a
a ->
  let f :: a -> (Int -> ST s ()) -> Int -> ST s ()
f a
x Int -> ST s ()
k = \Int
i ->
        if Int
i forall a. Eq a => a -> a -> Bool
== -Int
1
        then forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        else forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> a -> m ()
A.writeArray MutableArray s a
a Int
i a
x forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Int -> ST s ()
k (Int
iforall a. Num a => a -> a -> a
-Int
1)
  in forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> (Int -> ST s ()) -> Int -> ST s ()
f (\ !Int
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) [a]
xs (Int
nforall a. Num a => a -> a -> a
-Int
1)
{-# INLINE arrayFromRevListN #-}

errorElement :: a
errorElement :: forall a. a
errorElement = forall a. HasCallStack => String -> a
error String
"errorElement"