{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
#if MIN_VERSION_ghc_prim(0,3,1)
{-# LANGUAGE MagicHash #-}
#endif
#if __GLASGOW_HASKELL__ <= 710 && __GLASGOW_HASKELL__ >= 706
-- Work around a compiler bug
{-# OPTIONS_GHC -fsimpl-tick-factor=200 #-}
#endif
-- |
-- Module:      Data.Aeson.Parser.Internal
-- Copyright:   (c) 2011-2016 Bryan O'Sullivan
--              (c) 2011 MailRank, Inc.
-- License:     BSD3
-- Maintainer:  Bryan O'Sullivan <bos@serpentine.com>
-- Stability:   experimental
-- Portability: portable
--
-- Efficiently and correctly parse a JSON string.  The string must be
-- encoded as UTF-8.

module Data.Aeson.Parser.Internal
    (
    -- * Lazy parsers
      json, jsonEOF
    , jsonWith
    , jsonLast
    , jsonAccum
    , jsonNoDup
    , value
    , jstring
    , jstring_
    , scientific
    -- * Strict parsers
    , json', jsonEOF'
    , jsonWith'
    , jsonLast'
    , jsonAccum'
    , jsonNoDup'
    , value'
    -- * Helpers
    , decodeWith
    , decodeStrictWith
    , eitherDecodeWith
    , eitherDecodeStrictWith
    -- ** Handling objects with duplicate keys
    , fromListAccum
    , parseListNoDup
    ) where

import Prelude.Compat

import Control.Applicative ((<|>))
import Control.Monad (void, when)
import Data.Aeson.Types.Internal (IResult(..), JSONPath, Object, Result(..), Value(..))
import Data.Attoparsec.ByteString.Char8 (Parser, char, decimal, endOfInput, isDigit_w8, signed, string)
import Data.Function (fix)
import Data.Functor.Compat (($>))
import Data.Scientific (Scientific)
import Data.Text (Text)
import Data.Vector (Vector)
import qualified Data.Vector as Vector (empty, fromList, fromListN, reverse)
import qualified Data.Attoparsec.ByteString as A
import qualified Data.Attoparsec.Lazy as L
import qualified Data.ByteString as B
import qualified Data.ByteString.Unsafe as B
import qualified Data.ByteString.Lazy as L
import qualified Data.HashMap.Strict as H
import qualified Data.Scientific as Sci
import Data.Aeson.Parser.Unescape (unescapeText)

#if MIN_VERSION_ghc_prim(0,3,1)
import GHC.Base (Int#, (==#), isTrue#, word2Int#, orI#, andI#)
import GHC.Word (Word8(W8#))
import qualified Data.Text.Encoding as TE
#endif

#define BACKSLASH 92
#define CLOSE_CURLY 125
#define CLOSE_SQUARE 93
#define COMMA 44
#define DOUBLE_QUOTE 34
#define OPEN_CURLY 123
#define OPEN_SQUARE 91
#define C_0 48
#define C_9 57
#define C_A 65
#define C_F 70
#define C_a 97
#define C_f 102
#define C_n 110
#define C_t 116

-- | Parse any JSON value.
--
-- The conversion of a parsed value to a Haskell value is deferred
-- until the Haskell value is needed.  This may improve performance if
-- only a subset of the results of conversions are needed, but at a
-- cost in thunk allocation.
--
-- This function is an alias for 'value'. In aeson 0.8 and earlier, it
-- parsed only object or array types, in conformance with the
-- now-obsolete RFC 4627.
--
-- ==== Warning
--
-- If an object contains duplicate keys, only the first one will be kept.
-- For a more flexible alternative, see 'jsonWith'.
json :: Parser Value
json :: Parser Value
json = Parser Value
value

-- | Parse any JSON value.
--
-- This is a strict version of 'json' which avoids building up thunks
-- during parsing; it performs all conversions immediately.  Prefer
-- this version if most of the JSON data needs to be accessed.
--
-- This function is an alias for 'value''. In aeson 0.8 and earlier, it
-- parsed only object or array types, in conformance with the
-- now-obsolete RFC 4627.
--
-- ==== Warning
--
-- If an object contains duplicate keys, only the first one will be kept.
-- For a more flexible alternative, see 'jsonWith''.
json' :: Parser Value
json' :: Parser Value
json' = Parser Value
value'

-- Open recursion: object_, object_', array_, array_' are parameterized by the
-- toplevel Value parser to be called recursively, to keep the parameter
-- mkObject outside of the recursive loop for proper inlining.

object_ :: ([(Text, Value)] -> Either String Object) -> Parser Value -> Parser Value
object_ :: ([(Text, Value)] -> Either String Object)
-> Parser Value -> Parser Value
object_ mkObject :: [(Text, Value)] -> Either String Object
mkObject val :: Parser Value
val = {-# SCC "object_" #-} Object -> Value
Object (Object -> Value) -> Parser ByteString Object -> Parser Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([(Text, Value)] -> Either String Object)
-> Parser Text -> Parser Value -> Parser ByteString Object
objectValues [(Text, Value)] -> Either String Object
mkObject Parser Text
jstring Parser Value
val
{-# INLINE object_ #-}

object_' :: ([(Text, Value)] -> Either String Object) -> Parser Value -> Parser Value
object_' :: ([(Text, Value)] -> Either String Object)
-> Parser Value -> Parser Value
object_' mkObject :: [(Text, Value)] -> Either String Object
mkObject val' :: Parser Value
val' = {-# SCC "object_'" #-} do
  !Object
vals <- ([(Text, Value)] -> Either String Object)
-> Parser Text -> Parser Value -> Parser ByteString Object
objectValues [(Text, Value)] -> Either String Object
mkObject Parser Text
jstring' Parser Value
val'
  Value -> Parser Value
forall (m :: * -> *) a. Monad m => a -> m a
return (Object -> Value
Object Object
vals)
 where
  jstring' :: Parser Text
jstring' = do
    !Text
s <- Parser Text
jstring
    Text -> Parser Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
s
{-# INLINE object_' #-}

objectValues :: ([(Text, Value)] -> Either String Object)
             -> Parser Text -> Parser Value -> Parser (H.HashMap Text Value)
objectValues :: ([(Text, Value)] -> Either String Object)
-> Parser Text -> Parser Value -> Parser ByteString Object
objectValues mkObject :: [(Text, Value)] -> Either String Object
mkObject str :: Parser Text
str val :: Parser Value
val = do
  Parser ()
skipSpace
  Word8
w <- Parser Word8
A.peekWord8'
  if Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== CLOSE_CURLY
    then Parser Word8
A.anyWord8 Parser Word8
-> Parser ByteString Object -> Parser ByteString Object
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Object -> Parser ByteString Object
forall (m :: * -> *) a. Monad m => a -> m a
return Object
forall k v. HashMap k v
H.empty
    else [(Text, Value)] -> Parser ByteString Object
loop []
 where
  -- Why use acc pattern here, you may ask? because 'H.fromList' use 'unsafeInsert'
  -- and it's much faster because it's doing in place update to the 'HashMap'!
  loop :: [(Text, Value)] -> Parser ByteString Object
loop acc :: [(Text, Value)]
acc = do
    Text
k <- (Parser Text
str Parser Text -> String -> Parser Text
forall i a. Parser i a -> String -> Parser i a
A.<?> "object key") Parser Text -> Parser () -> Parser Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
skipSpace Parser Text -> Parser ByteString Char -> Parser Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (Char -> Parser ByteString Char
char ':' Parser ByteString Char -> String -> Parser ByteString Char
forall i a. Parser i a -> String -> Parser i a
A.<?> "':'")
    Value
v <- (Parser Value
val Parser Value -> String -> Parser Value
forall i a. Parser i a -> String -> Parser i a
A.<?> "object value") Parser Value -> Parser () -> Parser Value
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
skipSpace
    Word8
ch <- (Word8 -> Bool) -> Parser Word8
A.satisfy (\w :: Word8
w -> Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== COMMA || w == CLOSE_CURLY) A.<?> "',' or '}'"
    let acc' :: [(Text, Value)]
acc' = (Text
k, Value
v) (Text, Value) -> [(Text, Value)] -> [(Text, Value)]
forall a. a -> [a] -> [a]
: [(Text, Value)]
acc
    if Word8
ch Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== COMMA
      then Parser ()
skipSpace Parser () -> Parser ByteString Object -> Parser ByteString Object
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [(Text, Value)] -> Parser ByteString Object
loop [(Text, Value)]
acc'
      else case [(Text, Value)] -> Either String Object
mkObject [(Text, Value)]
acc' of
        Left err :: String
err -> String -> Parser ByteString Object
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err
        Right obj :: Object
obj -> Object -> Parser ByteString Object
forall (f :: * -> *) a. Applicative f => a -> f a
pure Object
obj
{-# INLINE objectValues #-}

array_ :: Parser Value -> Parser Value
array_ :: Parser Value -> Parser Value
array_ val :: Parser Value
val = {-# SCC "array_" #-} Array -> Value
Array (Array -> Value) -> Parser ByteString Array -> Parser Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Value -> Parser ByteString Array
arrayValues Parser Value
val
{-# INLINE array_ #-}

array_' :: Parser Value -> Parser Value
array_' :: Parser Value -> Parser Value
array_' val :: Parser Value
val = {-# SCC "array_'" #-} do
  !Array
vals <- Parser Value -> Parser ByteString Array
arrayValues Parser Value
val
  Value -> Parser Value
forall (m :: * -> *) a. Monad m => a -> m a
return (Array -> Value
Array Array
vals)
{-# INLINE array_' #-}

arrayValues :: Parser Value -> Parser (Vector Value)
arrayValues :: Parser Value -> Parser ByteString Array
arrayValues val :: Parser Value
val = do
  Parser ()
skipSpace
  Word8
w <- Parser Word8
A.peekWord8'
  if Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== CLOSE_SQUARE
    then Parser Word8
A.anyWord8 Parser Word8 -> Parser ByteString Array -> Parser ByteString Array
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Array -> Parser ByteString Array
forall (m :: * -> *) a. Monad m => a -> m a
return Array
forall a. Vector a
Vector.empty
    else [Value] -> Int -> Parser ByteString Array
loop [] 1
  where
    loop :: [Value] -> Int -> Parser ByteString Array
loop acc :: [Value]
acc !Int
len = do
      Value
v <- (Parser Value
val Parser Value -> String -> Parser Value
forall i a. Parser i a -> String -> Parser i a
A.<?> "json list value") Parser Value -> Parser () -> Parser Value
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
skipSpace
      Word8
ch <- (Word8 -> Bool) -> Parser Word8
A.satisfy (\w :: Word8
w -> Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== COMMA || w == CLOSE_SQUARE) A.<?> "',' or ']'"
      if Word8
ch Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== COMMA
        then Parser ()
skipSpace Parser () -> Parser ByteString Array -> Parser ByteString Array
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Value] -> Int -> Parser ByteString Array
loop (Value
vValue -> [Value] -> [Value]
forall a. a -> [a] -> [a]
:[Value]
acc) (Int
lenInt -> Int -> Int
forall a. Num a => a -> a -> a
+1)
        else Array -> Parser ByteString Array
forall (m :: * -> *) a. Monad m => a -> m a
return (Array -> Array
forall a. Vector a -> Vector a
Vector.reverse (Int -> [Value] -> Array
forall a. Int -> [a] -> Vector a
Vector.fromListN Int
len (Value
vValue -> [Value] -> [Value]
forall a. a -> [a] -> [a]
:[Value]
acc)))
{-# INLINE arrayValues #-}

-- | Parse any JSON value. Synonym of 'json'.
value :: Parser Value
value :: Parser Value
value = ([(Text, Value)] -> Either String Object) -> Parser Value
jsonWith (Object -> Either String Object
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Object -> Either String Object)
-> ([(Text, Value)] -> Object)
-> [(Text, Value)]
-> Either String Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Text, Value)] -> Object
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
H.fromList)

-- | Parse any JSON value.
--
-- This parser is parameterized by a function to construct an 'Object'
-- from a raw list of key-value pairs, where duplicates are preserved.
-- The pairs appear in __reverse order__ from the source.
--
-- ==== __Examples__
--
-- 'json' keeps only the first occurence of each key, using 'HashMap.Lazy.fromList'.
--
-- @
-- 'json' = 'jsonWith' ('Right' '.' 'H.fromList')
-- @
--
-- 'jsonLast' keeps the last occurence of each key, using
-- @'HashMap.Lazy.fromListWith' ('const' 'id')@.
--
-- @
-- 'jsonLast' = 'jsonWith' ('Right' '.' 'HashMap.Lazy.fromListWith' ('const' 'id'))
-- @
--
-- 'jsonAccum' keeps wraps all values in arrays to keep duplicates, using
-- 'fromListAccum'.
--
-- @
-- 'jsonAccum' = 'jsonWith' ('Right' . 'fromListAccum')
-- @
--
-- 'jsonNoDup' fails if any object contains duplicate keys, using 'parseListNoDup'.
--
-- @
-- 'jsonNoDup' = 'jsonWith' 'parseListNoDup'
-- @
jsonWith :: ([(Text, Value)] -> Either String Object) -> Parser Value
jsonWith :: ([(Text, Value)] -> Either String Object) -> Parser Value
jsonWith mkObject :: [(Text, Value)] -> Either String Object
mkObject = (Parser Value -> Parser Value) -> Parser Value
forall a. (a -> a) -> a
fix ((Parser Value -> Parser Value) -> Parser Value)
-> (Parser Value -> Parser Value) -> Parser Value
forall a b. (a -> b) -> a -> b
$ \value_ :: Parser Value
value_ -> do
  Parser ()
skipSpace
  Word8
w <- Parser Word8
A.peekWord8'
  case Word8
w of
    DOUBLE_QUOTE  -> A.anyWord8 *> (String <$> jstring_)
    OPEN_CURLY    -> A.anyWord8 *> object_ mkObject value_
    OPEN_SQUARE   -> A.anyWord8 *> array_ value_
    C_f           -> ByteString -> Parser ByteString
string "false" Parser ByteString -> Value -> Parser Value
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Bool -> Value
Bool Bool
False
    C_t           -> ByteString -> Parser ByteString
string "true" Parser ByteString -> Value -> Parser Value
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Bool -> Value
Bool Bool
True
    C_n           -> ByteString -> Parser ByteString
string "null" Parser ByteString -> Value -> Parser Value
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Value
Null
    _              | Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= 48 Bool -> Bool -> Bool
&& Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= 57 Bool -> Bool -> Bool
|| Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== 45
                  -> Scientific -> Value
Number (Scientific -> Value)
-> Parser ByteString Scientific -> Parser Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Scientific
scientific
      | Bool
otherwise -> String -> Parser Value
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "not a valid json value"
{-# INLINE jsonWith #-}

-- | Variant of 'json' which keeps only the last occurence of every key.
jsonLast :: Parser Value
jsonLast :: Parser Value
jsonLast = ([(Text, Value)] -> Either String Object) -> Parser Value
jsonWith (Object -> Either String Object
forall a b. b -> Either a b
Right (Object -> Either String Object)
-> ([(Text, Value)] -> Object)
-> [(Text, Value)]
-> Either String Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> Value -> Value) -> [(Text, Value)] -> Object
forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> [(k, v)] -> HashMap k v
H.fromListWith ((Value -> Value) -> Value -> Value -> Value
forall a b. a -> b -> a
const Value -> Value
forall a. a -> a
id))

-- | Variant of 'json' wrapping all object mappings in 'Array' to preserve
-- key-value pairs with the same keys.
jsonAccum :: Parser Value
jsonAccum :: Parser Value
jsonAccum = ([(Text, Value)] -> Either String Object) -> Parser Value
jsonWith (Object -> Either String Object
forall a b. b -> Either a b
Right (Object -> Either String Object)
-> ([(Text, Value)] -> Object)
-> [(Text, Value)]
-> Either String Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Text, Value)] -> Object
fromListAccum)

-- | Variant of 'json' which fails if any object contains duplicate keys.
jsonNoDup :: Parser Value
jsonNoDup :: Parser Value
jsonNoDup = ([(Text, Value)] -> Either String Object) -> Parser Value
jsonWith [(Text, Value)] -> Either String Object
parseListNoDup

-- | @'fromListAccum' kvs@ is an object mapping keys to arrays containing all
-- associated values from the original list @kvs@.
--
-- >>> fromListAccum [("apple", Bool True), ("apple", Bool False), ("orange", Bool False)]
-- fromList [("apple", [Bool False, Bool True]), ("orange", [Bool False])]
fromListAccum :: [(Text, Value)] -> Object
fromListAccum :: [(Text, Value)] -> Object
fromListAccum =
  (([Value] -> [Value]) -> Value)
-> HashMap Text ([Value] -> [Value]) -> Object
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Array -> Value
Array (Array -> Value)
-> (([Value] -> [Value]) -> Array) -> ([Value] -> [Value]) -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Value] -> Array
forall a. [a] -> Vector a
Vector.fromList ([Value] -> Array)
-> (([Value] -> [Value]) -> [Value])
-> ([Value] -> [Value])
-> Array
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([Value] -> [Value]) -> [Value] -> [Value]
forall a b. (a -> b) -> a -> b
$ [])) (HashMap Text ([Value] -> [Value]) -> Object)
-> ([(Text, Value)] -> HashMap Text ([Value] -> [Value]))
-> [(Text, Value)]
-> Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([Value] -> [Value])
 -> ([Value] -> [Value]) -> [Value] -> [Value])
-> [(Text, [Value] -> [Value])]
-> HashMap Text ([Value] -> [Value])
forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> [(k, v)] -> HashMap k v
H.fromListWith ([Value] -> [Value]) -> ([Value] -> [Value]) -> [Value] -> [Value]
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) ([(Text, [Value] -> [Value])] -> HashMap Text ([Value] -> [Value]))
-> ([(Text, Value)] -> [(Text, [Value] -> [Value])])
-> [(Text, Value)]
-> HashMap Text ([Value] -> [Value])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (((Text, Value) -> (Text, [Value] -> [Value]))
-> [(Text, Value)] -> [(Text, [Value] -> [Value])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((Text, Value) -> (Text, [Value] -> [Value]))
 -> [(Text, Value)] -> [(Text, [Value] -> [Value])])
-> ((Value -> [Value] -> [Value])
    -> (Text, Value) -> (Text, [Value] -> [Value]))
-> (Value -> [Value] -> [Value])
-> [(Text, Value)]
-> [(Text, [Value] -> [Value])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> [Value] -> [Value])
-> (Text, Value) -> (Text, [Value] -> [Value])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) (:)

-- | @'fromListNoDup' kvs@ fails if @kvs@ contains duplicate keys.
parseListNoDup :: [(Text, Value)] -> Either String Object
parseListNoDup :: [(Text, Value)] -> Either String Object
parseListNoDup =
  (Text -> Maybe Value -> Either String Value)
-> HashMap Text (Maybe Value) -> Either String Object
forall (f :: * -> *) k v1 v2.
Applicative f =>
(k -> v1 -> f v2) -> HashMap k v1 -> f (HashMap k v2)
H.traverseWithKey Text -> Maybe Value -> Either String Value
forall a b. Show a => a -> Maybe b -> Either String b
unwrap (HashMap Text (Maybe Value) -> Either String Object)
-> ([(Text, Value)] -> HashMap Text (Maybe Value))
-> [(Text, Value)]
-> Either String Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Value -> Maybe Value -> Maybe Value)
-> [(Text, Maybe Value)] -> HashMap Text (Maybe Value)
forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> [(k, v)] -> HashMap k v
H.fromListWith (\_ _ -> Maybe Value
forall a. Maybe a
Nothing) ([(Text, Maybe Value)] -> HashMap Text (Maybe Value))
-> ([(Text, Value)] -> [(Text, Maybe Value)])
-> [(Text, Value)]
-> HashMap Text (Maybe Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (((Text, Value) -> (Text, Maybe Value))
-> [(Text, Value)] -> [(Text, Maybe Value)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((Text, Value) -> (Text, Maybe Value))
 -> [(Text, Value)] -> [(Text, Maybe Value)])
-> ((Value -> Maybe Value) -> (Text, Value) -> (Text, Maybe Value))
-> (Value -> Maybe Value)
-> [(Text, Value)]
-> [(Text, Maybe Value)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> Maybe Value) -> (Text, Value) -> (Text, Maybe Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) Value -> Maybe Value
forall a. a -> Maybe a
Just
  where
    unwrap :: a -> Maybe b -> Either String b
unwrap k :: a
k Nothing = String -> Either String b
forall a b. a -> Either a b
Left (String -> Either String b) -> String -> Either String b
forall a b. (a -> b) -> a -> b
$ "found duplicate key: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
k
    unwrap _ (Just v :: b
v) = b -> Either String b
forall a b. b -> Either a b
Right b
v

-- | Strict version of 'value'. Synonym of 'json''.
value' :: Parser Value
value' :: Parser Value
value' = ([(Text, Value)] -> Either String Object) -> Parser Value
jsonWith' (Object -> Either String Object
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Object -> Either String Object)
-> ([(Text, Value)] -> Object)
-> [(Text, Value)]
-> Either String Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Text, Value)] -> Object
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
H.fromList)

