{-
Parser DSL for the \"aeson\" model of JSON tree.

The general model of this DSL is about switching between contexts.
-}
module AesonValueParser
  ( Value,
    run,
    runWithTextError,
    runAsValueParser,
    Error.Error (..),
    parseByteString,

    -- * Value parsers
    object,
    array,
    null,
    nullable,
    nullableMonoid,
    string,
    number,
    bool,
    fromJSON,

    -- * String parsers
    String,
    text,
    mappedText,
    narrowedText,
    matchedText,
    attoparsedText,
    megaparsedText,

    -- * Number parsers
    Number,
    scientific,
    integer,
    floating,
    matchedScientific,
    matchedInteger,
    matchedFloating,

    -- * Object parsers
    Object,
    field,
    oneOfFields,
    fieldMap,
    foldlFields,
    fieldsAmount,

    -- * Array parsers
    Array,
    element,
    elementVector,
    elementList,
    foldlElements,
    foldrElements,
    elementsAmount,
  )
where

import qualified AesonValueParser.Error as Error
import AesonValueParser.Prelude hiding (String, bool, null)
import qualified AesonValueParser.Vector as Vector
import qualified Data.Aeson as Aeson
import qualified Data.Aeson.Key as Key
import qualified Data.Aeson.KeyMap as KeyMap
import qualified Data.Aeson.Types as Aeson
import qualified Data.Attoparsec.Text as Attoparsec
import qualified Data.HashMap.Strict as HashMap
import qualified Data.Scientific as Scientific
import qualified Data.Text as Text
import qualified Data.Vector as Vector
import qualified Text.Megaparsec as Megaparsec

-- * Value

-- |
-- JSON `Aeson.Value` AST parser.
--
-- Its `Alternative` instance implements the logic of choosing between the possible types of JSON values.
newtype Value a
  = Value (ReaderT Aeson.Value (MaybeT (Either Error.Error)) a)
  deriving (forall a b. a -> Value b -> Value a
forall a b. (a -> b) -> Value a -> Value b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Value b -> Value a
$c<$ :: forall a b. a -> Value b -> Value a
fmap :: forall a b. (a -> b) -> Value a -> Value b
$cfmap :: forall a b. (a -> b) -> Value a -> Value b
Functor, Functor Value
forall a. a -> Value a
forall a b. Value a -> Value b -> Value a
forall a b. Value a -> Value b -> Value b
forall a b. Value (a -> b) -> Value a -> Value b
forall a b c. (a -> b -> c) -> Value a -> Value b -> Value c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b. Value a -> Value b -> Value a
$c<* :: forall a b. Value a -> Value b -> Value a
*> :: forall a b. Value a -> Value b -> Value b
$c*> :: forall a b. Value a -> Value b -> Value b
liftA2 :: forall a b c. (a -> b -> c) -> Value a -> Value b -> Value c
$cliftA2 :: forall a b c. (a -> b -> c) -> Value a -> Value b -> Value c
<*> :: forall a b. Value (a -> b) -> Value a -> Value b
$c<*> :: forall a b. Value (a -> b) -> Value a -> Value b
pure :: forall a. a -> Value a
$cpure :: forall a. a -> Value a
Applicative)

-- |
-- Implements the logic of choosing between the possible types of JSON values.
--
-- If you have multiple parsers of the same type of JSON value composed,
-- only the leftmost will be affective.
-- The errors from deeper parsers do not trigger the alternation,
-- instead they get propagated to the top.
instance Alternative Value where
  empty :: forall a. Value a
empty = forall a. ReaderT Value (MaybeT (Either Error)) a -> Value a
Value forall a b. (a -> b) -> a -> b
$ forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
  <|> :: forall a. Value a -> Value a -> Value a
(<|>) (Value ReaderT Value (MaybeT (Either Error)) a
leftParser) (Value ReaderT Value (MaybeT (Either Error)) a
rightParser) = forall a. ReaderT Value (MaybeT (Either Error)) a -> Value a
Value (ReaderT Value (MaybeT (Either Error)) a
leftParser forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ReaderT Value (MaybeT (Either Error)) a
rightParser)

{-# INLINE run #-}
run :: Value a -> Aeson.Value -> Either Error.Error a
run :: forall a. Value a -> Value -> Either Error a
run = \(Value ReaderT Value (MaybeT (Either Error)) a
parser) Value
value -> forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
(=<<) (forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a b. a -> Either a b
Left (forall {a}. IsString a => Value -> a
typeError Value
value)) forall a b. b -> Either a b
Right) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT forall a b. (a -> b) -> a -> b
$ forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT Value (MaybeT (Either Error)) a
parser Value
value
  where
    typeError :: Value -> a
typeError = \case
      Aeson.Array Array
_ -> a
"Unexpected type: array"
      Aeson.Object Object
_ -> a
"Unexpected type: object"
      Aeson.String Text
_ -> a
"Unexpected type: string"
      Aeson.Number Scientific
_ -> a
"Unexpected type: number"
      Aeson.Bool Bool
_ -> a
"Unexpected type: bool"
      Value
Aeson.Null -> a
"Unexpected type: null"

