{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE CPP #-}
module Data.Aeson.Config.Parser (
  Parser
, runParser

, typeMismatch
, withObject
, withText
, withString
, withArray
, withNumber
, withBool

, explicitParseField
, explicitParseFieldMaybe

, Aeson.JSONPathElement(..)
, (<?>)

, Value(..)
, Object
, Array

, liftParser

, fromAesonPath
, formatPath
) where

import           Imports

import qualified Control.Monad.Fail as Fail
import           Control.Monad.Trans.Class
import           Control.Monad.Trans.Writer
import           Data.Scientific
import           Data.Set (Set, notMember)
import qualified Data.Set as Set
import qualified Data.Text as T
import qualified Data.Vector as V
import           Data.Aeson.Config.Key (Key)
import qualified Data.Aeson.Config.Key as Key
import qualified Data.Aeson.Config.KeyMap as KeyMap
import           Data.Aeson.Types (Value(..), Object, Array)
import qualified Data.Aeson.Types as Aeson
import           Data.Aeson.Internal (IResult(..), iparse)
#if !MIN_VERSION_aeson(1,4,5)
import qualified Data.Aeson.Internal as Aeson
#endif

-- This is needed so that we have an Ord instance for aeson < 1.2.4.
data JSONPathElement = Key Text | Index Int
  deriving (JSONPathElement -> JSONPathElement -> Bool
(JSONPathElement -> JSONPathElement -> Bool)
-> (JSONPathElement -> JSONPathElement -> Bool)
-> Eq JSONPathElement
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: JSONPathElement -> JSONPathElement -> Bool
$c/= :: JSONPathElement -> JSONPathElement -> Bool
== :: JSONPathElement -> JSONPathElement -> Bool
$c== :: JSONPathElement -> JSONPathElement -> Bool
Eq, Int -> JSONPathElement -> ShowS
[JSONPathElement] -> ShowS
JSONPathElement -> String
(Int -> JSONPathElement -> ShowS)
-> (JSONPathElement -> String)
-> ([JSONPathElement] -> ShowS)
-> Show JSONPathElement
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JSONPathElement] -> ShowS
$cshowList :: [JSONPathElement] -> ShowS
show :: JSONPathElement -> String
$cshow :: JSONPathElement -> String
showsPrec :: Int -> JSONPathElement -> ShowS
$cshowsPrec :: Int -> JSONPathElement -> ShowS
Show, Eq JSONPathElement
Eq JSONPathElement
-> (JSONPathElement -> JSONPathElement -> Ordering)
-> (JSONPathElement -> JSONPathElement -> Bool)
-> (JSONPathElement -> JSONPathElement -> Bool)
-> (JSONPathElement -> JSONPathElement -> Bool)
-> (JSONPathElement -> JSONPathElement -> Bool)
-> (JSONPathElement -> JSONPathElement -> JSONPathElement)
-> (JSONPathElement -> JSONPathElement -> JSONPathElement)
-> Ord JSONPathElement
JSONPathElement -> JSONPathElement -> Bool
JSONPathElement -> JSONPathElement -> Ordering
JSONPathElement -> JSONPathElement -> JSONPathElement
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: JSONPathElement -> JSONPathElement -> JSONPathElement
$cmin :: JSONPathElement -> JSONPathElement -> JSONPathElement
max :: JSONPathElement -> JSONPathElement -> JSONPathElement
$cmax :: JSONPathElement -> JSONPathElement -> JSONPathElement
>= :: JSONPathElement -> JSONPathElement -> Bool
$c>= :: JSONPathElement -> JSONPathElement -> Bool
> :: JSONPathElement -> JSONPathElement -> Bool
$c> :: JSONPathElement -> JSONPathElement -> Bool
<= :: JSONPathElement -> JSONPathElement -> Bool
$c<= :: JSONPathElement -> JSONPathElement -> Bool
< :: JSONPathElement -> JSONPathElement -> Bool
$c< :: JSONPathElement -> JSONPathElement -> Bool
compare :: JSONPathElement -> JSONPathElement -> Ordering
$ccompare :: JSONPathElement -> JSONPathElement -> Ordering
$cp1Ord :: Eq JSONPathElement
Ord)