-- | Strict version of 'jsonWith'.
jsonWith' :: ([(Text, Value)] -> Either String Object) -> Parser Value
jsonWith' :: ([(Text, Value)] -> Either String Object) -> Parser Value
jsonWith' mkObject :: [(Text, Value)] -> Either String Object
mkObject = (Parser Value -> Parser Value) -> Parser Value
forall a. (a -> a) -> a
fix ((Parser Value -> Parser Value) -> Parser Value)
-> (Parser Value -> Parser Value) -> Parser Value
forall a b. (a -> b) -> a -> b
$ \value_ :: Parser Value
value_ -> do
  Parser ()
skipSpace
  Word8
w <- Parser Word8
A.peekWord8'
  case Word8
w of
    DOUBLE_QUOTE  -> do
                     !s <- A.anyWord8 *> jstring_
                     return (String s)
    OPEN_CURLY    -> A.anyWord8 *> object_' mkObject value_
    OPEN_SQUARE   -> A.anyWord8 *> array_' value_
    C_f           -> ByteString -> Parser ByteString
string "false" Parser ByteString -> Value -> Parser Value
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Bool -> Value
Bool Bool
False
    C_t           -> ByteString -> Parser ByteString
string "true" Parser ByteString -> Value -> Parser Value
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Bool -> Value
Bool Bool
True
    C_n           -> ByteString -> Parser ByteString
