{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RoleAnnotations #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

-- | Implementation of FromJSON parsers via Attoparsec.
--
-- This module does not construct intermediate data structures like maps or key-value lists,
-- and instead uses permutation parsers in order to parse your data structure directly.
-- This means that it is pretty fast!
-- However, you also get basically *zero* error reporting, which is generally not what you want.
module Jordan.FromJSON.Attoparsec
  ( attoparsecParserFor,
    parseViaAttoparsecWith,
    parseViaAttoparsec,
    attoparsecParser,
  )
where

import Control.Applicative (Alternative (..))
import Control.Monad (void, when)
import Data.Attoparsec.ByteString ((<?>))
import qualified Data.Attoparsec.ByteString as A
import qualified Data.Attoparsec.ByteString as AP
import qualified Data.Attoparsec.ByteString.Char8 as CH
import qualified Data.Attoparsec.Combinator as AC
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import qualified Data.ByteString.Unsafe as B
import Data.Char (chr, digitToInt, isControl, isHexDigit, ord)
import Data.Functor (void, ($>))
import Data.Monoid (Alt (..))
import Data.Scientific (Scientific)
import qualified Data.Scientific as Sci
import qualified Data.Scientific as Scientific
import qualified Data.Text as Text
import Data.Text.Encoding (decodeUtf8, encodeUtf8)
import Debug.Trace
import Jordan.FromJSON.Class
import Jordan.FromJSON.Internal.Attoparsec
import Jordan.FromJSON.Internal.Permutation
import Numeric (showHex)

newtype ObjectParser a = ObjectParser
  {ObjectParser a -> Permutation Parser a
runObjectParser :: Permutation AP.Parser a}
  deriving (a -> ObjectParser b -> ObjectParser a
(a -> b) -> ObjectParser a -> ObjectParser b
(forall a b. (a -> b) -> ObjectParser a -> ObjectParser b)
-> (forall a b. a -> ObjectParser b -> ObjectParser a)
-> Functor ObjectParser
forall a b. a -> ObjectParser b -> ObjectParser a
forall a b. (a -> b) -> ObjectParser a -> ObjectParser b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> ObjectParser b -> ObjectParser a
$c<$ :: forall a b. a -> ObjectParser b -> ObjectParser a
fmap :: (a -> b) -> ObjectParser a -> ObjectParser b
$cfmap :: forall a b. (a -> b) -> ObjectParser a -> ObjectParser b
Functor, Functor ObjectParser
a -> ObjectParser a
Functor ObjectParser
-> (forall a. a -> ObjectParser a)
-> (forall a b.
    ObjectParser (a -> b) -> ObjectParser a -> ObjectParser b)
-> (forall a b c.
    (a -> b -> c)
    -> ObjectParser a -> ObjectParser b -> ObjectParser c)
-> (forall a b. ObjectParser a -> ObjectParser b -> ObjectParser b)
-> (forall a b. ObjectParser a -> ObjectParser b -> ObjectParser a)
-> Applicative ObjectParser
ObjectParser a -> ObjectParser b -> ObjectParser b
ObjectParser a -> ObjectParser b -> ObjectParser a
ObjectParser (a -> b) -> ObjectParser a -> ObjectParser b
(a -> b -> c) -> ObjectParser a -> ObjectParser b -> ObjectParser c
forall a. a -> ObjectParser a
forall a b. ObjectParser a -> ObjectParser b -> ObjectParser a
forall a b. ObjectParser a -> ObjectParser b -> ObjectParser b
forall a b.
ObjectParser (a -> b) -> ObjectParser a -> ObjectParser b
forall a b c.
(a -> b -> c) -> ObjectParser a -> ObjectParser b -> ObjectParser 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
<* :: ObjectParser a -> ObjectParser b -> ObjectParser a
$c<* :: forall a b. ObjectParser a -> ObjectParser b -> ObjectParser a
*> :: ObjectParser a -> ObjectParser b -> ObjectParser b
$c*> :: forall a b. ObjectParser a -> ObjectParser b -> ObjectParser b
liftA2 :: (a -> b -> c) -> ObjectParser a -> ObjectParser b -> ObjectParser c
$cliftA2 :: forall a b c.
(a -> b -> c) -> ObjectParser a -> ObjectParser b -> ObjectParser c
<*> :: ObjectParser (a -> b) -> ObjectParser a -> ObjectParser b
$c<*> :: forall a b.
ObjectParser (a -> b) -> ObjectParser a -> ObjectParser b
pure :: a -> ObjectParser a
$cpure :: forall a. a -> ObjectParser a
$cp1Applicative :: Functor ObjectParser
Applicative)

type role ArrayParser representational

data ArrayParser a
  = ParseNoEffect a
  | ParseWithEffect (AP.Parser a)
  deriving (a -> ArrayParser b -> ArrayParser a
(a -> b) -> ArrayParser a -> ArrayParser b
(forall a b. (a -> b) -> ArrayParser a -> ArrayParser b)
-> (forall a b. a -> ArrayParser b -> ArrayParser a)
-> Functor ArrayParser
forall a b. a -> ArrayParser b -> ArrayParser a
forall a b. (a -> b) -> ArrayParser a -> ArrayParser b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> ArrayParser b -> ArrayParser a
$c<$ :: forall a b. a -> ArrayParser b -> ArrayParser a
fmap :: (a -> b) -> ArrayParser a -> ArrayParser b
$cfmap :: forall a b. (a -> b) -> ArrayParser a -> ArrayParser b
Functor)

instance Applicative ArrayParser where
  pure :: a -> ArrayParser a
pure = a -> ArrayParser a
forall a. a -> ArrayParser a
ParseNoEffect
  ArrayParser (a -> b)
f <*> :: ArrayParser (a -> b) -> ArrayParser a -> ArrayParser b
<*> ArrayParser a
a = case ArrayParser (a -> b)
f of
    ParseNoEffect a -> b
fab -> case ArrayParser a
a of
      ParseNoEffect a
a' -> b -> ArrayParser b
forall a. a -> ArrayParser a
ParseNoEffect (a -> b
fab a
a')
      ParseWithEffect Parser a
pa -> Parser b -> ArrayParser b
forall a. Parser a -> ArrayParser a
ParseWithEffect (a -> b
fab (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser a
pa)
    ParseWithEffect Parser (a -> b)
pa -> case ArrayParser a
a of
      ParseNoEffect a
a' -> Parser b -> ArrayParser b
forall a. Parser a -> ArrayParser a
ParseWithEffect (((a -> b) -> b) -> Parser (a -> b) -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
$ a
a') Parser (a -> b)
pa)
      ParseWithEffect Parser a
pa' -> Parser b -> ArrayParser b
forall a. Parser a -> ArrayParser a
ParseWithEffect (Parser b -> ArrayParser b) -> Parser b -> ArrayParser b
forall a b. (a -> b) -> a -> b
$ do
        a -> b
f' <- Parser (a -> b)
pa
        Parser ()
comma
        a -> b
f' (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser a
pa'

runArrayParser :: ArrayParser a -> AP.Parser a
runArrayParser :: ArrayParser a -> Parser a
runArrayParser (ParseNoEffect a
a) = a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
runArrayParser (ParseWithEffect Parser a
eff) = Parser a
eff

instance JSONObjectParser ObjectParser where
  parseFieldWith :: Text
-> (forall (valueParser :: * -> *).
    JSONParser valueParser =>
    valueParser a)
-> ObjectParser a
parseFieldWith Text
label forall (valueParser :: * -> *).
JSONParser valueParser =>
valueParser a
parser =
    Permutation Parser a -> ObjectParser a
forall a. Permutation Parser a -> ObjectParser a
ObjectParser (Permutation Parser a -> ObjectParser a)
-> Permutation Parser a -> ObjectParser a
forall a b. (a -> b) -> a -> b
$
      Parser ByteString a -> Permutation Parser a
forall (f :: * -> *) a. Alternative f => f a -> Permutation f a
asPermutation (Parser ByteString a -> Permutation Parser a)
-> Parser ByteString a -> Permutation Parser a
forall a b. (a -> b) -> a -> b
$
        Text -> Parser ByteString a -> Parser ByteString a
forall a. Text -> Parser a -> Parser a
parseObjectField
          Text
label
          (AttoparsecParser a -> Parser ByteString a
forall a. AttoparsecParser a -> Parser a
runAttoparsecParser AttoparsecParser a
forall (valueParser :: * -> *).
JSONParser valueParser =>
valueParser a
parser)
  {-# INLINE parseFieldWith #-}
  parseFieldWithDefault :: Text
-> (forall (valueParser :: * -> *).
    JSONParser valueParser =>
    valueParser a)
-> a
-> ObjectParser a
parseFieldWithDefault Text
f = \(AttoparsecParser parseField) a
def ->
    Permutation Parser a -> ObjectParser a
forall a. Permutation Parser a -> ObjectParser a
ObjectParser (Permutation Parser a -> ObjectParser a)
-> Permutation Parser a -> ObjectParser a
forall a b. (a -> b) -> a -> b
$
      Parser ByteString a -> a -> Permutation Parser a
forall (f :: * -> *) a.
Alternative f =>
f a -> a -> Permutation f a
asPermutationWithDefault (Text -> Parser ByteString a -> Parser ByteString a
forall a. Text -> Parser a -> Parser a
parseObjectField Text
f (Parser ByteString a
parseField Parser ByteString a -> String -> Parser ByteString a
forall i a. Parser i a -> String -> Parser i a
<?> (String
"field " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a. Show a => a -> String
show Text
f))) a
def

newtype AttoparsecParser a = AttoparsecParser
  {AttoparsecParser a -> Parser a
runAttoparsecParser :: AP.Parser a}
  deriving (a -> AttoparsecParser b -> AttoparsecParser a
(a -> b) -> AttoparsecParser a -> AttoparsecParser b
(forall a b. (a -> b) -> AttoparsecParser a -> AttoparsecParser b)
-> (forall a b. a -> AttoparsecParser b -> AttoparsecParser a)
-> Functor AttoparsecParser
forall a b. a -> AttoparsecParser b -> AttoparsecParser a
forall a b. (a -> b) -> AttoparsecParser a -> AttoparsecParser b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> AttoparsecParser b -> AttoparsecParser a
$c<$ :: forall a b. a -> AttoparsecParser b -> AttoparsecParser a
fmap :: (a -> b) -> AttoparsecParser a -> AttoparsecParser b
$cfmap :: forall a b. (a -> b) -> AttoparsecParser a -> AttoparsecParser b
Functor)
  deriving (b -> AttoparsecParser a -> AttoparsecParser a
NonEmpty (AttoparsecParser a) -> AttoparsecParser a
AttoparsecParser a -> AttoparsecParser a -> AttoparsecParser a
(AttoparsecParser a -> AttoparsecParser a -> AttoparsecParser a)
-> (NonEmpty (AttoparsecParser a) -> AttoparsecParser a)
-> (forall b.
    Integral b =>
    b -> AttoparsecParser a -> AttoparsecParser a)
-> Semigroup (AttoparsecParser a)
forall b.
Integral b =>
b -> AttoparsecParser a -> AttoparsecParser a
forall a. NonEmpty (AttoparsecParser a) -> AttoparsecParser a
forall a.
AttoparsecParser a -> AttoparsecParser a -> AttoparsecParser a
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
forall a b.
Integral b =>
b -> AttoparsecParser a -> AttoparsecParser a
stimes :: b -> AttoparsecParser a -> AttoparsecParser a
$cstimes :: forall a b.
Integral b =>
b -> AttoparsecParser a -> AttoparsecParser a
sconcat :: NonEmpty (AttoparsecParser a) -> AttoparsecParser a
$csconcat :: forall a. NonEmpty (AttoparsecParser a) -> AttoparsecParser a
<> :: AttoparsecParser a -> AttoparsecParser a -> AttoparsecParser a
$c<> :: forall a.
AttoparsecParser a -> AttoparsecParser a -> AttoparsecParser a
Semigroup, Semigroup (AttoparsecParser a)
AttoparsecParser a
Semigroup (AttoparsecParser a)
-> AttoparsecParser a
-> (AttoparsecParser a -> AttoparsecParser a -> AttoparsecParser a)
-> ([AttoparsecParser a] -> AttoparsecParser a)
-> Monoid (AttoparsecParser a)
[AttoparsecParser a] -> AttoparsecParser a
AttoparsecParser a -> AttoparsecParser a -> AttoparsecParser a
forall a. Semigroup (AttoparsecParser a)
forall a. AttoparsecParser a
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall a. [AttoparsecParser a] -> AttoparsecParser a
forall a.
AttoparsecParser a -> AttoparsecParser a -> AttoparsecParser a
mconcat :: [AttoparsecParser a] -> AttoparsecParser a
$cmconcat :: forall a. [AttoparsecParser a] -> AttoparsecParser a
mappend :: AttoparsecParser a -> AttoparsecParser a -> AttoparsecParser a
$cmappend :: forall a.
AttoparsecParser a -> AttoparsecParser a -> AttoparsecParser a
mempty :: AttoparsecParser a
$cmempty :: forall a. AttoparsecParser a
$cp1Monoid :: forall a. Semigroup (AttoparsecParser a)
Monoid) via (Alt AP.Parser a)

instance JSONTupleParser ArrayParser where
  consumeItemWith :: (forall (valueParser :: * -> *).
 JSONParser valueParser =>
 valueParser a)
-> ArrayParser a
consumeItemWith = \forall (valueParser :: * -> *).
JSONParser valueParser =>
valueParser a
parser -> Parser a -> ArrayParser a
forall a. Parser a -> ArrayParser a
ParseWithEffect (Parser a -> ArrayParser a) -> Parser a -> ArrayParser a
forall a b. (a -> b) -> a -> b
$ AttoparsecParser a -> Parser a
forall a. AttoparsecParser a -> Parser a
runAttoparsecParser AttoparsecParser a
forall (valueParser :: * -> *).
JSONParser valueParser =>
valueParser a
parser

instance JSONParser AttoparsecParser where
  parseObject :: (forall (objectParser :: * -> *).
 JSONObjectParser objectParser =>
 objectParser a)
-> AttoparsecParser a
parseObject = \forall (objectParser :: * -> *).
JSONObjectParser objectParser =>
objectParser a
parser -> Parser a -> AttoparsecParser a
forall a. Parser a -> AttoparsecParser a
AttoparsecParser (Parser a -> AttoparsecParser a) -> Parser a -> AttoparsecParser a
forall a b. (a -> b) -> a -> b
$
    String -> Parser a -> Parser a
forall a. String -> Parser a -> Parser a
label String
"Object" (Parser a -> Parser a) -> Parser a -> Parser a
forall a b. (a -> b) -> a -> b
$ do
      Parser ()
startObject
      a
r <- Parser () -> Parser () -> Permutation Parser a -> Parser a
forall (m :: * -> *) a b.
Alternative m =>
m b -> m b -> Permutation m a -> m a
wrapEffect (Parser ()
parseAnyField Parser () -> String -> Parser ()
forall i a. Parser i a -> String -> Parser i a
<?> String
"ignored field in the middle of an object") Parser ()
comma (Permutation Parser a -> Parser a)
-> Permutation Parser a -> Parser a
forall a b. (a -> b) -> a -> b
$ ObjectParser a -> Permutation Parser a
forall a. ObjectParser a -> Permutation Parser a
runObjectParser ObjectParser a
forall (objectParser :: * -> *).
JSONObjectParser objectParser =>
objectParser a
parser
      Parser ()
objectEndWithJunk
      a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
r
  {-# INLINE parseObject #-}
  parseDictionary :: (forall (jsonParser :: * -> *).
 JSONParser jsonParser =>
 jsonParser a)
-> AttoparsecParser [(Text, a)]
parseDictionary forall (jsonParser :: * -> *).
JSONParser jsonParser =>
jsonParser a
parse = Parser [(Text, a)] -> AttoparsecParser [(Text, a)]
forall a. Parser a -> AttoparsecParser a
AttoparsecParser (Parser [(Text, a)] -> AttoparsecParser [(Text, a)])
-> Parser [(Text, a)] -> AttoparsecParser [(Text, a)]
forall a b. (a -> b) -> a -> b
$
    Parser [(Text, a)] -> Parser [(Text, a)]
forall a. Parser a -> Parser a
inObjectBraces (Parser [(Text, a)] -> Parser [(Text, a)])
-> Parser [(Text, a)] -> Parser [(Text, a)]
forall a b. (a -> b) -> a -> b
$ do
      Parser a -> Parser (Text, a)
forall a. Parser a -> Parser (Text, a)
parseDictField (AttoparsecParser a -> Parser a
forall a. AttoparsecParser a -> Parser a
runAttoparsecParser AttoparsecParser a
forall (jsonParser :: * -> *).
JSONParser jsonParser =>
jsonParser a
parse) Parser (Text, a) -> Parser () -> Parser [(Text, a)]
forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
`AP.sepBy` Parser ()
comma
  parseTextConstant :: Text -> AttoparsecParser ()
parseTextConstant Text
c = Parser () -> AttoparsecParser ()
forall a. Parser a -> AttoparsecParser a
AttoparsecParser (Text -> Parser ()
objectKey Text
c Parser () -> String -> Parser ()
forall i a. Parser i a -> String -> Parser i a
<?> String
"text constant" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
Text.unpack Text
c)
  {-# INLINE parseTextConstant #-}
  parseText :: AttoparsecParser Text
parseText = Parser Text -> AttoparsecParser Text
forall a. Parser a -> AttoparsecParser a
AttoparsecParser Parser Text
parseJSONText
  {-# INLINE parseText #-}
  parseNumber :: AttoparsecParser Scientific
parseNumber = Parser Scientific -> AttoparsecParser Scientific
forall a. Parser a -> AttoparsecParser a
AttoparsecParser Parser Scientific
number
  {-# INLINE parseNumber #-}
  validateJSON :: AttoparsecParser (Either Text a) -> AttoparsecParser a
validateJSON AttoparsecParser (Either Text a)
v = Parser a -> AttoparsecParser a
forall a. Parser a -> AttoparsecParser a
AttoparsecParser (Parser a -> AttoparsecParser a) -> Parser a -> AttoparsecParser a
forall a b. (a -> b) -> a -> b
$ do
    Either Text a
r <- AttoparsecParser (Either Text a) -> Parser (Either Text a)
forall a. AttoparsecParser a -> Parser a
runAttoparsecParser AttoparsecParser (Either Text a)
v
    case Either Text a
r of
      Left Text
err -> String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (Text -> String
Text.unpack Text
err)
      Right a
e -> a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
e
  parseTuple :: (forall (arrayParser :: * -> *).
 JSONTupleParser arrayParser =>
 arrayParser o)
-> AttoparsecParser o
parseTuple forall (arrayParser :: * -> *).
JSONTupleParser arrayParser =>
arrayParser o
ap = Parser o -> AttoparsecParser o
forall a. Parser a -> AttoparsecParser a
AttoparsecParser (Parser o -> AttoparsecParser o) -> Parser o -> AttoparsecParser o
forall a b. (a -> b) -> a -> b
$ do
    Parser Word8 -> Parser Word8
forall a. Parser a -> Parser a
lexeme (Parser Word8 -> Parser Word8) -> Parser Word8 -> Parser Word8
forall a b. (a -> b) -> a -> b
$ Word8 -> Parser Word8
AP.word8 Word8
91
    o
r <- ArrayParser o -> Parser o
forall a. ArrayParser a -> Parser a
runArrayParser ArrayParser o
forall (arrayParser :: * -> *).
JSONTupleParser arrayParser =>
arrayParser o
ap
    Parser Word8 -> Parser Word8
forall a. Parser a -> Parser a
lexeme (Parser Word8 -> Parser Word8) -> Parser Word8 -> Parser Word8
forall a b. (a -> b) -> a -> b
$ Word8 -> Parser Word8
AP.word8 Word8
93
    o -> Parser o
forall (f :: * -> *) a. Applicative f => a -> f a
pure o
r
  {-# INLINE parseTuple #-}
  parseArrayWith :: (forall (jsonParser :: * -> *).
 JSONParser jsonParser =>
 jsonParser a)
-> AttoparsecParser [a]
parseArrayWith forall (jsonParser :: * -> *).
JSONParser jsonParser =>
jsonParser a
jp = Parser [a] -> AttoparsecParser [a]
forall a. Parser a -> AttoparsecParser a
AttoparsecParser (Parser [a] -> AttoparsecParser [a])
-> Parser [a] -> AttoparsecParser [a]
forall a b. (a -> b) -> a -> b
$ do
    Parser ()
startArray
    [a]
r <- Parser a -> Parser a
forall a. Parser a -> Parser a
lexeme (AttoparsecParser a -> Parser a
forall a. AttoparsecParser a -> Parser a
runAttoparsecParser AttoparsecParser a
forall (jsonParser :: * -> *).
JSONParser jsonParser =>
jsonParser a
jp) Parser a -> Parser () -> Parser [a]
forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
`AP.sepBy` Parser ()
comma Parser [a] -> String -> Parser [a]
forall i a. Parser i a -> String -> Parser i a
<?> String
"array items"
    Parser ()
endArray
    [a] -> Parser [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [a]
r
  {-# INLINE parseArrayWith #-}
  parseBool :: AttoparsecParser Bool
parseBool =
    Parser Bool -> AttoparsecParser Bool
forall a. Parser a -> AttoparsecParser a
AttoparsecParser (Parser Bool -> AttoparsecParser Bool)
-> Parser Bool -> AttoparsecParser Bool
forall a b. (a -> b) -> a -> b
$
      Parser Bool -> Parser Bool
forall a. Parser a -> Parser a
lexeme (Parser Bool -> Parser Bool) -> Parser Bool -> Parser Bool
forall a b. (a -> b) -> a -> b
$
        (ByteString -> Parser ByteString
AP.string ByteString
"true" Parser ByteString -> Bool -> Parser Bool
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Bool
True) Parser Bool -> Parser Bool -> Parser Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (ByteString -> Parser ByteString
AP.string ByteString
"false" Parser ByteString -> Bool -> Parser Bool
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Bool
False)
  parseNull :: AttoparsecParser ()
parseNull = Parser () -> AttoparsecParser ()
forall a. Parser a -> AttoparsecParser a
AttoparsecParser (Parser () -> AttoparsecParser ())
-> Parser () -> AttoparsecParser ()
forall a b. (a -> b) -> a -> b
$ Parser () -> Parser ()
forall a. Parser a -> Parser a
lexeme (ByteString -> Parser ByteString
AP.string ByteString
"null" Parser ByteString -> () -> Parser ()
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ())
  nameParser :: Text -> AttoparsecParser a -> AttoparsecParser a
nameParser Text
l = \(AttoparsecParser Parser a
a) ->
    Parser a -> AttoparsecParser a
forall a. Parser a -> AttoparsecParser a
AttoparsecParser (Parser a -> AttoparsecParser a) -> Parser a -> AttoparsecParser a
forall a b. (a -> b) -> a -> b
$
      String -> Parser a -> Parser a
forall a. String -> Parser a -> Parser a
label (String
"Parser '" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
Text.unpack Text
l String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"'") Parser a
a

-- | Convert an abstract JSON parser to an Attoparsec Parser.
-- This function will skip leading whitespace.
attoparsecParserFor :: (forall parser. JSONParser parser => parser a) -> AP.Parser a
attoparsecParserFor :: (forall (parser :: * -> *). JSONParser parser => parser a)
-> Parser a
attoparsecParserFor = \forall (parser :: * -> *). JSONParser parser => parser a
parser -> (Parser ()
skipSpace Parser () -> Parser a -> Parser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>) (Parser a -> Parser a) -> Parser a -> Parser a
forall a b. (a -> b) -> a -> b
$ AttoparsecParser a -> Parser a
forall a. AttoparsecParser a -> Parser a
runAttoparsecParser AttoparsecParser a
forall (parser :: * -> *). JSONParser parser => parser a
parser
{-# INLINE attoparsecParserFor #-}

parseViaAttoparsecWith :: (forall parser. JSONParser parser => parser a) -> ByteString -> Either String a
parseViaAttoparsecWith :: (forall (parser :: * -> *). JSONParser parser => parser a)
-> ByteString -> Either String a
parseViaAttoparsecWith forall (parser :: * -> *). JSONParser parser => parser a
p = Parser a -> ByteString -> Either String a
forall a. Parser a -> ByteString -> Either String a
AP.parseOnly ((forall (parser :: * -> *). JSONParser parser => parser a)
-> Parser a
forall a.
(forall (parser :: * -> *). JSONParser parser => parser a)
-> Parser a
attoparsecParserFor forall (parser :: * -> *). JSONParser parser => parser a
p)
{-# INLINE parseViaAttoparsecWith #-}

-- | Parse a ByteString via an Attoparsec Parser.
parseViaAttoparsec :: forall val. (FromJSON val) => ByteString -> Either String val
parseViaAttoparsec :: ByteString -> Either String val
parseViaAttoparsec = (forall (parser :: * -> *). JSONParser parser => parser val)
-> ByteString -> Either String val
forall a.
(forall (parser :: * -> *). JSONParser parser => parser a)
-> ByteString -> Either String a
parseViaAttoparsecWith (forall (parser :: * -> *).
(FromJSON val, JSONParser parser) =>
parser val
forall value (f :: * -> *).
(FromJSON value, JSONParser f) =>
f value
fromJSON @val)
{-# INLINE parseViaAttoparsec #-}

-- | Get an Attoparsec parser for a particular JSON-parsable value.
attoparsecParser :: (FromJSON val) => AP.Parser val
attoparsecParser :: Parser val
attoparsecParser = AttoparsecParser val -> Parser val
forall a. AttoparsecParser a -> Parser a
runAttoparsecParser AttoparsecParser val
forall value (f :: * -> *).
(FromJSON value, JSONParser f) =>
f value
fromJSON
{-# INLINE attoparsecParser #-}