type JSONPath = [JSONPathElement]

fromAesonPath :: Aeson.JSONPath -> JSONPath
fromAesonPath :: JSONPath -> [JSONPathElement]
fromAesonPath = [JSONPathElement] -> [JSONPathElement]
forall a. [a] -> [a]
reverse ([JSONPathElement] -> [JSONPathElement])
-> (JSONPath -> [JSONPathElement]) -> JSONPath -> [JSONPathElement]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (JSONPathElement -> JSONPathElement)
-> JSONPath -> [JSONPathElement]
forall a b. (a -> b) -> [a] -> [b]
map JSONPathElement -> JSONPathElement
fromAesonPathElement

fromAesonPathElement :: Aeson.JSONPathElement -> JSONPathElement
fromAesonPathElement :: JSONPathElement -> JSONPathElement
fromAesonPathElement JSONPathElement
e = case JSONPathElement
e of
  Aeson.Key Key
k -> Text -> JSONPathElement
Key (Key -> Text
Key.toText Key
k)
  Aeson.Index Int
n -> Int -> JSONPathElement
Index Int
n

newtype Parser a = Parser {Parser a -> WriterT (Set [JSONPathElement]) Parser a
unParser :: WriterT (Set JSONPath) Aeson.Parser a}
  deriving (a -> Parser b -> Parser a
(a -> b) -> Parser a -> Parser b
(forall a b. (a -> b) -> Parser a -> Parser b)
-> (forall a b. a -> Parser b -> Parser a) -> Functor Parser
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
<$ :: a -> Parser b -> Parser a
$c<$ :: forall a b. a -> Parser b -> Parser a
fmap :: (a -> b) -> Parser a -> Parser b
$cfmap :: forall a b. (a -> b) -> Parser a -> Parser b
Functor, Functor Parser
a -> Parser a
Functor Parser
-> (forall a. a -> Parser a)
-> (forall a b. Parser (a -> b) -> Parser a -> Parser b)
-> (forall a b c.
    (a -> b -> c) -> Parser a -> Parser b -> Parser c)
-> (forall a b. Parser a -> Parser b -> Parser b)
-> (forall a b. Parser a -> Parser b -> Parser a)
-> Applicative Parser
Parser a -> Parser b -> Parser b
Parser a -> Parser b -> Parser a
Parser (a -> b) -> Parser a -> Parser b
(a -> b -> c) -> Parser a -> Parser b -> Parser c
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
<* :: Parser a -> Parser b -> Parser a
$c<* :: forall a b. Parser a -> Parser b -> Parser a
*> :: Parser a -> Parser b -> Parser b
$c*> :: forall a b. Parser a -> Parser b -> Parser b
liftA2 :: (a -> b -> c) -> Parser a -> Parser b -> Parser c
$cliftA2 :: forall a b c. (a -> b -> c) -> Parser a -> Parser b -> Parser c
<*> :: Parser (a -> b) -> Parser a -> Parser b
$c<*> :: forall a b. Parser (a -> b) -> Parser a -> Parser b
pure :: a -> Parser a
$cpure :: forall a. a -> Parser a
$cp1Applicative :: Functor Parser
Applicative, Applicative Parser
Parser a
Applicative Parser
-> (forall a. Parser a)
-> (forall a. Parser a -> Parser a -> Parser a)
-> (forall a. Parser a -> Parser [a])
-> (forall a. Parser a -> Parser [a])
-> Alternative Parser
Parser a -> Parser a -> Parser a
Parser a -> Parser [a]
Parser a -> Parser [a]
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 :: Parser a -> Parser [a]
$cmany :: forall a. Parser a -> Parser [a]
some :: Parser a -> Parser [a]
$csome :: forall a. Parser a -> Parser [a]
<|> :: Parser a -> Parser a -> Parser a
$c<|> :: forall a. Parser a -> Parser a -> Parser a
empty :: Parser a
$cempty :: forall a. Parser a
$cp1Alternative :: Applicative Parser
Alternative, Applicative Parser
a -> Parser a
Applicative Parser
-> (forall a b. Parser a -> (a -> Parser b) -> Parser b)
-> (forall a b. Parser a -> Parser b -> Parser b)
-> (forall a. a -> Parser a)
-> Monad Parser
Parser a -> (a -> Parser b) -> Parser b
Parser a -> Parser b -> Parser b
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 :: a -> Parser a
$creturn :: forall a. a -> Parser a
>> :: Parser a -> Parser b -> Parser b
$c>> :: forall a b. Parser a -> Parser b -> Parser b
>>= :: Parser a -> (a -> Parser b) -> Parser b
$c>>= :: forall a b. Parser a -> (a -> Parser b) -> Parser b
$cp1Monad :: Applicative Parser
Monad, Monad Parser
Monad Parser -> (forall a. String -> Parser a) -> MonadFail Parser
String -> Parser a
forall a. String -> Parser a
forall (m :: * -> *).
Monad m -> (forall a. String -> m a) -> MonadFail m
fail :: String -> Parser a
$cfail :: forall a. String -> Parser a
$cp1MonadFail :: Monad Parser
Fail.MonadFail)