string "null" Parser ByteString -> Value -> Parser Value
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Value
Null
    _              | Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= 48 Bool -> Bool -> Bool
&& Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= 57 Bool -> Bool -> Bool
|| Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== 45
                  -> do
                     !Scientific
n <- Parser ByteString Scientific
scientific
                     Value -> Parser Value
forall (m :: * -> *) a. Monad m => a -> m a
return (Scientific -> Value
Number Scientific
n)
      | Bool
otherwise -> String -> Parser Value
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "not a valid json value"
{-# INLINE jsonWith' #-}

-- | Variant of 'json'' which keeps only the last occurence of every key.
jsonLast' :: Parser Value
jsonLast' :: Parser Value
jsonLast' = ([(Text, Value)] -> Either String Object) -> Parser Value
jsonWith' (Object -> Either String Object
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Object -> Either String Object)
-> ([(Text, Value)] -> Object)
-> [(Text, Value)]
-> Either String Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> Value -> Value) -> [(Text, Value)] -> Object
forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> [(k, v)] -> HashMap k v
H.fromListWith ((Value -> Value) -> Value -> Value -> Value
forall a b. a -> b -> a
const Value -> Value
forall a. a -> a
id))

-- | Variant of 'json'' wrapping all object mappings in 'Array' to preserve
-- key-value pairs with the same keys.
jsonAccum' :: Parser Value
jsonAccum' :: Parser Value
jsonAccum' = ([(Text, Value)] -> Either String Object) -> Parser Value
jsonWith' (Object -> Either String Object
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Object -> Either String Object)
-> ([(Text, Value)] -> Object)
-> [(Text, Value)]
-> Either String Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Text, Value)] -> Object
fromListAccum)

