{-
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,
    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,
    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.Attoparsec.Text as Attoparsec
import qualified Data.HashMap.Strict as HashMap
import qualified Data.HashSet as HashSet
import qualified Data.Scientific as Scientific
import qualified Data.Text.Encoding 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 (a -> Value b -> Value a
(a -> b) -> Value a -> Value b
(forall a b. (a -> b) -> Value a -> Value b)
-> (forall a b. a -> Value b -> Value a) -> Functor Value
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
<$ :: a -> Value b -> Value a
$c<$ :: forall a b. a -> Value b -> Value a
fmap :: (a -> b) -> Value a -> Value b
$cfmap :: forall a b. (a -> b) -> Value a -> Value b
Functor, Functor Value
a -> Value a
Functor Value
-> (forall a. a -> Value a)
-> (forall a b. Value (a -> b) -> Value a -> Value b)
-> (forall a b c. (a -> b -> c) -> Value a -> Value b -> Value c)
-> (forall a b. Value a -> Value b -> Value b)
-> (forall a b. Value a -> Value b -> Value a)
-> Applicative Value
Value a -> Value b -> Value b
Value a -> Value b -> Value a
Value (a -> b) -> Value a -> Value b
(a -> b -> c) -> Value a -> Value b -> Value c
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
<* :: Value a -> Value b -> Value a
$c<* :: forall a b. Value a -> Value b -> Value a
*> :: Value a -> Value b -> Value b
$c*> :: forall a b. Value a -> Value b -> Value b
liftA2 :: (a -> b -> c) -> Value a -> Value b -> Value c
$cliftA2 :: forall a b c. (a -> b -> c) -> Value a -> Value b -> Value c
<*> :: Value (a -> b) -> Value a -> Value b
$c<*> :: forall a b. Value (a -> b) -> Value a -> Value b
pure :: a -> Value a
$cpure :: forall a. a -> Value a
$cp1Applicative :: Functor Value
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 :: Value a
empty = ReaderT Value (MaybeT (Either Error)) a -> Value a
forall a. ReaderT Value (MaybeT (Either Error)) a -> Value a
Value (ReaderT Value (MaybeT (Either Error)) a -> Value a)
-> ReaderT Value (MaybeT (Either Error)) a -> Value a
forall a b. (a -> b) -> a -> b
$ (Value -> MaybeT (Either Error) a)
-> ReaderT Value (MaybeT (Either Error)) a
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((Value -> MaybeT (Either Error) a)
 -> ReaderT Value (MaybeT (Either Error)) a)
-> (Value -> MaybeT (Either Error) a)
-> ReaderT Value (MaybeT (Either Error)) a
forall a b. (a -> b) -> a -> b
$ MaybeT (Either Error) a -> Value -> MaybeT (Either Error) a
forall a b. a -> b -> a
const (MaybeT (Either Error) a -> Value -> MaybeT (Either Error) a)
-> MaybeT (Either Error) a -> Value -> MaybeT (Either Error) a
forall a b. (a -> b) -> a -> b
$ Either Error (Maybe a) -> MaybeT (Either Error) a
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (Either Error (Maybe a) -> MaybeT (Either Error) a)
-> Either Error (Maybe a) -> MaybeT (Either Error) a
forall a b. (a -> b) -> a -> b
$ Maybe a -> Either Error (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
  <|> :: Value a -> Value a -> Value a
(<|>) (Value ReaderT Value (MaybeT (Either Error)) a
leftParser) (Value ReaderT Value (MaybeT (Either Error)) a
rightParser) = ReaderT Value (MaybeT (Either Error)) a -> Value a
forall a. ReaderT Value (MaybeT (Either Error)) a -> Value a
Value (ReaderT Value (MaybeT (Either Error)) a
leftParser ReaderT Value (MaybeT (Either Error)) a
-> ReaderT Value (MaybeT (Either Error)) a
-> ReaderT Value (MaybeT (Either Error)) a
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 :: Value a -> Value -> Either Error a
run = \(Value ReaderT Value (MaybeT (Either Error)) a
parser) Value
value -> (Maybe a -> Either Error a)
-> Either Error (Maybe a) -> Either Error a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
(=<<) (Either Error a
-> (a -> Either Error a) -> Maybe a -> Either Error a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Error -> Either Error a
forall a b. a -> Either a b
Left (Value -> Error
forall p. IsString p => Value -> p
typeError Value
value)) a -> Either Error a
forall a b. b -> Either a b
Right) (Either Error (Maybe a) -> Either Error a)
-> Either Error (Maybe a) -> Either Error a
forall a b. (a -> b) -> a -> b
$ MaybeT (Either Error) a -> Either Error (Maybe a)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT (Either Error) a -> Either Error (Maybe a))
-> MaybeT (Either Error) a -> Either Error (Maybe a)
forall a b. (a -> b) -> a -> b
$ ReaderT Value (MaybeT (Either Error)) a
-> Value -> MaybeT (Either Error) a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT Value (MaybeT (Either Error)) a
parser Value
value
  where
    typeError :: Value -> p
typeError = \case
      Aeson.Array Array
_ -> p
"Unexpected type: array"
      Aeson.Object Object
_ -> p
"Unexpected type: object"
      Aeson.String Text
_ -> p
"Unexpected type: string"
      Aeson.Number Scientific
_ -> p
"Unexpected type: number"
      Aeson.Bool Bool
_ -> p
"Unexpected type: bool"
      Value
Aeson.Null -> p
"Unexpected type: null"

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

runString :: String a -> Text -> Either (Maybe Text) a
runString :: String a -> Text -> Either (Maybe Text) a
runString (String ReaderT Text (Except (Last Text)) a
a) Text
b = (Last Text -> Maybe Text)
-> Either (Last Text) a -> Either (Maybe Text) a
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Last Text -> Maybe Text
forall a. Last a -> Maybe a
getLast (Except (Last Text) a -> Either (Last Text) a
forall e a. Except e a -> Either e a
runExcept (ReaderT Text (Except (Last Text)) a -> Text -> Except (Last Text) a
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 :: Value a -> ByteString -> Either Text a
parseByteString Value a
p ByteString
bs =
  case ByteString -> Either String Value
forall a. FromJSON a => ByteString -> Either String a
Aeson.eitherDecodeStrict' ByteString
bs of
    Right Value
aeson -> Value a -> Value -> Either Text a
forall a. Value a -> Value -> Either Text a
runWithTextError Value a
p Value
aeson
    Left String
stringErr -> Text -> Either Text a
forall a b. a -> Either a b
Left (String -> Text
forall a. IsString a => String -> a
fromString String
stringErr)

-- ** Definitions

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

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

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

{-# INLINE nullable #-}
nullable :: Value a -> Value (Maybe a)
nullable :: Value a -> Value (Maybe a)
nullable (Value ReaderT Value (MaybeT (Either Error)) a
parser) = ReaderT Value (MaybeT (Either Error)) (Maybe a) -> Value (Maybe a)
forall a. ReaderT Value (MaybeT (Either Error)) a -> Value a
Value (ReaderT Value (MaybeT (Either Error)) (Maybe a)
 -> Value (Maybe a))
-> ReaderT Value (MaybeT (Either Error)) (Maybe a)
-> Value (Maybe a)
forall a b. (a -> b) -> a -> b
$
  (Value -> MaybeT (Either Error) (Maybe a))
-> ReaderT Value (MaybeT (Either Error)) (Maybe a)
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((Value -> MaybeT (Either Error) (Maybe a))
 -> ReaderT Value (MaybeT (Either Error)) (Maybe a))
-> (Value -> MaybeT (Either Error) (Maybe a))
-> ReaderT Value (MaybeT (Either Error)) (Maybe a)
forall a b. (a -> b) -> a -> b
$ \case
    Value
Aeson.Null -> Maybe a -> MaybeT (Either Error) (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
    Value
x -> (a -> Maybe a)
-> MaybeT (Either Error) a -> MaybeT (Either Error) (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Maybe a
forall a. a -> Maybe a
Just (ReaderT Value (MaybeT (Either Error)) a
-> Value -> MaybeT (Either Error) a
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 :: Value a -> Value a
nullableMonoid (Value ReaderT Value (MaybeT (Either Error)) a
parser) = ReaderT Value (MaybeT (Either Error)) a -> Value a
forall a. ReaderT Value (MaybeT (Either Error)) a -> Value a
Value (ReaderT Value (MaybeT (Either Error)) a -> Value a)
-> ReaderT Value (MaybeT (Either Error)) a -> Value a
forall a b. (a -> b) -> a -> b
$
  (Value -> MaybeT (Either Error) a)
-> ReaderT Value (MaybeT (Either Error)) a
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((Value -> MaybeT (Either Error) a)
 -> ReaderT Value (MaybeT (Either Error)) a)
-> (Value -> MaybeT (Either Error) a)
-> ReaderT Value (MaybeT (Either Error)) a
forall a b. (a -> b) -> a -> b
$ \case
    Value
Aeson.Null -> a -> MaybeT (Either Error) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
forall a. Monoid a => a
mempty
    Value
x -> ReaderT Value (MaybeT (Either Error)) a
-> Value -> MaybeT (Either Error) a
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 :: String a -> Value a
string (String ReaderT Text (Except (Last Text)) a
parser) = ReaderT Value (MaybeT (Either Error)) a -> Value a
forall a. ReaderT Value (MaybeT (Either Error)) a -> Value a
Value (ReaderT Value (MaybeT (Either Error)) a -> Value a)
-> ReaderT Value (MaybeT (Either Error)) a -> Value a
forall a b. (a -> b) -> a -> b
$
  (Value -> MaybeT (Either Error) a)
-> ReaderT Value (MaybeT (Either Error)) a
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((Value -> MaybeT (Either Error) a)
 -> ReaderT Value (MaybeT (Either Error)) a)
-> (Value -> MaybeT (Either Error) a)
-> ReaderT Value (MaybeT (Either Error)) a
forall a b. (a -> b) -> a -> b
$ \case
    Aeson.String Text
x -> Either Error a -> MaybeT (Either Error) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Either Error a -> MaybeT (Either Error) a)
-> Either Error a -> MaybeT (Either Error) a
forall a b. (a -> b) -> a -> b
$ (Last Text -> Error) -> Either (Last Text) a -> Either Error a
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left (Text -> Error
Error.message (Text -> Error) -> (Last Text -> Text) -> Last Text -> Error
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"No details" (Maybe Text -> Text)
-> (Last Text -> Maybe Text) -> Last Text -> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Last Text -> Maybe Text
forall a. Last a -> Maybe a
getLast) (Either (Last Text) a -> Either Error a)
-> Either (Last Text) a -> Either Error a
forall a b. (a -> b) -> a -> b
$ Except (Last Text) a -> Either (Last Text) a
forall e a. Except e a -> Either e a
runExcept (Except (Last Text) a -> Either (Last Text) a)
-> Except (Last Text) a -> Either (Last Text) a
forall a b. (a -> b) -> a -> b
$ ReaderT Text (Except (Last Text)) a -> Text -> Except (Last Text) a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT Text (Except (Last Text)) a
parser Text
x
    Value
_ -> MaybeT (Either Error) a
forall (f :: * -> *) a. Alternative f => f a
empty

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

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

{-# INLINE fromJSON #-}
fromJSON :: Aeson.FromJSON a => Value a
fromJSON :: Value a
fromJSON =
  ReaderT Value (MaybeT (Either Error)) a -> Value a
forall a. ReaderT Value (MaybeT (Either Error)) a -> Value a
Value (ReaderT Value (MaybeT (Either Error)) a -> Value a)
-> ReaderT Value (MaybeT (Either Error)) a -> Value a
forall a b. (a -> b) -> a -> b
$
    (Value -> MaybeT (Either Error) a)
-> ReaderT Value (MaybeT (Either Error)) a
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((Value -> MaybeT (Either Error) a)
 -> ReaderT Value (MaybeT (Either Error)) a)
-> (Value -> MaybeT (Either Error) a)
-> ReaderT Value (MaybeT (Either Error)) a
forall a b. (a -> b) -> a -> b
$
      Value -> Result a
forall a. FromJSON a => Value -> Result a
Aeson.fromJSON (Value -> Result a)
-> (Result a -> MaybeT (Either Error) a)
-> Value
-> MaybeT (Either Error) a
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 -> a -> MaybeT (Either Error) a
forall (m :: * -> *) a. Monad m => a -> m a
return a
r
        Aeson.Error String
m -> Either Error a -> MaybeT (Either Error) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Either Error a -> MaybeT (Either Error) a)
-> Either Error a -> MaybeT (Either Error) a
forall a b. (a -> b) -> a -> b
$ Error -> Either Error a
forall a b. a -> Either a b
Left (Error -> Either Error a) -> Error -> Either Error a
forall a b. (a -> b) -> a -> b
$ String -> Error
forall a. IsString a => String -> a
fromString String
m

-- * String parsers

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

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

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

{-# INLINE narrowedText #-}
narrowedText :: (Text -> Maybe a) -> String a
narrowedText :: (Text -> Maybe a) -> String a
narrowedText Text -> Maybe a
narrow = (Text -> Either Text a) -> String a
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 -> a -> Either Text a
forall a b. b -> Either a b
Right a
a
      Maybe a
_ -> Text -> Either Text a
forall a b. a -> Either a b
Left (Text
"Unexpected value: \"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
text Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\"")

{-# INLINE matchedText #-}
matchedText :: (Text -> Either Text a) -> String a
matchedText :: (Text -> Either Text a) -> String a
matchedText Text -> Either Text a
parser = ReaderT Text (Except (Last Text)) a -> String a
forall a. ReaderT Text (Except (Last Text)) a -> String a
String (ReaderT Text (Except (Last Text)) a -> String a)
-> ReaderT Text (Except (Last Text)) a -> String a
forall a b. (a -> b) -> a -> b
$ (Text -> Except (Last Text) a)
-> ReaderT Text (Except (Last Text)) a
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((Text -> Except (Last Text) a)
 -> ReaderT Text (Except (Last Text)) a)
-> (Text -> Except (Last Text) a)
-> ReaderT Text (Except (Last Text)) a
forall a b. (a -> b) -> a -> b
$ Either (Last Text) a -> Except (Last Text) a
forall (m :: * -> *) e a. Monad m => Either e a -> ExceptT e m a
except (Either (Last Text) a -> Except (Last Text) a)
-> (Text -> Either (Last Text) a) -> Text -> Except (Last Text) a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Text -> Last Text) -> Either Text a -> Either (Last Text) a
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left (Maybe Text -> Last Text
forall a. Maybe a -> Last a
Last (Maybe Text -> Last Text)
-> (Text -> Maybe Text) -> Text -> Last Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text -> Maybe Text
forall a. a -> Maybe a
Just) (Either Text a -> Either (Last Text) a)
-> (Text -> Either Text a) -> Text -> Either (Last Text) a
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 :: Parser a -> String a
attoparsedText Parser a
parser = (Text -> Either Text a) -> String a
forall a. (Text -> Either Text a) -> String a
matchedText ((Text -> Either Text a) -> String a)
-> (Text -> Either Text a) -> String a
forall a b. (a -> b) -> a -> b
$ (String -> Text) -> Either String a -> Either Text a
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left String -> Text
forall a. IsString a => String -> a
fromString (Either String a -> Either Text a)
-> (Text -> Either String a) -> Text -> Either Text a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Parser a -> Text -> Either String a
forall a. Parser a -> Text -> Either String a
Attoparsec.parseOnly Parser a
parser

{-# INLINE megaparsedText #-}
megaparsedText :: Megaparsec.Parsec Void Text a -> String a
megaparsedText :: Parsec Void Text a -> String a
megaparsedText = (Text -> Either Text a) -> String a
forall a. (Text -> Either Text a) -> String a
matchedText ((Text -> Either Text a) -> String a)
-> (Parsec Void Text a -> Text -> Either Text a)
-> Parsec Void Text a
-> String a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Parsec Void Text a -> Text -> Either Text a
forall a. Parsec Void Text a -> Text -> Either Text a
matcher
  where
    matcher :: Megaparsec.Parsec Void Text a -> Text -> Either Text a
    matcher :: Parsec Void Text a -> Text -> Either Text a
matcher Parsec Void Text a
p = (ParseErrorBundle Text Void -> Text)
-> Either (ParseErrorBundle Text Void) a -> Either Text a
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left (String -> Text
forall a. IsString a => String -> a
fromString (String -> Text)
-> (ParseErrorBundle Text Void -> String)
-> ParseErrorBundle Text Void
-> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ParseErrorBundle Text Void -> String
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
Megaparsec.errorBundlePretty) (Either (ParseErrorBundle Text Void) a -> Either Text a)
-> (Text -> Either (ParseErrorBundle Text Void) a)
-> Text
-> Either Text a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Parsec Void Text a
-> String -> Text -> Either (ParseErrorBundle Text Void) a
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
Megaparsec.runParser (Parsec Void Text a
p Parsec Void Text a
-> ParsecT Void Text Identity () -> Parsec Void Text a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
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 (a -> Number b -> Number a
(a -> b) -> Number a -> Number b
(forall a b. (a -> b) -> Number a -> Number b)
-> (forall a b. a -> Number b -> Number a) -> Functor Number
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
<$ :: a -> Number b -> Number a
$c<$ :: forall a b. a -> Number b -> Number a
fmap :: (a -> b) -> Number a -> Number b
$cfmap :: forall a b. (a -> b) -> Number a -> Number b
Functor, Functor Number
a -> Number a
Functor Number
-> (forall a. a -> Number a)
-> (forall a b. Number (a -> b) -> Number a -> Number b)
-> (forall a b c.
    (a -> b -> c) -> Number a -> Number b -> Number c)
-> (forall a b. Number a -> Number b -> Number b)
-> (forall a b. Number a -> Number b -> Number a)
-> Applicative Number
Number a -> Number b -> Number b
Number a -> Number b -> Number a
Number (a -> b) -> Number a -> Number b
(a -> b -> c) -> Number a -> Number b -> Number c
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
<* :: Number a -> Number b -> Number a
$c<* :: forall a b. Number a -> Number b -> Number a
*> :: Number a -> Number b -> Number b
$c*> :: forall a b. Number a -> Number b -> Number b
liftA2 :: (a -> b -> c) -> Number a -> Number b -> Number c
$cliftA2 :: forall a b c. (a -> b -> c) -> Number a -> Number b -> Number c
<*> :: Number (a -> b) -> Number a -> Number b
$c<*> :: forall a b. Number (a -> b) -> Number a -> Number b
pure :: a -> Number a
$cpure :: forall a. a -> Number a
$cp1Applicative :: Functor Number
Applicative, Applicative Number
Number a
Applicative Number
-> (forall a. Number a)
-> (forall a. Number a -> Number a -> Number a)
-> (forall a. Number a -> Number [a])
-> (forall a. Number a -> Number [a])
-> Alternative Number
Number a -> Number a -> Number a
Number a -> Number [a]
Number a -> Number [a]
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 :: Number a -> Number [a]
$cmany :: forall a. Number a -> Number [a]
some :: Number a -> Number [a]
$csome :: forall a. Number a -> Number [a]
<|> :: Number a -> Number a -> Number a
$c<|> :: forall a. Number a -> Number a -> Number a
empty :: Number a
$cempty :: forall a. Number a
$cp1Alternative :: Applicative Number
Alternative)

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

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

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

{-# INLINE matchedScientific #-}
matchedScientific :: (Scientific -> Either Text a) -> Number a
matchedScientific :: (Scientific -> Either Text a) -> Number a
matchedScientific Scientific -> Either Text a
matcher = ReaderT Scientific (Except (Last Text)) a -> Number a
forall a. ReaderT Scientific (Except (Last Text)) a -> Number a
Number (ReaderT Scientific (Except (Last Text)) a -> Number a)
-> ReaderT Scientific (Except (Last Text)) a -> Number a
forall a b. (a -> b) -> a -> b
$ (Scientific -> Except (Last Text) a)
-> ReaderT Scientific (Except (Last Text)) a
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((Scientific -> Except (Last Text) a)
 -> ReaderT Scientific (Except (Last Text)) a)
-> (Scientific -> Except (Last Text) a)
-> ReaderT Scientific (Except (Last Text)) a
forall a b. (a -> b) -> a -> b
$ Either (Last Text) a -> Except (Last Text) a
forall (m :: * -> *) e a. Monad m => Either e a -> ExceptT e m a
except (Either (Last Text) a -> Except (Last Text) a)
-> (Scientific -> Either (Last Text) a)
-> Scientific
-> Except (Last Text) a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Text -> Last Text) -> Either Text a -> Either (Last Text) a
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left (Maybe Text -> Last Text
forall a. Maybe a -> Last a
Last (Maybe Text -> Last Text)
-> (Text -> Maybe Text) -> Text -> Last Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text -> Maybe Text
forall a. a -> Maybe a
Just) (Either Text a -> Either (Last Text) a)
-> (Scientific -> Either Text a)
-> Scientific
-> Either (Last Text) a
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 :: (integer -> Either Text a) -> Number a
matchedInteger integer -> Either Text a
matcher = ReaderT Scientific (Except (Last Text)) a -> Number a
forall a. ReaderT Scientific (Except (Last Text)) a -> Number a
Number (ReaderT Scientific (Except (Last Text)) a -> Number a)
-> ReaderT Scientific (Except (Last Text)) a -> Number a
forall a b. (a -> b) -> a -> b
$ case Number integer
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 ReaderT Scientific (Except (Last Text)) integer
-> (integer -> ReaderT Scientific (Except (Last Text)) a)
-> ReaderT Scientific (Except (Last Text)) a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Text -> ReaderT Scientific (Except (Last Text)) a)
-> (a -> ReaderT Scientific (Except (Last Text)) a)
-> Either Text a
-> ReaderT Scientific (Except (Last Text)) a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Last Text -> ReaderT Scientific (Except (Last Text)) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Last Text -> ReaderT Scientific (Except (Last Text)) a)
-> (Text -> Last Text)
-> Text
-> ReaderT Scientific (Except (Last Text)) a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Maybe Text -> Last Text
forall a. Maybe a -> Last a
Last (Maybe Text -> Last Text)
-> (Text -> Maybe Text) -> Text -> Last Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text -> Maybe Text
forall a. a -> Maybe a
Just) a -> ReaderT Scientific (Except (Last Text)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text a -> ReaderT Scientific (Except (Last Text)) a)
-> (integer -> Either Text a)
-> integer
-> ReaderT Scientific (Except (Last Text)) a
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 :: (floating -> Either Text a) -> Number a
matchedFloating floating -> Either Text a
matcher = ReaderT Scientific (Except (Last Text)) a -> Number a
forall a. ReaderT Scientific (Except (Last Text)) a -> Number a
Number (ReaderT Scientific (Except (Last Text)) a -> Number a)
-> ReaderT Scientific (Except (Last Text)) a -> Number a
forall a b. (a -> b) -> a -> b
$ case Number floating
forall a. RealFloat a => Number a
floating of
  Number ReaderT Scientific (Except (Last Text)) floating
parser -> ReaderT Scientific (Except (Last Text)) floating
parser ReaderT Scientific (Except (Last Text)) floating
-> (floating -> ReaderT Scientific (Except (Last Text)) a)
-> ReaderT Scientific (Except (Last Text)) a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Text -> ReaderT Scientific (Except (Last Text)) a)
-> (a -> ReaderT Scientific (Except (Last Text)) a)
-> Either Text a
-> ReaderT Scientific (Except (Last Text)) a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Last Text -> ReaderT Scientific (Except (Last Text)) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Last Text -> ReaderT Scientific (Except (Last Text)) a)
-> (Text -> Last Text)
-> Text
-> ReaderT Scientific (Except (Last Text)) a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Maybe Text -> Last Text
forall a. Maybe a -> Last a
Last (Maybe Text -> Last Text)
-> (Text -> Maybe Text) -> Text -> Last Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text -> Maybe Text
forall a. a -> Maybe a
Just) a -> ReaderT Scientific (Except (Last Text)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text a -> ReaderT Scientific (Except (Last Text)) a)
-> (floating -> Either Text a)
-> floating
-> ReaderT Scientific (Except (Last Text)) a
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 (a -> Object b -> Object a
(a -> b) -> Object a -> Object b
(forall a b. (a -> b) -> Object a -> Object b)
-> (forall a b. a -> Object b -> Object a) -> Functor Object
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
<$ :: a -> Object b -> Object a
$c<$ :: forall a b. a -> Object b -> Object a
fmap :: (a -> b) -> Object a -> Object b
$cfmap :: forall a b. (a -> b) -> Object a -> Object b
Functor, Functor Object
a -> Object a
Functor Object
-> (forall a. a -> Object a)
-> (forall a b. Object (a -> b) -> Object a -> Object b)
-> (forall a b c.
    (a -> b -> c) -> Object a -> Object b -> Object c)
-> (forall a b. Object a -> Object b -> Object b)
-> (forall a b. Object a -> Object b -> Object a)
-> Applicative Object
Object a -> Object b -> Object b
Object a -> Object b -> Object a
Object (a -> b) -> Object a -> Object b
(a -> b -> c) -> Object a -> Object b -> Object c
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
<* :: Object a -> Object b -> Object a
$c<* :: forall a b. Object a -> Object b -> Object a
*> :: Object a -> Object b -> Object b
$c*> :: forall a b. Object a -> Object b -> Object b
liftA2 :: (a -> b -> c) -> Object a -> Object b -> Object c
$cliftA2 :: forall a b c. (a -> b -> c) -> Object a -> Object b -> Object c
<*> :: Object (a -> b) -> Object a -> Object b
$c<*> :: forall a b. Object (a -> b) -> Object a -> Object b
pure :: a -> Object a
$cpure :: forall a. a -> Object a
$cp1Applicative :: Functor Object
Applicative, Applicative Object
Object a
Applicative Object
-> (forall a. Object a)
-> (forall a. Object a -> Object a -> Object a)
-> (forall a. Object a -> Object [a])
-> (forall a. Object a -> Object [a])
-> Alternative Object
Object a -> Object a -> Object a
Object a -> Object [a]
Object a -> Object [a]
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 :: Object a -> Object [a]
$cmany :: forall a. Object a -> Object [a]
some :: Object a -> Object [a]
$csome :: forall a. Object a -> Object [a]
<|> :: Object a -> Object a -> Object a
$c<|> :: forall a. Object a -> Object a -> Object a
empty :: Object a
$cempty :: forall a. Object a
$cp1Alternative :: Applicative Object
Alternative, Applicative Object
a -> Object a
Applicative Object
-> (forall a b. Object a -> (a -> Object b) -> Object b)
-> (forall a b. Object a -> Object b -> Object b)
-> (forall a. a -> Object a)
-> Monad Object
Object a -> (a -> Object b) -> Object b
Object a -> Object b -> Object b
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 :: a -> Object a
$creturn :: forall a. a -> Object a
>> :: Object a -> Object b -> Object b
$c>> :: forall a b. Object a -> Object b -> Object b
>>= :: Object a -> (a -> Object b) -> Object b
$c>>= :: forall a b. Object a -> (a -> Object b) -> Object b
$cp1Monad :: Applicative Object
Monad, Monad Object
Alternative Object
Object a
Alternative Object
-> Monad Object
-> (forall a. Object a)
-> (forall a. Object a -> Object a -> Object a)
-> MonadPlus Object
Object a -> Object a -> Object a
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 :: Object a -> Object a -> Object a
$cmplus :: forall a. Object a -> Object a -> Object a
mzero :: Object a
$cmzero :: forall a. Object a
$cp2MonadPlus :: Monad Object
$cp1MonadPlus :: Alternative Object
MonadPlus, MonadError Error.Error)

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

{-# INLINE field #-}
field :: Text -> Value a -> Object a
field :: Text -> Value a -> Object a
field Text
name Value a
fieldParser = ReaderT Object (ExceptT Error (Except Error)) a -> Object a
forall a.
ReaderT Object (ExceptT Error (Except Error)) a -> Object a
Object (ReaderT Object (ExceptT Error (Except Error)) a -> Object a)
-> ReaderT Object (ExceptT Error (Except Error)) a -> Object a
forall a b. (a -> b) -> a -> b
$
  (Object -> ExceptT Error (Except Error) a)
-> ReaderT Object (ExceptT Error (Except Error)) a
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((Object -> ExceptT Error (Except Error) a)
 -> ReaderT Object (ExceptT Error (Except Error)) a)
-> (Object -> ExceptT Error (Except Error) a)
-> ReaderT Object (ExceptT Error (Except Error)) a
forall a b. (a -> b) -> a -> b
$ \Object
object -> case Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
KeyMap.lookup (Text -> Key
Key.fromText Text
name) Object
object of
    Just Value
value -> case Value a -> Value -> Either Error a
forall a. Value a -> Value -> Either Error a
run Value a
fieldParser Value
value of
      Right a
parsedValue -> a -> ExceptT Error (Except Error) a
forall (m :: * -> *) a. Monad m => a -> m a
return a
parsedValue
      Left Error
error -> ExceptT Error Identity a -> ExceptT Error (Except Error) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT Error Identity a -> ExceptT Error (Except Error) a)
-> ExceptT Error Identity a -> ExceptT Error (Except Error) a
forall a b. (a -> b) -> a -> b
$ Error -> ExceptT Error Identity a
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (Error -> ExceptT Error Identity a)
-> Error -> ExceptT Error Identity a
forall a b. (a -> b) -> a -> b
$ Text -> Error -> Error
Error.named Text
name Error
error
    Maybe Value
Nothing -> Error -> ExceptT Error (Except Error) a
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE ([Text] -> Text -> Error
Error.Error (Text -> [Text]
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: "
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a. IsString a => String -> a
fromString ([Key] -> String
forall a. Show a => a -> String
show (Object -> [Key]
forall v. KeyMap v -> [Key]
KeyMap.keys Object
object))

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

{-# INLINE fieldMap #-}
fieldMap :: (Eq a, Hashable a) => String a -> Value b -> Object (HashMap a b)
fieldMap :: String a -> Value b -> Object (HashMap a b)
fieldMap String a
keyParser Value b
fieldParser = ReaderT Object (ExceptT Error (Except Error)) (HashMap a b)
-> Object (HashMap a b)
forall a.
ReaderT Object (ExceptT Error (Except Error)) a -> Object a
Object (ReaderT Object (ExceptT Error (Except Error)) (HashMap a b)
 -> Object (HashMap a b))
-> ReaderT Object (ExceptT Error (Except Error)) (HashMap a b)
-> Object (HashMap a b)
forall a b. (a -> b) -> a -> b
$ (Object -> ExceptT Error (Except Error) (HashMap a b))
-> ReaderT Object (ExceptT Error (Except Error)) (HashMap a b)
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((Object -> ExceptT Error (Except Error) (HashMap a b))
 -> ReaderT Object (ExceptT Error (Except Error)) (HashMap a b))
-> (Object -> ExceptT Error (Except Error) (HashMap a b))
-> ReaderT Object (ExceptT Error (Except Error)) (HashMap a b)
forall a b. (a -> b) -> a -> b
$ ([(a, b)] -> HashMap a b)
-> ExceptT Error (Except Error) [(a, b)]
-> ExceptT Error (Except Error) (HashMap a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(a, b)] -> HashMap a b
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList (ExceptT Error (Except Error) [(a, b)]
 -> ExceptT Error (Except Error) (HashMap a b))
-> (Object -> ExceptT Error (Except Error) [(a, b)])
-> Object
-> ExceptT Error (Except Error) (HashMap a b)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ((Key, Value) -> ExceptT Error (Except Error) (a, b))
-> [(Key, Value)] -> ExceptT Error (Except Error) [(a, b)]
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 ([(Key, Value)] -> ExceptT Error (Except Error) [(a, b)])
-> (Object -> [(Key, Value)])
-> Object
-> ExceptT Error (Except Error) [(a, b)]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Object -> [(Key, Value)]
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 String a -> Text -> Either (Maybe Text) a
forall a. String a -> Text -> Either (Maybe Text) a
runString String a
keyParser Text
keyText of
          Right a
parsedKey -> case Value b -> Value -> Either Error b
forall a. Value a -> Value -> Either Error a
run Value b
fieldParser Value
ast of
            Right b
parsedField -> (a, b) -> ExceptT Error (Except Error) (a, b)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
parsedKey, b
parsedField)
            Left Error
error -> ExceptT Error Identity (a, b)
-> ExceptT Error (Except Error) (a, b)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Error -> ExceptT Error Identity (a, b)
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 -> ExceptT Error Identity (a, b)
-> ExceptT Error (Except Error) (a, b)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Error -> ExceptT Error Identity (a, b)
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (Error -> (Text -> Error) -> Maybe Text -> Error
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Error
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 :: (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 = ReaderT Object (ExceptT Error (Except Error)) state -> Object state
forall a.
ReaderT Object (ExceptT Error (Except Error)) a -> Object a
Object (ReaderT Object (ExceptT Error (Except Error)) state
 -> Object state)
-> ReaderT Object (ExceptT Error (Except Error)) state
-> Object state
forall a b. (a -> b) -> a -> b
$
  (Object -> ExceptT Error (Except Error) state)
-> ReaderT Object (ExceptT Error (Except Error)) state
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((Object -> ExceptT Error (Except Error) state)
 -> ReaderT Object (ExceptT Error (Except Error)) state)
-> (Object -> ExceptT Error (Except Error) state)
-> ReaderT Object (ExceptT Error (Except Error)) state
forall a b. (a -> b) -> a -> b
$ \Object
object ->
    (Key
 -> Value
 -> (state -> ExceptT Error (Except Error) state)
 -> state
 -> ExceptT Error (Except Error) state)
-> (state -> ExceptT Error (Except Error) state)
-> Object
-> state
-> ExceptT Error (Except Error) state
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 state -> ExceptT Error (Except Error) state
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 String key -> Text -> Either (Maybe Text) key
forall a. String a -> Text -> Either (Maybe Text) a
runString String key
keyParser Text
key of
          Right key
parsedKey -> case Value field -> Value -> Either Error field
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 -> ExceptT Error Identity state -> ExceptT Error (Except Error) state
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT Error Identity state
 -> ExceptT Error (Except Error) state)
-> ExceptT Error Identity state
-> ExceptT Error (Except Error) state
forall a b. (a -> b) -> a -> b
$ Error -> ExceptT Error Identity state
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (Error -> ExceptT Error Identity state)
-> Error -> ExceptT Error Identity state
forall a b. (a -> b) -> a -> b
$ Text -> Error -> Error
Error.named Text
key Error
error
          Left Maybe Text
error -> ExceptT Error Identity state -> ExceptT Error (Except Error) state
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Error -> ExceptT Error Identity state
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (Error -> (Text -> Error) -> Maybe Text -> Error
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Error
forall a. Monoid a => a
mempty Text -> Error
Error.message Maybe Text
error))

fieldsAmount :: Object Int
fieldsAmount :: Object Int
fieldsAmount = ReaderT Object (ExceptT Error (Except Error)) Int -> Object Int
forall a.
ReaderT Object (ExceptT Error (Except Error)) a -> Object a
Object (ReaderT Object (ExceptT Error (Except Error)) Int -> Object Int)
-> ReaderT Object (ExceptT Error (Except Error)) Int -> Object Int
forall a b. (a -> b) -> a -> b
$ (Object -> ExceptT Error (Except Error) Int)
-> ReaderT Object (ExceptT Error (Except Error)) Int
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((Object -> ExceptT Error (Except Error) Int)
 -> ReaderT Object (ExceptT Error (Except Error)) Int)
-> (Object -> ExceptT Error (Except Error) Int)
-> ReaderT Object (ExceptT Error (Except Error)) Int
forall a b. (a -> b) -> a -> b
$ Int -> ExceptT Error (Except Error) Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> ExceptT Error (Except Error) Int)
-> (Object -> Int) -> Object -> ExceptT Error (Except Error) Int
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Object -> Int
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 (a -> Array b -> Array a
(a -> b) -> Array a -> Array b
(forall a b. (a -> b) -> Array a -> Array b)
-> (forall a b. a -> Array b -> Array a) -> Functor Array
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
<$ :: a -> Array b -> Array a
$c<$ :: forall a b. a -> Array b -> Array a
fmap :: (a -> b) -> Array a -> Array b
$cfmap :: forall a b. (a -> b) -> Array a -> Array b
Functor, Functor Array
a -> Array a
Functor Array
-> (forall a. a -> Array a)
-> (forall a b. Array (a -> b) -> Array a -> Array b)
-> (forall a b c. (a -> b -> c) -> Array a -> Array b -> Array c)
-> (forall a b. Array a -> Array b -> Array b)
-> (forall a b. Array a -> Array b -> Array a)
-> Applicative Array
Array a -> Array b -> Array b
Array a -> Array b -> Array a
Array (a -> b) -> Array a -> Array b
(a -> b -> c) -> Array a -> Array b -> Array c
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
<* :: Array a -> Array b -> Array a
$c<* :: forall a b. Array a -> Array b -> Array a
*> :: Array a -> Array b -> Array b
$c*> :: forall a b. Array a -> Array b -> Array b
liftA2 :: (a -> b -> c) -> Array a -> Array b -> Array c
$cliftA2 :: forall a b c. (a -> b -> c) -> Array a -> Array b -> Array c
<*> :: Array (a -> b) -> Array a -> Array b
$c<*> :: forall a b. Array (a -> b) -> Array a -> Array b
pure :: a -> Array a
$cpure :: forall a. a -> Array a
$cp1Applicative :: Functor Array
Applicative, Applicative Array
Array a
Applicative Array
-> (forall a. Array a)
-> (forall a. Array a -> Array a -> Array a)
-> (forall a. Array a -> Array [a])
-> (forall a. Array a -> Array [a])
-> Alternative Array
Array a -> Array a -> Array a
Array a -> Array [a]
Array a -> Array [a]
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 :: Array a -> Array [a]
$cmany :: forall a. Array a -> Array [a]
some :: Array a -> Array [a]
$csome :: forall a. Array a -> Array [a]
<|> :: Array a -> Array a -> Array a
$c<|> :: forall a. Array a -> Array a -> Array a
empty :: Array a
$cempty :: forall a. Array a
$cp1Alternative :: Applicative Array
Alternative, Applicative Array
a -> Array a
Applicative Array
-> (forall a b. Array a -> (a -> Array b) -> Array b)
-> (forall a b. Array a -> Array b -> Array b)
-> (forall a. a -> Array a)
-> Monad Array
Array a -> (a -> Array b) -> Array b
Array a -> Array b -> Array b
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 :: a -> Array a
$creturn :: forall a. a -> Array a
>> :: Array a -> Array b -> Array b
$c>> :: forall a b. Array a -> Array b -> Array b
>>= :: Array a -> (a -> Array b) -> Array b
$c>>= :: forall a b. Array a -> (a -> Array b) -> Array b
$cp1Monad :: Applicative Array
Monad, Monad Array
Alternative Array
Array a
Alternative Array
-> Monad Array
-> (forall a. Array a)
-> (forall a. Array a -> Array a -> Array a)
-> MonadPlus Array
Array a -> Array a -> Array a
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 :: Array a -> Array a -> Array a
$cmplus :: forall a. Array a -> Array a -> Array a
mzero :: Array a
$cmzero :: forall a. Array a
$cp2MonadPlus :: Monad Array
$cp1MonadPlus :: Alternative Array
MonadPlus, MonadError Error.Error)

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

{-# INLINE element #-}
element :: Int -> Value a -> Array a
element :: Int -> Value a -> Array a
element Int
index Value a
elementParser = ReaderT Array (ExceptT Error (Except Error)) a -> Array a
forall a. ReaderT Array (ExceptT Error (Except Error)) a -> Array a
Array (ReaderT Array (ExceptT Error (Except Error)) a -> Array a)
-> ReaderT Array (ExceptT Error (Except Error)) a -> Array a
forall a b. (a -> b) -> a -> b
$
  (Array -> ExceptT Error (Except Error) a)
-> ReaderT Array (ExceptT Error (Except Error)) a
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((Array -> ExceptT Error (Except Error) a)
 -> ReaderT Array (ExceptT Error (Except Error)) a)
-> (Array -> ExceptT Error (Except Error) a)
-> ReaderT Array (ExceptT Error (Except Error)) a
forall a b. (a -> b) -> a -> b
$ \Array
array -> case Array
array Array -> Int -> Maybe Value
forall a. Vector a -> Int -> Maybe a
Vector.!? Int
index of
    Just Value
element -> case Value a -> Value -> Either Error a
forall a. Value a -> Value -> Either Error a
run Value a
elementParser Value
element of
      Right a
result -> a -> ExceptT Error (Except Error) a
forall (m :: * -> *) a. Monad m => a -> m a
return a
result
      Left Error
error -> ExceptT Error Identity a -> ExceptT Error (Except Error) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT Error Identity a -> ExceptT Error (Except Error) a)
-> ExceptT Error Identity a -> ExceptT Error (Except Error) a
forall a b. (a -> b) -> a -> b
$ Error -> ExceptT Error Identity a
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (Error -> ExceptT Error Identity a)
-> Error -> ExceptT Error Identity a
forall a b. (a -> b) -> a -> b
$ Int -> Error -> Error
Error.indexed Int
index Error
error
    Maybe Value
Nothing -> Error -> ExceptT Error (Except Error) a
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (Error -> ExceptT Error (Except Error) a)
-> Error -> ExceptT Error (Except Error) a
forall a b. (a -> b) -> a -> b
$ [Text] -> Text -> Error
Error.Error (Text -> [Text]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Text
forall a. IsString a => String -> a
fromString (Int -> String
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 :: Value a -> Array (Vector a)
elementVector Value a
elementParser = ReaderT Array (ExceptT Error (Except Error)) (Vector a)
-> Array (Vector a)
forall a. ReaderT Array (ExceptT Error (Except Error)) a -> Array a
Array (ReaderT Array (ExceptT Error (Except Error)) (Vector a)
 -> Array (Vector a))
-> ReaderT Array (ExceptT Error (Except Error)) (Vector a)
-> Array (Vector a)
forall a b. (a -> b) -> a -> b
$
  (Array -> ExceptT Error (Except Error) (Vector a))
-> ReaderT Array (ExceptT Error (Except Error)) (Vector a)
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((Array -> ExceptT Error (Except Error) (Vector a))
 -> ReaderT Array (ExceptT Error (Except Error)) (Vector a))
-> (Array -> ExceptT Error (Except Error) (Vector a))
-> ReaderT Array (ExceptT Error (Except Error)) (Vector a)
forall a b. (a -> b) -> a -> b
$ \Array
arrayAst -> ((Int -> Value -> ExceptT Error (Except Error) a)
 -> Array -> ExceptT Error (Except Error) (Vector a))
-> Array
-> (Int -> Value -> ExceptT Error (Except Error) a)
-> ExceptT Error (Except Error) (Vector a)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Int -> Value -> ExceptT Error (Except Error) a)
-> Array -> ExceptT Error (Except Error) (Vector a)
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m (Vector b)
Vector.imapM Array
arrayAst ((Int -> Value -> ExceptT Error (Except Error) a)
 -> ExceptT Error (Except Error) (Vector a))
-> (Int -> Value -> ExceptT Error (Except Error) a)
-> ExceptT Error (Except Error) (Vector a)
forall a b. (a -> b) -> a -> b
$ \Int
index Value
ast -> case Value a -> Value -> Either Error a
forall a. Value a -> Value -> Either Error a
run Value a
elementParser Value
ast of
    Right a
element -> a -> ExceptT Error (Except Error) a
forall (m :: * -> *) a. Monad m => a -> m a
return a
element
    Left Error
error -> ExceptT Error Identity a -> ExceptT Error (Except Error) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT Error Identity a -> ExceptT Error (Except Error) a)
-> ExceptT Error Identity a -> ExceptT Error (Except Error) a
forall a b. (a -> b) -> a -> b
$ Error -> ExceptT Error Identity a
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (Error -> ExceptT Error Identity a)
-> Error -> ExceptT Error Identity a
forall a b. (a -> b) -> a -> b
$ Int -> Error -> Error
Error.indexed Int
index Error
error

{-# INLINE foldlElements #-}
foldlElements :: (state -> Int -> element -> state) -> state -> Value element -> Array state
foldlElements :: (state -> Int -> element -> state)
-> state -> Value element -> Array state
foldlElements state -> Int -> element -> state
step state
state Value element
elementParser = ReaderT Array (ExceptT Error (Except Error)) state -> Array state
forall a. ReaderT Array (ExceptT Error (Except Error)) a -> Array a
Array (ReaderT Array (ExceptT Error (Except Error)) state -> Array state)
-> ReaderT Array (ExceptT Error (Except Error)) state
-> Array state
forall a b. (a -> b) -> a -> b
$ (Array -> ExceptT Error (Except Error) state)
-> ReaderT Array (ExceptT Error (Except Error)) state
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((Array -> ExceptT Error (Except Error) state)
 -> ReaderT Array (ExceptT Error (Except Error)) state)
-> (Array -> ExceptT Error (Except Error) state)
-> ReaderT Array (ExceptT Error (Except Error)) state
forall a b. (a -> b) -> a -> b
$ (state -> Int -> Value -> ExceptT Error (Except Error) state)
-> state -> Array -> ExceptT Error (Except Error) state
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 Value element -> Value -> Either Error element
forall a. Value a -> Value -> Either Error a
run Value element
elementParser Value
ast of
      Right element
element -> state -> ExceptT Error (Except Error) state
forall (m :: * -> *) a. Monad m => a -> m a
return (state -> ExceptT Error (Except Error) state)
-> state -> ExceptT Error (Except Error) state
forall a b. (a -> b) -> a -> b
$ state -> Int -> element -> state
step state
state Int
index element
element
      Left Error
error -> ExceptT Error Identity state -> ExceptT Error (Except Error) state
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT Error Identity state
 -> ExceptT Error (Except Error) state)
-> ExceptT Error Identity state
-> ExceptT Error (Except Error) state
forall a b. (a -> b) -> a -> b
$ Error -> ExceptT Error Identity state
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (Error -> ExceptT Error Identity state)
-> Error -> ExceptT Error Identity state
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 :: (Int -> element -> state -> state)
-> state -> Value element -> Array state
foldrElements Int -> element -> state -> state
step state
state Value element
elementParser = ReaderT Array (ExceptT Error (Except Error)) state -> Array state
forall a. ReaderT Array (ExceptT Error (Except Error)) a -> Array a
Array (ReaderT Array (ExceptT Error (Except Error)) state -> Array state)
-> ReaderT Array (ExceptT Error (Except Error)) state
-> Array state
forall a b. (a -> b) -> a -> b
$ (Array -> ExceptT Error (Except Error) state)
-> ReaderT Array (ExceptT Error (Except Error)) state
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((Array -> ExceptT Error (Except Error) state)
 -> ReaderT Array (ExceptT Error (Except Error)) state)
-> (Array -> ExceptT Error (Except Error) state)
-> ReaderT Array (ExceptT Error (Except Error)) state
forall a b. (a -> b) -> a -> b
$ (Int -> Value -> state -> ExceptT Error (Except Error) state)
-> state -> Array -> ExceptT Error (Except Error) state
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 Value element -> Value -> Either Error element
forall a. Value a -> Value -> Either Error a
run Value element
elementParser Value
ast of
      Right element
element -> state -> ExceptT Error (Except Error) state
forall (m :: * -> *) a. Monad m => a -> m a
return (state -> ExceptT Error (Except Error) state)
-> state -> ExceptT Error (Except Error) state
forall a b. (a -> b) -> a -> b
$ Int -> element -> state -> state
step Int
index element
element state
nextState
      Left Error
error -> ExceptT Error Identity state -> ExceptT Error (Except Error) state
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT Error Identity state
 -> ExceptT Error (Except Error) state)
-> ExceptT Error Identity state
-> ExceptT Error (Except Error) state
forall a b. (a -> b) -> a -> b
$ Error -> ExceptT Error Identity state
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (Error -> ExceptT Error Identity state)
-> Error -> ExceptT Error Identity state
forall a b. (a -> b) -> a -> b
$ Int -> Error -> Error
Error.indexed Int
index Error
error

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