liftParser :: Aeson.Parser a -> Parser a
liftParser :: Parser a -> Parser a
liftParser = WriterT (Set [JSONPathElement]) Parser a -> Parser a
forall a. WriterT (Set [JSONPathElement]) Parser a -> Parser a
Parser (WriterT (Set [JSONPathElement]) Parser a -> Parser a)
-> (Parser a -> WriterT (Set [JSONPathElement]) Parser a)
-> Parser a
-> Parser a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser a -> WriterT (Set [JSONPathElement]) Parser a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift

runParser :: (Value -> Parser a) -> Value -> Either String (a, [String])
runParser :: (Value -> Parser a) -> Value -> Either String (a, [String])
runParser Value -> Parser a
p Value
v = case (Value -> Parser (a, Set [JSONPathElement]))
-> Value -> IResult (a, Set [JSONPathElement])
forall a b. (a -> Parser b) -> a -> IResult b
iparse (WriterT (Set [JSONPathElement]) Parser a
-> Parser (a, Set [JSONPathElement])
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT (WriterT (Set [JSONPathElement]) Parser a
 -> Parser (a, Set [JSONPathElement]))
-> (Parser a -> WriterT (Set [JSONPathElement]) Parser a)
-> Parser a
-> Parser (a, Set [JSONPathElement])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser a -> WriterT (Set [JSONPathElement]) Parser a
forall a. Parser a -> WriterT (Set [JSONPathElement]) Parser a
unParser (Parser a -> Parser (a, Set [JSONPathElement]))
-> (Value -> Parser a)
-> Value
-> Parser (a, Set [JSONPathElement])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser a
p) Value
v of
  IError JSONPath
path String
err -> String -> Either String (a, [String])
forall a b. a -> Either a b
Left (String
"Error while parsing " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [JSONPathElement] -> String
formatPath (JSONPath -> [JSONPathElement]
fromAesonPath JSONPath
path) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" - " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
err)
  ISuccess (a
a, Set [JSONPathElement]
consumed) -> (a, [String]) -> Either String (a, [String])
forall a b. b -> Either a b
Right (a
a, ([JSONPathElement] -> String) -> [[JSONPathElement]] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map [JSONPathElement] -> String
formatPath (Set [JSONPathElement] -> Value -> [[JSONPathElement]]
determineUnconsumed Set [JSONPathElement]
consumed Value
v))

formatPath :: JSONPath -> String
formatPath :: [JSONPathElement] -> String
formatPath = String -> [JSONPathElement] -> String
go String
"$" ([JSONPathElement] -> String)
-> ([JSONPathElement] -> [JSONPathElement])
-> [JSONPathElement]
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [JSONPathElement] -> [JSONPathElement]
forall a. [a] -> [a]
reverse
  where
    go :: String -> JSONPath -> String
    go :: String -> [JSONPathElement] -> String
go String
acc [JSONPathElement]
path = case [JSONPathElement]
path of
      [] -> String
acc
      Index Int
n : [JSONPathElement]
xs -> String -> [JSONPathElement] -> String
go (String
acc String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"[" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"]") [JSONPathElement]
xs
      Key Text