-- | Variant of 'json'' which fails if any object contains duplicate keys.
jsonNoDup' :: Parser Value
jsonNoDup' :: Parser Value
jsonNoDup' = ([(Text, Value)] -> Either String Object) -> Parser Value
jsonWith' [(Text, Value)] -> Either String Object
parseListNoDup

-- | Parse a quoted JSON string.
jstring :: Parser Text
jstring :: Parser Text
jstring = Word8 -> Parser Word8
A.word8 DOUBLE_QUOTE *> jstring_

-- | Parse a string without a leading quote.
jstring_ :: Parser Text
{-# INLINE jstring_ #-}
jstring_ :: Parser Text
jstring_ = {-# SCC "jstring_" #-} do
#if MIN_VERSION_ghc_prim(0,3,1)
  (s :: ByteString
s, S _ escaped :: Int#
escaped) <- S -> (S -> Word8 -> Maybe S) -> Parser (ByteString, S)
forall s. s -> (s -> Word8 -> Maybe s) -> Parser (ByteString, s)
A.runScanner S
startState S -> Word8 -> Maybe S
go Parser (ByteString, S) -> Parser Word8 -> Parser (ByteString, S)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Word8
A.anyWord8
  -- We escape only if there are
  -- non-ascii (over 7bit) characters or backslash present.
  --
  -- Note: if/when text will have fast ascii -> text conversion
  -- (e.g. uses utf8 encoding) we can have further speedup.
  if Int# -> Bool
isTrue# Int#
escaped
    then case ByteString -> Either UnicodeException Text
unescapeText ByteString
s of
      Right r :: Text
r  -> Text -> Parser Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
r
      Left err :: UnicodeException
err -> String -> Parser Text
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser Text) -> String -> Parser Text
forall a b. (a -> b) -> a -> b
$ UnicodeException -> String
forall a. Show a => a -> String
show UnicodeException
err
    else Text -> Parser Text
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Text
TE.decodeUtf8 ByteString
s)
 where
    startState :: S