{-# INLINE runWithTextError #-}
runWithTextError :: Value a -> Aeson.Value -> Either Text a
runWithTextError :: forall a. Value a -> Value -> Either Text a
runWithTextError Value a
parser = forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left Error -> Text
Error.toText forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. Value a -> Value -> Either Error a
run Value a
parser

-- | Convert into a function directly applicable as definition
-- of 'Aeson.parseJSON'.
--
-- Here's an example of how it can be used:
--
-- @
-- data Artist = Artist
--   { artistName :: Text,
--     artistGenres :: [Text]
--   }
--
-- instance 'Aeson.FromJSON' Artist where
--   'Aeson.parseJSON' = 'runAsValueParser' $
--     'object' $ do
--       name <- 'field' "name" $ 'string' 'text'
--       genres <- 'field' "genres" $ 'array' $ 'elementList' $ 'string' 'text'
--       return $ Artist name genres
-- @
runAsValueParser :: Value a -> Aeson.Value -> Aeson.Parser a
runAsValueParser :: forall a. Value a -> Value -> Parser a
runAsValueParser Value a
parser =
  forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text -> String
Text.unpack) forall (m :: * -> *) a. Monad m => a -> m a
return
    forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. Value a -> Value -> Either Text a
runWithTextError Value a
parser

runString :: String a -> Text -> Either (Maybe Text) a
runString :: forall a. String a -> Text -> Either (Maybe Text) a
runString (String ReaderT Text (Except (Last Text)) a
a) Text
b = forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first forall a. Last a -> Maybe a
getLast (forall e a. Except e a -> Either e a
runExcept (forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT Text (Except (Last Text)) a
a Text
b))

parseByteString :: Value a -> ByteString -> Either Text a
parseByteString :: forall a. Value a -> ByteString -> Either Text a
parseByteString Value a
p ByteString
bs =
  case forall a. FromJSON a => ByteString -> Either String a
Aeson.eitherDecodeStrict' ByteString
bs of
    Right Value
aeson -> forall a. Value a -> Value -> Either Text a
runWithTextError Value a
p Value
aeson
    Left String
stringErr -> forall a b. a -> Either a b
Left (forall a. IsString a => String -> a
fromString String
stringErr)

-- ** Definitions