key : [JSONPathElement]
xs -> String -> [JSONPathElement] -> String
go (String
acc String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"." String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack Text
key) [JSONPathElement]
xs

determineUnconsumed :: Set JSONPath -> Value -> [JSONPath]
determineUnconsumed :: Set [JSONPathElement] -> Value -> [[JSONPathElement]]
determineUnconsumed ((Set [JSONPathElement]
-> Set [JSONPathElement] -> Set [JSONPathElement]
forall a. Semigroup a => a -> a -> a
<> [JSONPathElement] -> Set [JSONPathElement]
forall a. a -> Set a
Set.singleton []) -> Set [JSONPathElement]
consumed) = Set [JSONPathElement] -> [[JSONPathElement]]
forall a. Set a -> [a]
Set.toList (Set [JSONPathElement] -> [[JSONPathElement]])
-> (Value -> Set [JSONPathElement]) -> Value -> [[JSONPathElement]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Writer (Set [JSONPathElement]) () -> Set [JSONPathElement]
forall w a. Writer w a -> w
execWriter (Writer (Set [JSONPathElement]) () -> Set [JSONPathElement])
-> (Value -> Writer (Set [JSONPathElement]) ())
-> Value
-> Set [JSONPathElement]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [JSONPathElement] -> Value -> Writer (Set [JSONPathElement]) ()
go []
  where
    go :: JSONPath -> Value -> Writer (Set JSONPath) ()
    go :: [JSONPathElement] -> Value -> Writer (Set [JSONPathElement]) ()
go [JSONPathElement]
path Value
value
      | [JSONPathElement]
path [JSONPathElement] -> Set [JSONPathElement] -> Bool
forall a. Ord a => a -> Set a -> Bool
`notMember` Set [JSONPathElement]
consumed = Set [JSONPathElement] -> Writer (Set [JSONPathElement]) ()
forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
tell ([JSONPathElement] -> Set [JSONPathElement]
forall a. a -> Set a
Set.singleton [JSONPathElement]
path)
      | Bool
otherwise = case Value
value of
          Number Scientific
_ -> () -> Writer (Set [JSONPathElement]) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          String Text
_ -> () -> Writer (Set [JSONPathElement]) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          Bool Bool
_ -> () -> Writer (Set [JSONPathElement]) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          Value
Null -> () -> Writer (Set [JSONPathElement]) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          Object Object
o -> do
            [(Key, Value)]
-> ((Key, Value) -> Writer (Set [JSONPathElement]) ())
-> Writer (Set [JSONPathElement]) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Object -> [(Key, Value)]
forall v. KeyMap v -> [(Key, v)]
KeyMap.toList Object
o) (((Key, Value) -> Writer (Set [JSONPathElement]) ())
 -> Writer (Set [JSONPathElement]) ())
-> ((Key, Value) -> Writer (Set [JSONPathElement]) ())
-> Writer (Set [JSONPathElement]) ()
forall a b. (a -> b) -> a -> b
$ \ (Key -> Text
Key.toText -> Text
k, Value
v) -> do
              Bool
-> Writer (Set [JSONPathElement]) ()
-> Writer (Set [JSONPathElement]) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Text
"_" Text -> Text -> Bool
`T.isPrefixOf` Text
k) (Writer (Set [JSONPathElement]) ()
 -> Writer (Set [JSONPathElement]) ())
-> Writer (Set [JSONPathElement]) ()
-> Writer (Set [JSONPathElement]) ()
forall a b. (a -> b) -> a -> b
$ do
                [JSONPathElement] -> Value -> Writer (Set [JSONPathElement]) ()
go (Text -> JSONPathElement
Key Text
k JSONPathElement -> [JSONPathElement] -> [JSONPathElement]
forall a. a -> [a] -> [a]
: [JSONPathElement]
path) Value
v
          Array Array
xs -> do
            [(Int, Value)]
-> ((Int, Value) -> Writer (Set [JSONPathElement]) ())
-> Writer (Set [JSONPathElement]) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([Int] -> [Value] -> [(Int, Value)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] ([Value] -> [(Int, Value)]) -> [Value] -> [(Int, Value)]
forall a b. (a -> b) -> a -> b
$ Array -> [Value]
forall a. Vector a -> [a]
V.toList Array
xs) (((Int, Value) -> Writer (Set [JSONPathElement]) ())
 -> Writer (Set [JSONPathElement]) ())