startState              = Int# -> Int# -> S
S 0# 0#
    go :: S -> Word8 -> Maybe S
go (S skip :: Int#
skip escaped :: Int#
escaped) (W8# c :: Word#
c)
      | Int# -> Bool
isTrue# Int#
skip        = S -> Maybe S
forall a. a -> Maybe a
Just (Int# -> Int# -> S
S 0# Int#
escaped')
      | Int# -> Bool
isTrue# (Int#
w Int# -> Int# -> Int#
==# 34#) = Maybe S
forall a. Maybe a
Nothing   -- double quote
      | Bool
otherwise           = S -> Maybe S
forall a. a -> Maybe a
Just (Int# -> Int# -> S
S Int#
skip' Int#
escaped')
      where
        w :: Int#
w = Word# -> Int#
word2Int# Word#
c
        skip' :: Int#
skip' = Int#
w Int# -> Int# -> Int#
==# 92# -- backslash
        escaped' :: Int#
escaped' = Int#
escaped
            Int# -> Int# -> Int#
`orI#` (Int#
w Int# -> Int# -> Int#
`andI#` 0x80# Int# -> Int# -> Int#
==# 0x80#) -- c >= 0x80
            Int# -> Int# -> Int#
`orI#` Int#
skip'
            Int# -> Int# -> Int#
`orI#` (Int#
w Int# -> Int# -> Int#
`andI#` 0x1f# Int# -> Int# -> Int#
==# Int#
w)     -- c < 0x20

data S = S Int# Int#
#else
  s <- A.scan startState go <* A.anyWord8
  case unescapeText s of
    Right r  -> return r
    Left err -> fail $ show err
 where
    startState              = False
    go a c
      | a                  = Just False
      | c == DOUBLE_QUOTE  = Nothing
      | otherwise = let a' = c == backslash
                    in Just a'
      where backslash = BACKSLASH
#endif

decodeWith :: Parser Value -> (Value -> Result a) -> L.ByteString -> Maybe a
decodeWith :: Parser Value -> (Value -> Result a) -> ByteString -> Maybe a
decodeWith p :: Parser Value
p to :: Value -> Result a
to s :: ByteString
s =
    case Parser Value -> ByteString -> Result Value
forall a. Parser a -> ByteString -> Result a
L.parse Parser Value
p ByteString
s of
      L.Done _ v :: Value
v -> case Value -> Result a
to Value
v of
                      Success a :: a
a -> a -> Maybe a
forall a. a -> Maybe a
Just a
a
                      _         -> Maybe a
forall a. Maybe a
Nothing
      _          -> Maybe a
forall a. Maybe a
Nothing
{-# INLINE decodeWith #-}

decodeStrictWith :: Parser Value -> (Value -> Result a) -> B.ByteString
                 -> Maybe a
decodeStrictWith :: Parser Value -> (Value -> Result a) -> ByteString -> Maybe a
decodeStrictWith p :: Parser Value
p to :: Value -> Result a
to s :: ByteString
s =
    case (String -> Result a)
-> (Value -> Result a) -> Either String Value -> Result a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Result a
forall a. String -> Result a
Error Value -> Result a
to (Parser Value -> ByteString -> Either String Value
forall a. Parser a -> ByteString -> Either String a
A.parseOnly Parser Value
p ByteString
s) of
      Success a :: a
a -> a -> Maybe a
forall a. a -> Maybe a
Just a
a
      _         -> Maybe a
forall a. Maybe a
Nothing
{-# INLINE decodeStrictWith #-}

eitherDecodeWith :: Parser Value -> (Value -> IResult a) -> L.ByteString
                 -> Either (JSONPath, String) a
eitherDecodeWith :: Parser Value
-> (Value -> IResult a)
-> ByteString
-> Either (JSONPath, String) a
eitherDecodeWith p :: Parser Value
p to :: Value -> IResult a
to s :: ByteString
s =
    case Parser Value -> ByteString -> Result Value
forall a. Parser a -> ByteString -> Result a
L.parse Parser Value
p ByteString
s of
      L.Done _ v :: Value
v     -> case Value -> IResult a
to Value
v of
                          ISuccess a :: a
a      -> a -> Either (JSONPath, String) a
forall a b. b -> Either a b
Right a
a
                          IError path :: JSONPath
path msg :: String
msg -> (JSONPath, String) -> Either (JSONPath, String) a
forall a b. a -> Either a b
Left (JSONPath
path, String
msg)
      L.Fail _ ctx :: [String]
ctx msg :: String
msg -> (JSONPath, String) -> Either (JSONPath, String) a
forall a b. a -> Either a b
Left ([], [String] -> String -> String
buildMsg [String]
ctx String
msg)
  where
    buildMsg :: [String] -> String -> String
    buildMsg :: [String] -> String -> String
buildMsg [] msg :: String
msg = String
msg
    buildMsg (expectation :: String
expectation:_) msg :: String
msg =
      String
msg String -> String -> String
forall a. [a] -> [a] -> [a]
++ ". Expecting " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
expectation
{-# INLINE eitherDecodeWith #-}

eitherDecodeStrictWith :: Parser Value -> (Value -> IResult a) -> B.ByteString
                       -> Either (JSONPath, String) a
eitherDecodeStrictWith :: Parser Value
-> (Value -> IResult a)
-> ByteString
-> Either (JSONPath, String) a
eitherDecodeStrictWith p :: Parser Value
p to :: Value -> IResult a
to s :: ByteString
s =
    case (String -> IResult a)
-> (Value -> IResult a) -> Either String Value -> IResult a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (JSONPath -> String -> IResult a
forall a. JSONPath -> String -> IResult a
IError []) Value -> IResult a
to (Parser Value -> ByteString -> Either String Value
forall a. Parser a -> ByteString -> Either String a
A.parseOnly Parser Value
p ByteString
s) of
      ISuccess a :: a
a      -> a -> Either (JSONPath, String) a
forall a b. b -> Either a b
Right a
a
      IError path :: JSONPath
path msg :: String
msg -> (JSONPath, String) -> Either (JSONPath, String) a
forall a b. a -> Either a b
Left (JSONPath
path, String
msg)
{-# INLINE eitherDecodeStrictWith #-}

-- $lazy
--
-- The 'json' and 'value' parsers decouple identification from
-- conversion.  Identification occurs immediately (so that an invalid
-- JSON document can be rejected as early as possible), but conversion
-- to a Haskell value is deferred until that value is needed.
--
-- This decoupling can be time-efficient if only a smallish subset of
-- elements in a JSON value need to be inspected, since the cost of
-- conversion is zero for uninspected elements.  The trade off is an
-- increase in memory usage, due to allocation of thunks for values
-- that have not yet been converted.

-- $strict
--
-- The 'json'' and 'value'' parsers combine identification with
-- conversion.  They consume more CPU cycles up front, but have a
-- smaller memory footprint.

-- | Parse a top-level JSON value followed by optional whitespace and
-- end-of-input.  See also: 'json'.
jsonEOF :: Parser Value
jsonEOF :: Parser Value
jsonEOF = Parser Value
json Parser Value -> Parser () -> Parser Value
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
skipSpace Parser Value -> Parser () -> Parser Value
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
forall t. Chunk t => Parser t ()
endOfInput

-- | Parse a top-level JSON value followed by optional whitespace and
-- end-of-input.  See also: 'json''.
jsonEOF' :: Parser Value
jsonEOF' :: Parser Value
jsonEOF' = Parser Value
json' Parser Value -> Parser () -> Parser Value
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
skipSpace Parser Value -> Parser () -> Parser Value
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
forall t. Chunk t => Parser t ()
endOfInput

-- | The only valid whitespace in a JSON document is space, newline,
-- carriage return, and tab.
skipSpace :: Parser ()
skipSpace :: Parser ()
skipSpace = (Word8 -> Bool) -> Parser ()
A.skipWhile ((Word8 -> Bool) -> Parser ()) -> (Word8 -> Bool) -> Parser ()
forall a b. (a -> b) -> a -> b
$ \w :: Word8
w -> Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== 0x20 Bool -> Bool -> Bool
|| Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== 0x0a Bool -> Bool -> Bool
|| Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== 0x0d Bool -> Bool -> Bool
|| Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== 0x09
{-# INLINE skipSpace #-}

------------------ Copy-pasted and adapted from attoparsec ------------------

-- A strict pair
data SP = SP !Integer {-# UNPACK #-}!Int

decimal0 :: Parser Integer
decimal0 :: Parser Integer
decimal0 = do
  let zero :: Word8
zero = 48
  ByteString
digits <- (Word8 -> Bool) -> Parser ByteString
A.takeWhile1 Word8 -> Bool
isDigit_w8
  if ByteString -> Int
B.length ByteString
digits Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 1 Bool -> Bool -> Bool
&& ByteString -> Word8
B.unsafeHead ByteString
digits Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
zero
    then String -> Parser Integer
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "leading zero"
    else Integer -> Parser Integer
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Integer
bsToInteger ByteString
digits)

-- | Parse a JSON number.
scientific :: Parser Scientific
scientific :: Parser ByteString Scientific
scientific = do
  let minus :: Word8
minus = 45
      plus :: Word8
plus  = 43
  Word8
sign <- Parser Word8
A.peekWord8'
  let !positive :: Bool
positive = Word8
sign Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
plus Bool -> Bool -> Bool
|| Word8
sign Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
minus
  Bool -> Parser () -> Parser ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word8
sign Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
plus Bool -> Bool -> Bool
|| Word8
sign Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
minus) (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$
    Parser Word8 -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Parser Word8
A.anyWord8

  Integer
n <- Parser Integer
decimal0

  let f :: ByteString -> SP
f fracDigits :: ByteString
fracDigits = Integer -> Int -> SP
SP ((Integer -> Word8 -> Integer) -> Integer -> ByteString -> Integer
forall a. (a -> Word8 -> a) -> a -> ByteString -> a
B.foldl' Integer -> Word8 -> Integer
forall a a. (Integral a, Num a) => a -> a -> a
step Integer
n ByteString
fracDigits)
                        (Int -> Int
forall a. Num a => a -> a
negate (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
B.length ByteString
fracDigits)
      step :: a -> a -> a
step a :: a
a w :: a
w = a
a a -> a -> a
forall a. Num a => a -> a -> a
* 10 a -> a -> a
forall a. Num a => a -> a -> a
+ a -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a
w a -> a -> a
forall a. Num a => a -> a -> a
- 48)

  Maybe Word8
dotty <- Parser (Maybe Word8)
A.peekWord8
  -- '.' -> ascii 46
  SP c :: Integer
c e :: Int
e <- case Maybe Word8
dotty of
              Just 46 -> Parser Word8
A.anyWord8 Parser Word8 -> Parser ByteString SP -> Parser ByteString SP
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (ByteString -> SP
f (ByteString -> SP) -> Parser ByteString -> Parser ByteString SP
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word8 -> Bool) -> Parser ByteString
A.takeWhile1 Word8 -> Bool
isDigit_w8)
              _       -> SP -> Parser ByteString SP
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer -> Int -> SP
SP Integer
n 0)

  let !signedCoeff :: Integer
signedCoeff | Bool
positive  =  Integer
c
                   | Bool
otherwise = -Integer
c

  let littleE :: Word8
littleE = 101
      bigE :: Word8
bigE    = 69
  ((Word8 -> Bool) -> Parser Word8
A.satisfy (\ex :: Word8
ex -> Word8
ex Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
littleE Bool -> Bool -> Bool
|| Word8
ex Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
bigE) Parser Word8
-> Parser ByteString Scientific -> Parser ByteString Scientific
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
      (Int -> Scientific)
-> Parser ByteString Int -> Parser ByteString Scientific
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Integer -> Int -> Scientific
Sci.scientific Integer
signedCoeff (Int -> Scientific) -> (Int -> Int) -> Int -> Scientific
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int
e Int -> Int -> Int
forall a. Num a => a -> a -> a
+)) (Parser ByteString Int -> Parser ByteString Int
forall a. Num a => Parser a -> Parser a
signed Parser ByteString Int
forall a. Integral a => Parser a
decimal)) Parser ByteString Scientific
-> Parser ByteString Scientific -> Parser ByteString Scientific
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
    Scientific -> Parser ByteString Scientific
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> Int -> Scientific
Sci.scientific Integer
signedCoeff    Int
e)
{-# INLINE scientific #-}

------------------ Copy-pasted and adapted from base ------------------------

bsToInteger :: B.ByteString -> Integer
bsToInteger :: ByteString -> Integer
bsToInteger bs :: ByteString
bs
    | Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 40    = Integer -> Int -> [Integer] -> Integer
valInteger 10 Int
l [ Word8 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8
w Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- 48) | Word8
w <- ByteString -> [Word8]
B.unpack ByteString
bs ]
    | Bool
otherwise = ByteString -> Integer
bsToIntegerSimple ByteString
bs
  where
    l :: Int
l = ByteString -> Int
B.length ByteString
bs

bsToIntegerSimple :: B.ByteString -> Integer
bsToIntegerSimple :: ByteString -> Integer
bsToIntegerSimple = (Integer -> Word8 -> Integer) -> Integer -> ByteString -> Integer
forall a. (a -> Word8 -> a) -> a -> ByteString -> a
B.foldl' Integer -> Word8 -> Integer
forall a a. (Integral a, Num a) => a -> a -> a
step 0 where
  step :: a -> a -> a
step a :: a
a b :: a
b = a
a a -> a -> a
forall a. Num a => a -> a -> a
* 10 a -> a -> a
forall a. Num a => a -> a -> a
+ a -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a
b a -> a -> a
forall a. Num a => a -> a -> a
- 48) -- 48 = '0'

-- A sub-quadratic algorithm for Integer. Pairs of adjacent radix b
-- digits are combined into a single radix b^2 digit. This process is
-- repeated until we are left with a single digit. This algorithm
-- performs well only on large inputs, so we use the simple algorithm
-- for smaller inputs.
valInteger :: Integer -> Int -> [Integer] -> Integer
valInteger :: Integer -> Int -> [Integer] -> Integer
valInteger = Integer -> Int -> [Integer] -> Integer
go
  where
    go :: Integer -> Int -> [Integer] -> Integer
    go :: Integer -> Int -> [Integer] -> Integer
go _ _ []  = 0
    go _ _ [d :: Integer
d] = Integer
d
    go b :: Integer
b l :: Int
l ds :: [Integer]
ds
        | Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 40 = Integer
b' Integer -> Integer -> Integer
forall a b. a -> b -> b
`seq` Integer -> Int -> [Integer] -> Integer
go Integer
b' Int
l' (Integer -> [Integer] -> [Integer]
forall a. Num a => a -> [a] -> [a]
combine Integer
b [Integer]
ds')
        | Bool
otherwise = Integer -> [Integer] -> Integer
valSimple Integer
b [Integer]
ds
      where
        -- ensure that we have an even number of digits
        -- before we call combine:
        ds' :: [Integer]
ds' = if Int -> Bool
forall a. Integral a => a -> Bool
even Int
l then [Integer]
ds else 0 Integer -> [Integer] -> [Integer]
forall a. a -> [a] -> [a]
: [Integer]
ds
        b' :: Integer
b' = Integer
b Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
b
        l' :: Int
l' = (Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` 2

    combine :: a -> [a] -> [a]
combine b :: a
b (d1 :: a
d1 : d2 :: a
d2 : ds :: [a]
ds) = a
d a -> [a] -> [a]
forall a b. a -> b -> b
`seq` (a
d a -> [a] -> [a]
forall a. a -> [a] -> [a]
: a -> [a] -> [a]
combine a
b [a]
ds)
      where
        d :: a
d = a
d1 a -> a -> a
forall a. Num a => a -> a -> a
* a
b a -> a -> a
forall a. Num a => a -> a -> a
+ a
d2
    combine _ []  = []
    combine _ [_] = String -> [a]
forall a. String -> a
errorWithoutStackTrace "this should not happen"

-- The following algorithm is only linear for types whose Num operations
-- are in constant time.
valSimple :: Integer -> [Integer] -> Integer
valSimple :: Integer -> [Integer] -> Integer
valSimple base :: Integer
base = Integer -> [Integer] -> Integer
forall a. Integral a => Integer -> [a] -> Integer
go 0
  where
    go :: Integer -> [a] -> Integer
go r :: Integer
r [] = Integer
r
    go r :: Integer
r (d :: a
d : ds :: [a]
ds) = Integer
r' Integer -> Integer -> Integer
forall a b. a -> b -> b
`seq` Integer -> [a] -> Integer
go Integer
r' [a]
ds
      where
        r' :: Integer
r' = Integer
r Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
base Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ a -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
d