{-# INLINE array #-}
array :: Array a -> Value a
array :: forall a. Array a -> Value a
array (Array ReaderT Array (ExceptT Error (Except Error)) a
parser) = forall a. ReaderT Value (MaybeT (Either Error)) a -> Value a
Value forall a b. (a -> b) -> a -> b
$
  forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \case
    Aeson.Array Array
x -> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall a b. (a -> b) -> a -> b
$ forall e a. Except e a -> Either e a
runExcept forall a b. (a -> b) -> a -> b
$ forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT forall a b. (a -> b) -> a -> b
$ forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT Array (ExceptT Error (Except Error)) a
parser Array
x
    Value
_ -> forall (f :: * -> *) a. Alternative f => f a
empty

{-# INLINE object #-}
object :: Object a -> Value a
object :: forall a. Object a -> Value a
object (Object ReaderT Object (ExceptT Error (Except Error)) a
parser) = forall a. ReaderT Value (MaybeT (Either Error)) a -> Value a
Value forall a b. (a -> b) -> a -> b
$
  forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \case
    Aeson.Object Object
x -> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall a b. (a -> b) -> a -> b
$ forall e a. Except e a -> Either e a
runExcept forall a b. (a -> b) -> a -> b
$ forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT forall a b. (a -> b) -> a -> b
$ forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT Object (ExceptT Error (Except Error)) a
parser Object
x
    Value
_ -> forall (f :: * -> *) a. Alternative f => f a
empty

{-# INLINE null #-}
null :: Value ()
null :: Value ()
null = forall a. ReaderT Value (MaybeT (Either Error)) a -> Value a
Value forall a b. (a -> b) -> a -> b
$
  forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \case
    Value
Aeson.Null -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    Value
_ -> forall (f :: * -> *) a. Alternative f => f a
empty

{-# INLINE nullable #-}
nullable :: Value a -> Value (Maybe a)
nullable :: forall a. Value a -> Value (Maybe a)
nullable (Value ReaderT Value (MaybeT (Either Error)) a
parser) = forall a. ReaderT Value (MaybeT (Either Error)) a -> Value a
Value forall a b. (a -> b) -> a -> b
$
  forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \case
    Value
Aeson.Null -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
    Value
x -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just (forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT Value (MaybeT (Either Error)) a
parser Value
x)

{-# INLINE nullableMonoid #-}
nullableMonoid :: (Monoid a) => Value a -> Value a
nullableMonoid :: forall a. Monoid a => Value a -> Value a
nullableMonoid (Value ReaderT Value (MaybeT (Either Error)) a
parser) = forall a. ReaderT Value (MaybeT (Either Error)) a -> Value a
Value forall a b. (a -> b) -> a -> b
$
  forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \case
    Value
Aeson.Null -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty
    Value
x -> forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT Value (MaybeT (Either Error)) a
parser Value
x

{-# INLINE string #-}
string :: String a -> Value a
string :: forall a. String a -> Value a
string (String ReaderT Text (Except (Last Text)) a
parser) = forall a. ReaderT Value (MaybeT (Either Error)) a -> Value a
Value forall a b. (a -> b) -> a -> b
$
  forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \case
    Aeson.String Text
x -> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left (Text -> Error
Error.message forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. a -> Maybe a -> a
fromMaybe Text
"No details" forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. Last a -> Maybe a
getLast) forall a b. (a -> b) -> a -> b
$ forall e a. Except e a -> Either e a
runExcept forall a b. (a -> b) -> a -> b
$ forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT Text (Except (Last Text)) a
parser Text
x
    Value
_ -> forall (f :: * -> *) a. Alternative f => f a
empty

{-# INLINE number #-}
number :: Number a -> Value a
number :: forall a. Number a -> Value a
number (Number ReaderT Scientific (Except (Last Text)) a
parser) = forall a. ReaderT Value (MaybeT (Either Error)) a -> Value a
Value forall a b. (a -> b) -> a -> b
$
  forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \case
    Aeson.Number Scientific
x -> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left (Text -> Error
Error.message forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. a -> Maybe a -> a
fromMaybe Text
"No details" forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. Last a -> Maybe a
getLast) forall a b. (a -> b) -> a -> b
$ forall e a. Except e a -> Either e a
runExcept forall a b. (a -> b) -> a -> b
$ forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT Scientific (Except (Last Text)) a
parser Scientific
x
    Value
_ -> forall (f :: * -> *) a. Alternative f => f a
empty

{-# INLINE bool #-}
bool :: Value Bool
bool :: Value Bool
bool = forall a. ReaderT Value (MaybeT (Either Error)) a -> Value a
Value forall a b. (a -> b) -> a -> b
$
  forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \case
    Aeson.Bool Bool
x -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
x
    Value
_ -> forall (f :: * -> *) a. Alternative f => f a
empty

{-# INLINE fromJSON #-}
fromJSON :: (Aeson.FromJSON a) => Value a
fromJSON :: forall a. FromJSON a => Value a
fromJSON =
  forall a. ReaderT Value (MaybeT (Either Error)) a -> Value a
Value forall a b. (a -> b) -> a -> b
$
    forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$
      forall a. FromJSON a => Value -> Result a
Aeson.fromJSON forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> \case
        Aeson.Success a
r -> forall (m :: * -> *) a. Monad m => a -> m a
return a
r
        Aeson.Error String
m -> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall a. IsString a => String -> a
fromString String
m

-- * String parsers

newtype String a
  = String (ReaderT Text (Except (Last Text)) a)
  deriving (forall a b. a -> String b -> String a
forall a b. (a -> b) -> String a -> String b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> String b -> String a
$c<$ :: forall a b. a -> String b -> String a
fmap :: forall a b. (a -> b) -> String a -> String b
$cfmap :: forall a b. (a -> b) -> String a -> String b
Functor, Functor String
forall a. a -> String a
forall a b. String a -> String b -> String a
forall a b. String a -> String b -> String b
forall a b. String (a -> b) -> String a -> String b
forall a b c. (a -> b -> c) -> String a -> String b -> String c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b. String a -> String b -> String a
$c<* :: forall a b. String a -> String b -> String a
*> :: forall a b. String a -> String b -> String b
$c*> :: forall a b. String a -> String b -> String b
liftA2 :: forall a b c. (a -> b -> c) -> String a -> String b -> String c
$cliftA2 :: forall a b c. (a -> b -> c) -> String a -> String b -> String c
<*> :: forall a b. String (a -> b) -> String a -> String b
$c<*> :: forall a b. String (a -> b) -> String a -> String b
pure :: forall a. a -> String a
$cpure :: forall a. a -> String a
Applicative, Applicative String
forall a. String a
forall a. String a -> String [a]
forall a. String a -> String a -> String a
forall (f :: * -> *).
Applicative f
-> (forall a. f a)
-> (forall a. f a -> f a -> f a)
-> (forall a. f a -> f [a])
-> (forall a. f a -> f [a])
-> Alternative f
many :: forall a. String a -> String [a]
$cmany :: forall a. String a -> String [a]
some :: forall a. String a -> String [a]
$csome :: forall a. String a -> String [a]
<|> :: forall a. String a -> String a -> String a
$c<|> :: forall a. String a -> String a -> String a
empty :: forall a. String a
$cempty :: forall a. String a
Alternative)

{-# INLINE text #-}
text :: String Text
text :: String Text
text = forall a. ReaderT Text (Except (Last Text)) a -> String a
String forall (m :: * -> *) r. Monad m => ReaderT r m r
ask

{-# INLINE mappedText #-}
mappedText :: [(Text, a)] -> String a
mappedText :: forall a. [(Text, a)] -> String a
mappedText [(Text, a)]
mappingList =
  let expectedValuesText :: Text
expectedValuesText = forall a. IsString a => String -> a
fromString (forall a. Show a => a -> String
show (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst [(Text, a)]
mappingList))
      match :: (Text -> Maybe a) -> Text -> Either Text a
match Text -> Maybe a
lookup Text
text = case Text -> Maybe a
lookup Text
text of
        Just a
a -> forall a b. b -> Either a b
Right a
a
        Maybe a
_ -> forall a b. a -> Either a b
Left (Text
"Unexpected value: \"" forall a. Semigroup a => a -> a -> a
<> Text
text forall a. Semigroup a => a -> a -> a
<> Text
"\". Expecting one of: " forall a. Semigroup a => a -> a -> a
<> Text
expectedValuesText)
      mappingListLength :: Int
mappingListLength = forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Text, a)]
mappingList
   in if Int
mappingListLength forall a. Ord a => a -> a -> Bool
> Int
512
        then
          let !hashMap :: HashMap Text a
hashMap = forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList [(Text, a)]
mappingList
           in forall a. (Text -> Either Text a) -> String a
matchedText ((Text -> Maybe a) -> Text -> Either Text a
match (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup HashMap Text a
hashMap))
        else forall a. (Text -> Either Text a) -> String a
matchedText ((Text -> Maybe a) -> Text -> Either Text a
match (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup [(Text, a)]
mappingList))

{-# INLINE narrowedText #-}
narrowedText :: (Text -> Maybe a) -> String a
narrowedText :: forall a. (Text -> Maybe a) -> String a
narrowedText Text -> Maybe a
narrow = forall a. (Text -> Either Text a) -> String a
matchedText Text -> Either Text a
match
  where
    match :: Text -> Either Text a
match Text
text = case Text -> Maybe a
narrow Text
text of
      Just a
a -> forall a b. b -> Either a b
Right a
a
      Maybe a
_ -> forall a b. a -> Either a b
Left (Text
"Unexpected value: \"" forall a. Semigroup a => a -> a -> a
<> Text
text forall a. Semigroup a => a -> a -> a
<> Text
"\"")

{-# INLINE matchedText #-}
matchedText :: (Text -> Either Text a) -> String a
matchedText :: forall a. (Text -> Either Text a) -> String a
matchedText Text -> Either Text a
parser = forall a. ReaderT Text (Except (Last Text)) a -> String a
String forall a b. (a -> b) -> a -> b
$ forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) e a. Monad m => Either e a -> ExceptT e m a
except forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left (forall a. Maybe a -> Last a
Last forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. a -> Maybe a
Just) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text -> Either Text a
parser

{-# INLINE attoparsedText #-}
attoparsedText :: Attoparsec.Parser a -> String a
attoparsedText :: forall a. Parser a -> String a
attoparsedText Parser a
parser = forall a. (Text -> Either Text a) -> String a
matchedText forall a b. (a -> b) -> a -> b
$ forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left forall a. IsString a => String -> a
fromString forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. Parser a -> Text -> Either String a
Attoparsec.parseOnly Parser a
parser

{-# INLINE megaparsedText #-}
megaparsedText :: Megaparsec.Parsec Void Text a -> String a
megaparsedText :: forall a. Parsec Void Text a -> String a
megaparsedText = forall a. (Text -> Either Text a) -> String a
matchedText forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. Parsec Void Text a -> Text -> Either Text a
matcher
  where
    matcher :: Megaparsec.Parsec Void Text a -> Text -> Either Text a
    matcher :: forall a. Parsec Void Text a -> Text -> Either Text a
matcher Parsec Void Text a
p = forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left (forall a. IsString a => String -> a
fromString forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
Megaparsec.errorBundlePretty) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
Megaparsec.runParser (Parsec Void Text a
p forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall e s (m :: * -> *). MonadParsec e s m => m ()
Megaparsec.eof) String
""

-- * Number parsers

newtype Number a
  = Number (ReaderT Scientific (Except (Last Text)) a)
  deriving (forall a b. a -> Number b -> Number a
forall a b. (a -> b) -> Number a -> Number b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Number b -> Number a
$c<$ :: forall a b. a -> Number b -> Number a
fmap :: forall a b. (a -> b) -> Number a -> Number b
$cfmap :: forall a b. (a -> b) -> Number a -> Number b
Functor, Functor Number
forall a. a -> Number a
forall a b. Number a -> Number b -> Number a
forall a b. Number a -> Number b -> Number b
forall a b. Number (a -> b) -> Number a -> Number b
forall a b c. (a -> b -> c) -> Number a -> Number b -> Number c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b. Number a -> Number b -> Number a
$c<* :: forall a b. Number a -> Number b -> Number a
*> :: forall a b. Number a -> Number b -> Number b
$c*> :: forall a b. Number a -> Number b -> Number b
liftA2 :: forall a b c. (a -> b -> c) -> Number a -> Number b -> Number c
$cliftA2 :: forall a b c. (a -> b -> c) -> Number a -> Number b -> Number c
<*> :: forall a b. Number (a -> b) -> Number a -> Number b
$c<*> :: forall a b. Number (a -> b) -> Number a -> Number b
pure :: forall a. a -> Number a
$cpure :: forall a. a -> Number a
Applicative, Applicative Number
forall a. Number a
forall a. Number a -> Number [a]
forall a. Number a -> Number a -> Number a
forall (f :: * -> *).
Applicative f
-> (forall a. f a)
-> (forall a. f a -> f a -> f a)
-> (forall a. f a -> f [a])
-> (forall a. f a -> f [a])
-> Alternative f
many :: forall a. Number a -> Number [a]
$cmany :: forall a. Number a -> Number [a]
some :: forall a. Number a -> Number [a]
$csome :: forall a. Number a -> Number [a]
<|> :: forall a. Number a -> Number a -> Number a
$c<|> :: forall a. Number a -> Number a -> Number a
empty :: forall a. Number a
$cempty :: forall a. Number a
Alternative)

{-# INLINE scientific #-}
scientific :: Number Scientific
scientific :: Number Scientific
scientific = forall a. ReaderT Scientific (Except (Last Text)) a -> Number a
Number forall (m :: * -> *) r. Monad m => ReaderT r m r
ask

{-# INLINE integer #-}
integer :: (Integral a, Bounded a) => Number a
integer :: forall a. (Integral a, Bounded a) => Number a
integer = forall a. ReaderT Scientific (Except (Last Text)) a -> Number a
Number forall a b. (a -> b) -> a -> b
$
  forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \Scientific
x ->
    if Scientific -> Bool
Scientific.isInteger Scientific
x
      then case forall i. (Integral i, Bounded i) => Scientific -> Maybe i
Scientific.toBoundedInteger Scientific
x of
        Just a
int -> forall (m :: * -> *) a. Monad m => a -> m a
return a
int
        Maybe a
Nothing -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (forall a. Maybe a -> Last a
Last (forall a. a -> Maybe a
Just (forall a. IsString a => String -> a
fromString (String
"Number " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Scientific
x forall a. Semigroup a => a -> a -> a
<> String
" is out of integer range"))))
      else forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (forall a. Maybe a -> Last a
Last (forall a. a -> Maybe a
Just (forall a. IsString a => String -> a
fromString (String
"Number " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Scientific
x forall a. Semigroup a => a -> a -> a
<> String
" is not integer"))))

{-# INLINE floating #-}
floating :: (RealFloat a) => Number a
floating :: forall a. RealFloat a => Number a
floating = forall a. ReaderT Scientific (Except (Last Text)) a -> Number a
Number forall a b. (a -> b) -> a -> b
$
  forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \Scientific
a -> case forall a. RealFloat a => Scientific -> Either a a
Scientific.toBoundedRealFloat Scientific
a of
    Right a
b -> forall (m :: * -> *) a. Monad m => a -> m a
return a
b
    Left a
c ->
      if a
c forall a. Eq a => a -> a -> Bool
== a
0
        then forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (forall a. Maybe a -> Last a
Last (forall a. a -> Maybe a
Just (forall a. IsString a => String -> a
fromString (String
"Number " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Scientific
a forall a. Semigroup a => a -> a -> a
<> String
" is too small"))))
        else forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (forall a. Maybe a -> Last a
Last (forall a. a -> Maybe a
Just (forall a. IsString a => String -> a
fromString (String
"Number " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Scientific
a forall a. Semigroup a => a -> a -> a
<> String
" is too large"))))

{-# INLINE matchedScientific #-}
matchedScientific :: (Scientific -> Either Text a) -> Number a
matchedScientific :: forall a. (Scientific -> Either Text a) -> Number a
matchedScientific Scientific -> Either Text a
matcher = forall a. ReaderT Scientific (Except (Last Text)) a -> Number a
Number forall a b. (a -> b) -> a -> b
$ forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) e a. Monad m => Either e a -> ExceptT e m a
except forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left (forall a. Maybe a -> Last a
Last forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. a -> Maybe a
Just) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Scientific -> Either Text a
matcher

{-# INLINE matchedInteger #-}
matchedInteger :: (Integral integer, Bounded integer) => (integer -> Either Text a) -> Number a
matchedInteger :: forall integer a.
(Integral integer, Bounded integer) =>
(integer -> Either Text a) -> Number a
matchedInteger integer -> Either Text a
matcher = forall a. ReaderT Scientific (Except (Last Text)) a -> Number a
Number forall a b. (a -> b) -> a -> b
$ case forall a. (Integral a, Bounded a) => Number a
integer of
  Number ReaderT Scientific (Except (Last Text)) integer
parser -> ReaderT Scientific (Except (Last Text)) integer
parser forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. Maybe a -> Last a
Last forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. a -> Maybe a
Just) forall (m :: * -> *) a. Monad m => a -> m a
return forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. integer -> Either Text a
matcher

{-# INLINE matchedFloating #-}
matchedFloating :: (RealFloat floating) => (floating -> Either Text a) -> Number a
matchedFloating :: forall floating a.
RealFloat floating =>
(floating -> Either Text a) -> Number a
matchedFloating floating -> Either Text a
matcher = forall a. ReaderT Scientific (Except (Last Text)) a -> Number a
Number forall a b. (a -> b) -> a -> b
$ case forall a. RealFloat a => Number a
floating of
  Number ReaderT Scientific (Except (Last Text)) floating
parser -> ReaderT Scientific (Except (Last Text)) floating
parser forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. Maybe a -> Last a
Last forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. a -> Maybe a
Just) forall (m :: * -> *) a. Monad m => a -> m a
return forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. floating -> Either Text a
matcher

-- * Object parsers

-- |
-- JSON `Aeson.Object` parser.
newtype Object a
  = Object (ReaderT (KeyMap.KeyMap Aeson.Value) (ExceptT Error.Error (Except Error.Error)) a)
  deriving (forall a b. a -> Object b -> Object a
forall a b. (a -> b) -> Object a -> Object b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Object b -> Object a
$c<$ :: forall a b. a -> Object b -> Object a
fmap :: forall a b. (a -> b) -> Object a -> Object b
$cfmap :: forall a b. (a -> b) -> Object a -> Object b
Functor, Functor Object
forall a. a -> Object a
forall a b. Object a -> Object b -> Object a
forall a b. Object a -> Object b -> Object b
forall a b. Object (a -> b) -> Object a -> Object b
forall a b c. (a -> b -> c) -> Object a -> Object b -> Object c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b. Object a -> Object b -> Object a
$c<* :: forall a b. Object a -> Object b -> Object a
*> :: forall a b. Object a -> Object b -> Object b
$c*> :: forall a b. Object a -> Object b -> Object b
liftA2 :: forall a b c. (a -> b -> c) -> Object a -> Object b -> Object c
$cliftA2 :: forall a b c. (a -> b -> c) -> Object a -> Object b -> Object c
<*> :: forall a b. Object (a -> b) -> Object a -> Object b
$c<*> :: forall a b. Object (a -> b) -> Object a -> Object b
pure :: forall a. a -> Object a
$cpure :: forall a. a -> Object a
Applicative, Applicative Object
forall a. Object a
forall a. Object a -> Object [a]
forall a. Object a -> Object a -> Object a
forall (f :: * -> *).
Applicative f
-> (forall a. f a)
-> (forall a. f a -> f a -> f a)
-> (forall a. f a -> f [a])
-> (forall a. f a -> f [a])
-> Alternative f
many :: forall a. Object a -> Object [a]
$cmany :: forall a. Object a -> Object [a]
some :: forall a. Object a -> Object [a]
$csome :: forall a. Object a -> Object [a]
<|> :: forall a. Object a -> Object a -> Object a
$c<|> :: forall a. Object a -> Object a -> Object a
empty :: forall a. Object a
$cempty :: forall a. Object a
Alternative, Applicative Object
forall a. a -> Object a
forall a b. Object a -> Object b -> Object b
forall a b. Object a -> (a -> Object b) -> Object b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> Object a
$creturn :: forall a. a -> Object a
>> :: forall a b. Object a -> Object b -> Object b
$c>> :: forall a b. Object a -> Object b -> Object b
>>= :: forall a b. Object a -> (a -> Object b) -> Object b
$c>>= :: forall a b. Object a -> (a -> Object b) -> Object b
Monad, Monad Object
Alternative Object
forall a. Object a
forall a. Object a -> Object a -> Object a
forall (m :: * -> *).
Alternative m
-> Monad m
-> (forall a. m a)
-> (forall a. m a -> m a -> m a)
-> MonadPlus m
mplus :: forall a. Object a -> Object a -> Object a
$cmplus :: forall a. Object a -> Object a -> Object a
mzero :: forall a. Object a
$cmzero :: forall a. Object a
MonadPlus, MonadError Error.Error)

instance MonadFail Object where
  fail :: forall a. String -> Object a
fail = forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. IsString a => String -> a
fromString

{-# INLINE field #-}
field :: Text -> Value a -> Object a
field :: forall a. Text -> Value a -> Object a
field Text
name Value a
fieldParser = forall a.
ReaderT Object (ExceptT Error (Except Error)) a -> Object a
Object forall a b. (a -> b) -> a -> b
$
  forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \Object
object -> case forall v. Key -> KeyMap v -> Maybe v
KeyMap.lookup (Text -> Key
Key.fromText Text
name) Object
object of
    Just Value
value -> case forall a. Value a -> Value -> Either Error a
run Value a
fieldParser Value
value of
      Right a
parsedValue -> forall (m :: * -> *) a. Monad m => a -> m a
return a
parsedValue
      Left Error
error -> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE forall a b. (a -> b) -> a -> b
$ Text -> Error -> Error
Error.named Text
name Error
error
    Maybe Value
Nothing -> forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE ([Text] -> Text -> Error
Error.Error (forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
name) Text
message)
      where
        message :: Text
message =
          Text
"Object contains no field with this name. Fields available: "
            forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => String -> a
fromString (forall a. Show a => a -> String
show (forall v. KeyMap v -> [Key]
KeyMap.keys Object
object))

{-# INLINE oneOfFields #-}
oneOfFields :: [Text] -> Value a -> Object a
oneOfFields :: forall a. [Text] -> Value a -> Object a
oneOfFields [Text]
keys Value a
valueParser = forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Text -> Value a -> Object a
field Value a
valueParser) [Text]
keys)

{-# INLINE fieldMap #-}
fieldMap :: (Hashable a) => String a -> Value b -> Object (HashMap a b)
fieldMap :: forall a b.
Hashable a =>
String a -> Value b -> Object (HashMap a b)
fieldMap String a
keyParser Value b
fieldParser = forall a.
ReaderT Object (ExceptT Error (Except Error)) a -> Object a
Object forall a b. (a -> b) -> a -> b
$ forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Key, Value) -> ExceptT Error (Except Error) (a, b)
mapping forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall v. KeyMap v -> [(Key, v)]
KeyMap.toList
  where
    mapping :: (Key, Value) -> ExceptT Error (Except Error) (a, b)
mapping (Key
key, Value
ast) =
      case Key -> Text
Key.toText Key
key of
        Text
keyText -> case forall a. String a -> Text -> Either (Maybe Text) a
runString String a
keyParser Text
keyText of
          Right a
parsedKey -> case forall a. Value a -> Value -> Either Error a
run Value b
fieldParser Value
ast of
            Right b
parsedField -> forall (m :: * -> *) a. Monad m => a -> m a
return (a
parsedKey, b
parsedField)
            Left Error
error -> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (Text -> Error -> Error
Error.named Text
keyText Error
error))
          Left Maybe Text
error -> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty Text -> Error
Error.message Maybe Text
error))

{-# INLINE foldlFields #-}
foldlFields :: (state -> key -> field -> state) -> state -> String key -> Value field -> Object state
foldlFields :: forall state key field.
(state -> key -> field -> state)
-> state -> String key -> Value field -> Object state
foldlFields state -> key -> field -> state
step state
state String key
keyParser Value field
fieldParser = forall a.
ReaderT Object (ExceptT Error (Except Error)) a -> Object a
Object forall a b. (a -> b) -> a -> b
$
  forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \Object
object ->
    forall v a. (Key -> v -> a -> a) -> a -> KeyMap v -> a
KeyMap.foldrWithKey Key
-> Value
-> (state -> ExceptT Error (Except Error) state)
-> state
-> ExceptT Error (Except Error) state
newStep forall (f :: * -> *) a. Applicative f => a -> f a
pure Object
object state
state
  where
    newStep :: Key
-> Value
-> (state -> ExceptT Error (Except Error) state)
-> state
-> ExceptT Error (Except Error) state
newStep Key
key Value
value state -> ExceptT Error (Except Error) state
next !state
state =
      case Key -> Text
Key.toText Key
key of
        Text
key -> case forall a. String a -> Text -> Either (Maybe Text) a
runString String key
keyParser Text
key of
          Right key
parsedKey -> case forall a. Value a -> Value -> Either Error a
run Value field
fieldParser Value
value of
            Right field
parsedValue -> state -> ExceptT Error (Except Error) state
next (state -> key -> field -> state
step state
state key
parsedKey field
parsedValue)
            Left Error
error -> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE forall a b. (a -> b) -> a -> b
$ Text -> Error -> Error
Error.named Text
key Error
error
          Left Maybe Text
error -> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty Text -> Error
Error.message Maybe Text
error))

fieldsAmount :: Object Int
fieldsAmount :: Object Int
fieldsAmount = forall a.
ReaderT Object (ExceptT Error (Except Error)) a -> Object a
Object forall a b. (a -> b) -> a -> b
$ forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall v. KeyMap v -> Int
KeyMap.size

-- * Array parsers

-- |
-- JSON `Aeson.Array` parser.
newtype Array a
  = Array (ReaderT (Vector Aeson.Value) (ExceptT Error.Error (Except Error.Error)) a)
  deriving (forall a b. a -> Array b -> Array a
forall a b. (a -> b) -> Array a -> Array b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Array b -> Array a
$c<$ :: forall a b. a -> Array b -> Array a
fmap :: forall a b. (a -> b) -> Array a -> Array b
$cfmap :: forall a b. (a -> b) -> Array a -> Array b
Functor, Functor Array
forall a. a -> Array a
forall a b. Array a -> Array b -> Array a
forall a b. Array a -> Array b -> Array b
forall a b. Array (a -> b) -> Array a -> Array b
forall a b c. (a -> b -> c) -> Array a -> Array b -> Array c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b. Array a -> Array b -> Array a
$c<* :: forall a b. Array a -> Array b -> Array a
*> :: forall a b. Array a -> Array b -> Array b
$c*> :: forall a b. Array a -> Array b -> Array b
liftA2 :: forall a b c. (a -> b -> c) -> Array a -> Array b -> Array c
$cliftA2 :: forall a b c. (a -> b -> c) -> Array a -> Array b -> Array c
<*> :: forall a b. Array (a -> b) -> Array a -> Array b
$c<*> :: forall a b. Array (a -> b) -> Array a -> Array b
pure :: forall a. a -> Array a
$cpure :: forall a. a -> Array a
Applicative, Applicative Array
forall a. Array a
forall a. Array a -> Array [a]
forall a. Array a -> Array a -> Array a
forall (f :: * -> *).
Applicative f
-> (forall a. f a)
-> (forall a. f a -> f a -> f a)
-> (forall a. f a -> f [a])
-> (forall a. f a -> f [a])
-> Alternative f
many :: forall a. Array a -> Array [a]
$cmany :: forall a. Array a -> Array [a]
some :: forall a. Array a -> Array [a]
$csome :: forall a. Array a -> Array [a]
<|> :: forall a. Array a -> Array a -> Array a
$c<|> :: forall a. Array a -> Array a -> Array a
empty :: forall a. Array a
$cempty :: forall a. Array a
Alternative, Applicative Array
forall a. a -> Array a
forall a b. Array a -> Array b -> Array b
forall a b. Array a -> (a -> Array b) -> Array b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> Array a
$creturn :: forall a. a -> Array a
>> :: forall a b. Array a -> Array b -> Array b
$c>> :: forall a b. Array a -> Array b -> Array b
>>= :: forall a b. Array a -> (a -> Array b) -> Array b
$c>>= :: forall a b. Array a -> (a -> Array b) -> Array b
Monad, Monad Array
Alternative Array
forall a. Array a
forall a. Array a -> Array a -> Array a
forall (m :: * -> *).
Alternative m
-> Monad m
-> (forall a. m a)
-> (forall a. m a -> m a -> m a)
-> MonadPlus m
mplus :: forall a. Array a -> Array a -> Array a
$cmplus :: forall a. Array a -> Array a -> Array a
mzero :: forall a. Array a
$cmzero :: forall a. Array a
MonadPlus, MonadError Error.Error)

instance MonadFail Array where
  fail :: forall a. String -> Array a
fail = forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. IsString a => String -> a
fromString

{-# INLINE element #-}
element :: Int -> Value a -> Array a
element :: forall a. Int -> Value a -> Array a
element Int
index Value a
elementParser = forall a. ReaderT Array (ExceptT Error (Except Error)) a -> Array a
Array forall a b. (a -> b) -> a -> b
$
  forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \Array
array -> case Array
array forall a. Vector a -> Int -> Maybe a
Vector.!? Int
index of
    Just Value
element -> case forall a. Value a -> Value -> Either Error a
run Value a
elementParser Value
element of
      Right a
result -> forall (m :: * -> *) a. Monad m => a -> m a
return a
result
      Left Error
error -> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE forall a b. (a -> b) -> a -> b
$ Int -> Error -> Error
Error.indexed Int
index Error
error
    Maybe Value
Nothing -> forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE forall a b. (a -> b) -> a -> b
$ [Text] -> Text -> Error
Error.Error (forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. IsString a => String -> a
fromString (forall a. Show a => a -> String
show Int
index))) Text
"Array contains no element by this index"

{-# INLINE elementVector #-}
elementVector :: Value a -> Array (Vector a)
elementVector :: forall a. Value a -> Array (Vector a)
elementVector Value a
elementParser = forall a. ReaderT Array (ExceptT Error (Except Error)) a -> Array a
Array forall a b. (a -> b) -> a -> b
$
  forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \Array
arrayAst -> forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m (Vector b)
Vector.imapM Array
arrayAst forall a b. (a -> b) -> a -> b
$ \Int
index Value
ast -> case forall a. Value a -> Value -> Either Error a
run Value a
elementParser Value
ast of
    Right a
element -> forall (m :: * -> *) a. Monad m => a -> m a
return a
element
    Left Error
error -> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE forall a b. (a -> b) -> a -> b
$ Int -> Error -> Error
Error.indexed Int
index Error
error

{-# INLINE elementList #-}
elementList :: Value a -> Array [a]
elementList :: forall a. Value a -> Array [a]
elementList = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Vector a -> [a]
Vector.toList forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. Value a -> Array (Vector a)
elementVector

{-# INLINE foldlElements #-}
foldlElements :: (state -> Int -> element -> state) -> state -> Value element -> Array state
foldlElements :: forall state element.
(state -> Int -> element -> state)
-> state -> Value element -> Array state
foldlElements state -> Int -> element -> state
step state
state Value element
elementParser = forall a. ReaderT Array (ExceptT Error (Except Error)) a -> Array a
Array forall a b. (a -> b) -> a -> b
$ forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a b.
Monad m =>
(a -> Int -> b -> m a) -> a -> Vector b -> m a
Vector.ifoldM' state -> Int -> Value -> ExceptT Error (Except Error) state
newStep state
state
  where
    newStep :: state -> Int -> Value -> ExceptT Error (Except Error) state
newStep state
state Int
index Value
ast = case forall a. Value a -> Value -> Either Error a
run Value element
elementParser Value
ast of
      Right element
element -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ state -> Int -> element -> state
step state
state Int
index element
element
      Left Error
error -> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE forall a b. (a -> b) -> a -> b
$ Int -> Error -> Error
Error.indexed Int
index Error
error

{-# INLINE foldrElements #-}
foldrElements :: (Int -> element -> state -> state) -> state -> Value element -> Array state
foldrElements :: forall element state.
(Int -> element -> state -> state)
-> state -> Value element -> Array state
foldrElements Int -> element -> state -> state
step state
state Value element
elementParser = forall a. ReaderT Array (ExceptT Error (Except Error)) a -> Array a
Array forall a b. (a -> b) -> a -> b
$ forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ forall (v :: * -> *) a (m :: * -> *) b.
(Vector v a, Monad m) =>
(Int -> a -> b -> m b) -> b -> v a -> m b
Vector.ifoldrM Int -> Value -> state -> ExceptT Error (Except Error) state
newStep state
state
  where
    newStep :: Int -> Value -> state -> ExceptT Error (Except Error) state
newStep Int
index Value
ast state
nextState = case forall a. Value a -> Value -> Either Error a
run Value element
elementParser Value
ast of
      Right element
element -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Int -> element -> state -> state
step Int
index element
element state
nextState
      Left Error
error -> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE forall a b. (a -> b) -> a -> b
$ Int -> Error -> Error
Error.indexed Int
index Error
error

elementsAmount :: Array Int
elementsAmount :: Array Int
elementsAmount = forall a. ReaderT Array (ExceptT Error (Except Error)) a -> Array a
Array forall a b. (a -> b) -> a -> b
$ forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. Vector a -> Int
Vector.length