-> ((Int, Value) -> Writer (Set [JSONPathElement]) ())
-> Writer (Set [JSONPathElement]) ()
forall a b. (a -> b) -> a -> b
$ \ (Int
n, Value
v) -> do
              [JSONPathElement] -> Value -> Writer (Set [JSONPathElement]) ()
go (Int -> JSONPathElement
Index Int
n JSONPathElement -> [JSONPathElement] -> [JSONPathElement]
forall a. a -> [a] -> [a]
: [JSONPathElement]
path) Value
v

(<?>) :: Parser a -> Aeson.JSONPathElement -> Parser a
<?> :: Parser a -> JSONPathElement -> Parser a
(<?>) (Parser (WriterT Parser (a, Set [JSONPathElement])
p)) JSONPathElement
e = do
  WriterT (Set [JSONPathElement]) Parser a -> Parser a
forall a. WriterT (Set [JSONPathElement]) Parser a -> Parser a
Parser (Parser (a, Set [JSONPathElement])
-> WriterT (Set [JSONPathElement]) Parser a
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
WriterT (Parser (a, Set [JSONPathElement])
p Parser (a, Set [JSONPathElement])
-> JSONPathElement -> Parser (a, Set [JSONPathElement])
forall a. Parser a -> JSONPathElement -> Parser a
Aeson.<?> JSONPathElement
e)) Parser a -> Parser () -> Parser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* JSONPathElement -> Parser ()
markConsumed (JSONPathElement -> JSONPathElement
fromAesonPathElement JSONPathElement
e)

markConsumed :: JSONPathElement -> Parser ()
markConsumed :: JSONPathElement -> Parser ()
markConsumed JSONPathElement
e = do
  [JSONPathElement]
path <- Parser [JSONPathElement]
getPath
  WriterT (Set [JSONPathElement]) Parser () -> Parser ()
forall a. WriterT (Set [JSONPathElement]) Parser a -> Parser a
Parser (WriterT (Set [JSONPathElement]) Parser () -> Parser ())
-> WriterT (Set [JSONPathElement]) Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ Set [JSONPathElement] -> WriterT (Set [JSONPathElement]) Parser ()
forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
tell ([JSONPathElement] -> Set [JSONPathElement]
forall a. a -> Set a
Set.singleton ([JSONPathElement] -> Set [JSONPathElement])
-> [JSONPathElement] -> Set [JSONPathElement]
forall a b. (a -> b) -> a -> b
$ JSONPathElement
e JSONPathElement -> [JSONPathElement] -> [JSONPathElement]
forall a. a -> [a] -> [a]
: [JSONPathElement]
path)

getPath :: Parser JSONPath
getPath :: Parser [JSONPathElement]
getPath = Parser [JSONPathElement] -> Parser [JSONPathElement]
forall a. Parser a -> Parser a
liftParser (Parser [JSONPathElement] -> Parser [JSONPathElement])
-> Parser [JSONPathElement] -> Parser [JSONPathElement]
forall a b. (a -> b) -> a -> b
$ Parser [JSONPathElement]
-> (JSONPath -> String -> Parser [JSONPathElement])
-> Parser [JSONPathElement]
forall a. Parser a -> (JSONPath -> String -> Parser a) -> Parser a
Aeson.parserCatchError Parser [JSONPathElement]
forall (f :: * -> *) a. Alternative f => f a
empty ((JSONPath -> String -> Parser [JSONPathElement])
 -> Parser [JSONPathElement])
-> (JSONPath -> String -> Parser [JSONPathElement])
-> Parser [JSONPathElement]
forall a b. (a -> b) -> a -> b
$ \ JSONPath
path String
_ -> [JSONPathElement] -> Parser [JSONPathElement]
forall (m :: * -> *) a. Monad m => a -> m a
return (JSONPath -> [JSONPathElement]
fromAesonPath JSONPath
path)

explicitParseField :: (Value -> Parser a) -> Object -> Key -> Parser a
explicitParseField :: (Value -> Parser a) -> Object -> Key -> Parser a
explicitParseField Value -> Parser a
p Object
o Key
key = case Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
KeyMap.lookup Key
key Object
o of
  Maybe Value
Nothing -> String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser a) -> String -> Parser a
forall a b. (a -> b) -> a -> b
$ String
"key " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Key -> String
forall a. Show a => a -> String
show Key
key String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" not present"
  Just Value
v  -> Value -> Parser a
p Value
v Parser a -> JSONPathElement -> Parser a
forall a. Parser a -> JSONPathElement -> Parser a
<?> Key -> JSONPathElement
Aeson.Key Key
key

explicitParseFieldMaybe :: (Value -> Parser a) -> Object -> Key -> Parser (Maybe a)
explicitParseFieldMaybe :: (Value -> Parser a) -> Object -> Key -> Parser (Maybe a)
explicitParseFieldMaybe Value -> Parser a
p Object
o Key
key = case Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
KeyMap.lookup Key
key Object
o of
  Maybe Value
Nothing -> Maybe a -> Parser (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
  Just Value
v  -> a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> Parser a -> Parser (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser a
p Value
v Parser a -> JSONPathElement -> Parser a
forall a. Parser a -> JSONPathElement -> Parser a
<?> Key -> JSONPathElement
Aeson.Key Key
key

typeMismatch :: String -> Value -> Parser a
typeMismatch :: String -> Value -> Parser a
typeMismatch String
expected = Parser a -> Parser a
forall a. Parser a -> Parser a
liftParser (Parser a -> Parser a) -> (Value -> Parser a) -> Value -> Parser a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Value -> Parser a
forall a. String -> Value -> Parser a
Aeson.typeMismatch String
expected

withObject :: (Object -> Parser a) -> Value -> Parser a
withObject :: (Object -> Parser a) -> Value -> Parser a
withObject Object -> Parser a
p (Object Object
o) = Object -> Parser a
p Object
o
withObject Object -> Parser a
_ Value
v = String -> Value -> Parser a
forall a. String -> Value -> Parser a
typeMismatch String
"Object" Value
v

withText :: (Text -> Parser a) -> Value -> Parser a
withText :: (Text -> Parser a) -> Value -> Parser a
withText Text -> Parser a
p (String Text
s) = Text -> Parser a
p Text
s
withText Text -> Parser a
_ Value
v = String -> Value -> Parser a
forall a. String -> Value -> Parser a
typeMismatch String
"String" Value
v

withString :: (String -> Parser a) -> Value -> Parser a
withString :: (String -> Parser a) -> Value -> Parser a
withString String -> Parser a
p = (Text -> Parser a) -> Value -> Parser a
forall a. (Text -> Parser a) -> Value -> Parser a
withText (String -> Parser a
p (String -> Parser a) -> (Text -> String) -> Text -> Parser a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack)

withArray :: (Array -> Parser a) -> Value -> Parser a
withArray :: (Array -> Parser a) -> Value -> Parser a
withArray Array -> Parser a
p (Array Array
xs) = Array -> Parser a
p Array
xs
withArray Array -> Parser a
_ Value
v = String -> Value -> Parser a
forall a. String -> Value -> Parser a
typeMismatch String
"Array" Value
v

withNumber :: (Scientific -> Parser a) -> Value -> Parser a
withNumber :: (Scientific -> Parser a) -> Value -> Parser a
withNumber Scientific -> Parser a
p (Number Scientific
n) = Scientific -> Parser a
p Scientific
n
withNumber Scientific -> Parser a
_ Value
v = String -> Value -> Parser a
forall a. String -> Value -> Parser a
typeMismatch String
"Number" Value
v

withBool :: (Bool -> Parser a) -> Value -> Parser a
withBool :: (Bool -> Parser a) -> Value -> Parser a
withBool Bool -> Parser a
p (Bool Bool
b) = Bool -> Parser a
p Bool
b
withBool Bool -> Parser a
_ Value
v = String -> Value -> Parser a
forall a. String -> Value -> Parser a
typeMismatch String
"Boolean" Value
v