{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

{-# OPTIONS_GHC -fno-warn-orphans #-}

module Data.Exists.Aeson
  ( FromJSONForall(..)
  , FromJSONForeach(..)
  , FromJSONExists(..)
  , ToJSONForall(..)
  , ToJSONForeach(..)
  , ToJSONKeyFunctionForall(..)
  , FromJSONKeyFunctionForeach(..)
  , ToJSONKeyForall(..)
  , ToJSONKeyForeach(..)
  , FromJSONKeyExists(..)
  , FromJSONKeyForeach(..)
  , ToJSONSing(..)
  , FromJSONSing(..)
  , parseJSONMapForeachKey
  , toJSONMapForeachKey
  ) where

import Control.Applicative (Const(..))
import Data.Aeson ((<?>))
import Data.Aeson (ToJSON(..),FromJSON(..))
import Data.Aeson (ToJSONKey(..),FromJSONKey(..))
import Data.Aeson (ToJSONKeyFunction(..),FromJSONKeyFunction(..))
import Data.Aeson.Types (JSONPathElement(Key,Index))
import Data.Coerce (coerce)
import Data.Exists (Exists(..),Some(..),Sing,ApplyForeach(..),OrdForeach)
import Data.Exists (Reify(..),Unreify(..))
import Data.Functor.Compose (Compose(..))
import Data.Functor.Product (Product(..))
import Data.Kind (Type)
import Data.Map.Strict (Map)

import qualified Data.Aeson.Encoding as Aeson
import qualified Data.Aeson.Encoding.Internal as AEI
import qualified Data.Aeson.Key as Key
import qualified Data.Aeson.KeyMap as KM
import qualified Data.Aeson.Types as Aeson
import qualified Data.HashMap.Strict as HM
import qualified Data.Map.Strict as M
import qualified Data.Traversable as TRV
import qualified Data.Vector as V

data ToJSONKeyFunctionForall f
  = ToJSONKeyTextForall !(forall a. f a -> Aeson.Key) !(forall a. f a -> Aeson.Encoding' Aeson.Key)
  | ToJSONKeyValueForall !(forall a. f a -> Aeson.Value) !(forall a. f a -> Aeson.Encoding)
data FromJSONKeyFunctionForeach f
  = FromJSONKeyTextParserForeach !(forall a. Sing a -> Aeson.Key -> Aeson.Parser (f a))
  | FromJSONKeyValueForeach !(forall a. Sing a -> Aeson.Value -> Aeson.Parser (f a))

instance (ToJSONForeach f, Reify a) => ToJSON (ApplyForeach f a) where
  toJSON :: ApplyForeach f a -> Value
toJSON = Sing a -> ApplyForeach f a -> Value
forall (a :: k). Sing a -> ApplyForeach f a -> Value
forall {k} (f :: k -> *) (a :: k).
ToJSONForeach f =>
Sing a -> f a -> Value
toJSONForeach Sing a
forall {k} (a :: k). Reify a => Sing a
reify

instance (FromJSONForeach f, Reify a) => FromJSON (ApplyForeach f a) where
  parseJSON :: Value -> Parser (ApplyForeach f a)
parseJSON = Sing a -> Value -> Parser (ApplyForeach f a)
forall (a :: k). Sing a -> Value -> Parser (ApplyForeach f a)
forall {k} (f :: k -> *) (a :: k).
FromJSONForeach f =>
Sing a -> Value -> Parser (f a)
parseJSONForeach Sing a
forall {k} (a :: k). Reify a => Sing a
reify

instance ToJSONForeach f => ToJSONForeach (ApplyForeach f) where
  toJSONForeach :: forall (a :: k). Sing a -> ApplyForeach f a -> Value
toJSONForeach Sing a
s (ApplyForeach f a
x) = Sing a -> f a -> Value
forall (a :: k). Sing a -> f a -> Value
forall {k} (f :: k -> *) (a :: k).
ToJSONForeach f =>
Sing a -> f a -> Value
toJSONForeach Sing a
s f a
x

instance FromJSONForeach f => FromJSONForeach (ApplyForeach f) where
  parseJSONForeach :: forall (a :: k). Sing a -> Value -> Parser (ApplyForeach f a)
parseJSONForeach Sing a
s = (f a -> ApplyForeach f a)
-> Parser (f a) -> Parser (ApplyForeach f a)
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f a -> ApplyForeach f a
forall {k} (f :: k -> *) (a :: k). f a -> ApplyForeach f a
ApplyForeach (Parser (f a) -> Parser (ApplyForeach f a))
-> (Value -> Parser (f a)) -> Value -> Parser (ApplyForeach f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sing a -> Value -> Parser (f a)
forall (a :: k). Sing a -> Value -> Parser (f a)
forall {k} (f :: k -> *) (a :: k).
FromJSONForeach f =>
Sing a -> Value -> Parser (f a)
parseJSONForeach Sing a
s

instance ToJSONKeyForeach f => ToJSONKeyForeach (ApplyForeach f) where
  toJSONKeyForeach :: ToJSONKeyFunctionForall (Product Sing (ApplyForeach f))
toJSONKeyForeach = case ToJSONKeyFunctionForall (Product Sing f)
forall {k} (f :: k -> *).
ToJSONKeyForeach f =>
ToJSONKeyFunctionForall (Product Sing f)
toJSONKeyForeach of
    ToJSONKeyTextForall forall (a :: k). Product Sing f a -> Key
f forall (a :: k). Product Sing f a -> Encoding' Key
g -> (forall (a :: k). Product Sing (ApplyForeach f) a -> Key)
-> (forall (a :: k).
    Product Sing (ApplyForeach f) a -> Encoding' Key)
-> ToJSONKeyFunctionForall (Product Sing (ApplyForeach f))
forall {k} (f :: k -> *).
(forall (a :: k). f a -> Key)
-> (forall (a :: k). f a -> Encoding' Key)
-> ToJSONKeyFunctionForall f
ToJSONKeyTextForall
      (\(Pair Sing a
s (ApplyForeach f a
x)) -> Product Sing f a -> Key
forall (a :: k). Product Sing f a -> Key
f (Sing a -> f a -> Product Sing f a
forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
Pair Sing a
s f a
x))
      (\(Pair Sing a
s (ApplyForeach f a
x)) -> Product Sing f a -> Encoding' Key
forall (a :: k). Product Sing f a -> Encoding' Key
g (Sing a -> f a -> Product Sing f a
forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
Pair Sing a
s f a
x))
    ToJSONKeyValueForall forall (a :: k). Product Sing f a -> Value
f forall (a :: k). Product Sing f a -> Encoding
g -> (forall (a :: k). Product Sing (ApplyForeach f) a -> Value)
-> (forall (a :: k). Product Sing (ApplyForeach f) a -> Encoding)
-> ToJSONKeyFunctionForall (Product Sing (ApplyForeach f))
forall {k} (f :: k -> *).
(forall (a :: k). f a -> Value)
-> (forall (a :: k). f a -> Encoding) -> ToJSONKeyFunctionForall f
ToJSONKeyValueForall
      (\(Pair Sing a
s (ApplyForeach f a
x)) -> Product Sing f a -> Value
forall (a :: k). Product Sing f a -> Value
f (Sing a -> f a -> Product Sing f a
forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
Pair Sing a
s f a
x))
      (\(Pair Sing a
s (ApplyForeach f a
x)) -> Product Sing f a -> Encoding
forall (a :: k). Product Sing f a -> Encoding
g (Sing a -> f a -> Product Sing f a
forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
Pair Sing a
s f a
x))

instance FromJSONKeyForeach f => FromJSONKeyForeach (ApplyForeach f) where
  fromJSONKeyForeach :: FromJSONKeyFunctionForeach (ApplyForeach f)
fromJSONKeyForeach = case FromJSONKeyFunctionForeach f
forall {k} (f :: k -> *).
FromJSONKeyForeach f =>
FromJSONKeyFunctionForeach f
fromJSONKeyForeach of
    FromJSONKeyTextParserForeach forall (a :: k). Sing a -> Key -> Parser (f a)
f -> (forall (a :: k). Sing a -> Key -> Parser (ApplyForeach f a))
-> FromJSONKeyFunctionForeach (ApplyForeach f)
forall {k} (f :: k -> *).
(forall (a :: k). Sing a -> Key -> Parser (f a))
-> FromJSONKeyFunctionForeach f
FromJSONKeyTextParserForeach (\Sing a
s Key
t -> (f a -> ApplyForeach f a)
-> Parser (f a) -> Parser (ApplyForeach f a)
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f a -> ApplyForeach f a
forall {k} (f :: k -> *) (a :: k). f a -> ApplyForeach f a
ApplyForeach (Sing a -> Key -> Parser (f a)
forall (a :: k). Sing a -> Key -> Parser (f a)
f Sing a
s Key
t))
    FromJSONKeyValueForeach forall (a :: k). Sing a -> Value -> Parser (f a)
f -> (forall (a :: k). Sing a -> Value -> Parser (ApplyForeach f a))
-> FromJSONKeyFunctionForeach (ApplyForeach f)
forall {k} (f :: k -> *).
(forall (a :: k). Sing a -> Value -> Parser (f a))
-> FromJSONKeyFunctionForeach f
FromJSONKeyValueForeach (\Sing a
s Value
t -> (f a -> ApplyForeach f a)
-> Parser (f a) -> Parser (ApplyForeach f a)
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f a -> ApplyForeach f a
forall {k} (f :: k -> *) (a :: k). f a -> ApplyForeach f a
ApplyForeach (Sing a -> Value -> Parser (f a)
forall (a :: k). Sing a -> Value -> Parser (f a)
f Sing a
s Value
t))

instance (ToJSONKeyForeach f, Reify a) => ToJSONKey (ApplyForeach f a) where
  toJSONKey :: ToJSONKeyFunction (ApplyForeach f a)
toJSONKey = case ToJSONKeyFunctionForall (Product Sing f)
forall {k} (f :: k -> *).
ToJSONKeyForeach f =>
ToJSONKeyFunctionForall (Product Sing f)
toJSONKeyForeach of
    ToJSONKeyTextForall forall (a :: k). Product Sing f a -> Key
toText forall (a :: k). Product Sing f a -> Encoding' Key
toEnc -> (ApplyForeach f a -> Key)
-> (ApplyForeach f a -> Encoding' Key)
-> ToJSONKeyFunction (ApplyForeach f a)
forall a. (a -> Key) -> (a -> Encoding' Key) -> ToJSONKeyFunction a
ToJSONKeyText
      (\(ApplyForeach f a
x) -> Product Sing f a -> Key
forall (a :: k). Product Sing f a -> Key
toText (Sing a -> f a -> Product Sing f a
forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
Pair Sing a
forall {k} (a :: k). Reify a => Sing a
reify f a
x))
      (\(ApplyForeach f a
x) -> Product Sing f a -> Encoding' Key
forall (a :: k). Product Sing f a -> Encoding' Key
toEnc (Sing a -> f a -> Product Sing f a
forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
Pair Sing a
forall {k} (a :: k). Reify a => Sing a
reify f a
x))
    ToJSONKeyValueForall forall (a :: k). Product Sing f a -> Value
toValue forall (a :: k). Product Sing f a -> Encoding
toEnc -> (ApplyForeach f a -> Value)
-> (ApplyForeach f a -> Encoding)
-> ToJSONKeyFunction (ApplyForeach f a)
forall a. (a -> Value) -> (a -> Encoding) -> ToJSONKeyFunction a
ToJSONKeyValue
      (\(ApplyForeach f a
x) -> Product Sing f a -> Value
forall (a :: k). Product Sing f a -> Value
toValue (Sing a -> f a -> Product Sing f a
forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
Pair Sing a
forall {k} (a :: k). Reify a => Sing a
reify f a
x))
      (\(ApplyForeach f a
x) -> Product Sing f a -> Encoding
forall (a :: k). Product Sing f a -> Encoding
toEnc (Sing a -> f a -> Product Sing f a
forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
Pair Sing a
forall {k} (a :: k). Reify a => Sing a
reify f a
x))
  toJSONKeyList :: ToJSONKeyFunction [ApplyForeach f a]
toJSONKeyList = case ToJSONKeyFunctionForall (Product Sing f)
forall {k} (f :: k -> *).
ToJSONKeyForeach f =>
ToJSONKeyFunctionForall (Product Sing f)
toJSONKeyForeach of
    ToJSONKeyTextForall forall (a :: k). Product Sing f a -> Key
toText forall (a :: k). Product Sing f a -> Encoding' Key
toEnc -> ([ApplyForeach f a] -> Value)
-> ([ApplyForeach f a] -> Encoding)
-> ToJSONKeyFunction [ApplyForeach f a]
forall a. (a -> Value) -> (a -> Encoding) -> ToJSONKeyFunction a
ToJSONKeyValue
      (\[ApplyForeach f a]
xs -> [Key] -> Value
forall a. ToJSON a => a -> Value
toJSON ([Key] -> Value) -> [Key] -> Value
forall a b. (a -> b) -> a -> b
$ (ApplyForeach f a -> Key) -> [ApplyForeach f a] -> [Key]
forall a b. (a -> b) -> [a] -> [b]
map (\(ApplyForeach f a
x) -> Product Sing f a -> Key
forall (a :: k). Product Sing f a -> Key
toText (Sing a -> f a -> Product Sing f a
forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
Pair Sing a
forall {k} (a :: k). Reify a => Sing a
reify f a
x)) [ApplyForeach f a]
xs)
      (\[ApplyForeach f a]
xs -> (f a -> Encoding) -> [f a] -> Encoding
forall a. (a -> Encoding) -> [a] -> Encoding
Aeson.list (Encoding' Key -> Encoding
textEncodingToValueEncoding (Encoding' Key -> Encoding)
-> (f a -> Encoding' Key) -> f a -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Product Sing f a -> Encoding' Key
forall (a :: k). Product Sing f a -> Encoding' Key
toEnc (Product Sing f a -> Encoding' Key)
-> (f a -> Product Sing f a) -> f a -> Encoding' Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sing a -> f a -> Product Sing f a
forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
Pair Sing a
forall {k} (a :: k). Reify a => Sing a
reify) ((ApplyForeach f a -> f a) -> [ApplyForeach f a] -> [f a]
forall a b. (a -> b) -> [a] -> [b]
map ApplyForeach f a -> f a
forall {k} (f :: k -> *) (a :: k). ApplyForeach f a -> f a
getApplyForeach [ApplyForeach f a]
xs))
    ToJSONKeyValueForall forall (a :: k). Product Sing f a -> Value
toValue forall (a :: k). Product Sing f a -> Encoding
toEnc -> ([ApplyForeach f a] -> Value)
-> ([ApplyForeach f a] -> Encoding)
-> ToJSONKeyFunction [ApplyForeach f a]
forall a. (a -> Value) -> (a -> Encoding) -> ToJSONKeyFunction a
ToJSONKeyValue
      (\[ApplyForeach f a]
xs -> [Value] -> Value
forall a. ToJSON a => a -> Value
toJSON ([Value] -> Value) -> [Value] -> Value
forall a b. (a -> b) -> a -> b
$ (ApplyForeach f a -> Value) -> [ApplyForeach f a] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map (\(ApplyForeach f a
x) -> Product Sing f a -> Value
forall (a :: k). Product Sing f a -> Value
toValue (Sing a -> f a -> Product Sing f a
forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
Pair Sing a
forall {k} (a :: k). Reify a => Sing a
reify f a
x)) [ApplyForeach f a]
xs)
      (\[ApplyForeach f a]
xs -> (f a -> Encoding) -> [f a] -> Encoding
forall a. (a -> Encoding) -> [a] -> Encoding
Aeson.list (Product Sing f a -> Encoding
forall (a :: k). Product Sing f a -> Encoding
toEnc (Product Sing f a -> Encoding)
-> (f a -> Product Sing f a) -> f a -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sing a -> f a -> Product Sing f a
forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
Pair Sing a
forall {k} (a :: k). Reify a => Sing a
reify) ((ApplyForeach f a -> f a) -> [ApplyForeach f a] -> [f a]
forall a b. (a -> b) -> [a] -> [b]
map ApplyForeach f a -> f a
forall {k} (f :: k -> *) (a :: k). ApplyForeach f a -> f a
getApplyForeach [ApplyForeach f a]
xs))

-- this is always safe
textEncodingToValueEncoding :: Aeson.Encoding' Aeson.Key -> Aeson.Encoding' Aeson.Value
textEncodingToValueEncoding :: Encoding' Key -> Encoding
textEncodingToValueEncoding = Encoding' Key -> Encoding
forall a b. Encoding' a -> Encoding' b
AEI.retagEncoding

instance (FromJSONKeyForeach f, Reify a) => FromJSONKey (ApplyForeach f a) where
  fromJSONKey :: FromJSONKeyFunction (ApplyForeach f a)
fromJSONKey = case FromJSONKeyFunctionForeach f
forall {k} (f :: k -> *).
FromJSONKeyForeach f =>
FromJSONKeyFunctionForeach f
fromJSONKeyForeach of
    FromJSONKeyTextParserForeach forall (a :: k). Sing a -> Key -> Parser (f a)
f -> (Text -> Parser (ApplyForeach f a))
-> FromJSONKeyFunction (ApplyForeach f a)
forall a. (Text -> Parser a) -> FromJSONKeyFunction a
FromJSONKeyTextParser ((f a -> ApplyForeach f a)
-> Parser (f a) -> Parser (ApplyForeach f a)
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f a -> ApplyForeach f a
forall {k} (f :: k -> *) (a :: k). f a -> ApplyForeach f a
ApplyForeach (Parser (f a) -> Parser (ApplyForeach f a))
-> (Text -> Parser (f a)) -> Text -> Parser (ApplyForeach f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sing a -> Key -> Parser (f a)
forall (a :: k). Sing a -> Key -> Parser (f a)
f Sing a
forall {k} (a :: k). Reify a => Sing a
reify (Key -> Parser (f a)) -> (Text -> Key) -> Text -> Parser (f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Key
Key.fromText)
    FromJSONKeyValueForeach forall (a :: k). Sing a -> Value -> Parser (f a)
f -> (Value -> Parser (ApplyForeach f a))
-> FromJSONKeyFunction (ApplyForeach f a)
forall a. (Value -> Parser a) -> FromJSONKeyFunction a
FromJSONKeyValue ((f a -> ApplyForeach f a)
-> Parser (f a) -> Parser (ApplyForeach f a)
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f a -> ApplyForeach f a
forall {k} (f :: k -> *) (a :: k). f a -> ApplyForeach f a
ApplyForeach (Parser (f a) -> Parser (ApplyForeach f a))
-> (Value -> Parser (f a)) -> Value -> Parser (ApplyForeach f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sing a -> Value -> Parser (f a)
forall (a :: k). Sing a -> Value -> Parser (f a)
f Sing a
forall {k} (a :: k). Reify a => Sing a
reify)
  fromJSONKeyList :: FromJSONKeyFunction [ApplyForeach f a]
fromJSONKeyList = case FromJSONKeyFunctionForeach f
forall {k} (f :: k -> *).
FromJSONKeyForeach f =>
FromJSONKeyFunctionForeach f
fromJSONKeyForeach of
    FromJSONKeyTextParserForeach forall (a :: k). Sing a -> Key -> Parser (f a)
f -> (Value -> Parser [ApplyForeach f a])
-> FromJSONKeyFunction [ApplyForeach f a]
forall a. (Value -> Parser a) -> FromJSONKeyFunction a
FromJSONKeyValue ((Value -> Parser [ApplyForeach f a])
 -> FromJSONKeyFunction [ApplyForeach f a])
-> (Value -> Parser [ApplyForeach f a])
-> FromJSONKeyFunction [ApplyForeach f a]
forall a b. (a -> b) -> a -> b
$ String
-> (Array -> Parser [ApplyForeach f a])
-> Value
-> Parser [ApplyForeach f a]
forall a. String -> (Array -> Parser a) -> Value -> Parser a
Aeson.withArray String
"ApplyForeach" ((Array -> Parser [ApplyForeach f a])
 -> Value -> Parser [ApplyForeach f a])
-> (Array -> Parser [ApplyForeach f a])
-> Value
-> Parser [ApplyForeach f a]
forall a b. (a -> b) -> a -> b
$ \Array
xs -> do
      (Vector (ApplyForeach f a) -> [ApplyForeach f a])
-> Parser (Vector (ApplyForeach f a)) -> Parser [ApplyForeach f a]
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Vector (ApplyForeach f a) -> [ApplyForeach f a]
forall a. Vector a -> [a]
V.toList ((Value -> Parser (ApplyForeach f a))
-> Array -> Parser (Vector (ApplyForeach f a))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Vector a -> m (Vector b)
mapM ((f a -> ApplyForeach f a)
-> Parser (f a) -> Parser (ApplyForeach f a)
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f a -> ApplyForeach f a
forall {k} (f :: k -> *) (a :: k). f a -> ApplyForeach f a
ApplyForeach (Parser (f a) -> Parser (ApplyForeach f a))
-> (Value -> Parser (f a)) -> Value -> Parser (ApplyForeach f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> (Text -> Parser (f a)) -> Value -> Parser (f a)
forall a. String -> (Text -> Parser a) -> Value -> Parser a
Aeson.withText String
"ApplyForeach" (Sing a -> Key -> Parser (f a)
forall (a :: k). Sing a -> Key -> Parser (f a)
f Sing a
forall {k} (a :: k). Reify a => Sing a
reify (Key -> Parser (f a)) -> (Text -> Key) -> Text -> Parser (f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Key
Key.fromText)) Array
xs)
    FromJSONKeyValueForeach forall (a :: k). Sing a -> Value -> Parser (f a)
f -> (Value -> Parser [ApplyForeach f a])
-> FromJSONKeyFunction [ApplyForeach f a]
forall a. (Value -> Parser a) -> FromJSONKeyFunction a
FromJSONKeyValue ((Value -> Parser [ApplyForeach f a])
 -> FromJSONKeyFunction [ApplyForeach f a])
-> (Value -> Parser [ApplyForeach f a])
-> FromJSONKeyFunction [ApplyForeach f a]
forall a b. (a -> b) -> a -> b
$ String
-> (Array -> Parser [ApplyForeach f a])
-> Value
-> Parser [ApplyForeach f a]
forall a. String -> (Array -> Parser a) -> Value -> Parser a
Aeson.withArray String
"ApplyForeach" ((Array -> Parser [ApplyForeach f a])
 -> Value -> Parser [ApplyForeach f a])
-> (Array -> Parser [ApplyForeach f a])
-> Value
-> Parser [ApplyForeach f a]
forall a b. (a -> b) -> a -> b
$ \Array
xs -> do
      (Vector (ApplyForeach f a) -> [ApplyForeach f a])
-> Parser (Vector (ApplyForeach f a)) -> Parser [ApplyForeach f a]
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Vector (ApplyForeach f a) -> [ApplyForeach f a]
forall a. Vector a -> [a]
V.toList ((Value -> Parser (ApplyForeach f a))
-> Array -> Parser (Vector (ApplyForeach f a))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Vector a -> m (Vector b)
mapM ((f a -> ApplyForeach f a)
-> Parser (f a) -> Parser (ApplyForeach f a)
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f a -> ApplyForeach f a
forall {k} (f :: k -> *) (a :: k). f a -> ApplyForeach f a
ApplyForeach (Parser (f a) -> Parser (ApplyForeach f a))
-> (Value -> Parser (f a)) -> Value -> Parser (ApplyForeach f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sing a -> Value -> Parser (f a)
forall (a :: k). Sing a -> Value -> Parser (f a)
f Sing a
forall {k} (a :: k). Reify a => Sing a
reify) Array
xs)

class ToJSONKeyForall f where
  toJSONKeyForall :: ToJSONKeyFunctionForall f

class ToJSONKeyForeach f where
  toJSONKeyForeach :: ToJSONKeyFunctionForall (Product Sing f)

class FromJSONKeyExists f where
  fromJSONKeyExists :: FromJSONKeyFunction (Exists f)

class FromJSONKeyForeach f where
  fromJSONKeyForeach :: FromJSONKeyFunctionForeach f

class ToJSONForall f where
  toJSONForall :: f a -> Aeson.Value

class ToJSONForeach f where
  toJSONForeach :: Sing a -> f a -> Aeson.Value

class FromJSONForall f where
  parseJSONForall :: Sing a -> Aeson.Value -> Aeson.Parser (f a)

class FromJSONForeach f where
  parseJSONForeach :: Sing a -> Aeson.Value -> Aeson.Parser (f a)

class FromJSONExists f where
  parseJSONExists :: Aeson.Value -> Aeson.Parser (Exists f)

instance FromJSON a => FromJSONForeach (Const a) where
  parseJSONForeach :: forall (a :: k). Sing a -> Value -> Parser (Const a a)
parseJSONForeach Sing a
_ = (a -> Const a a) -> Parser a -> Parser (Const a a)
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Const a a
forall {k} a (b :: k). a -> Const a b
Const (Parser a -> Parser (Const a a))
-> (Value -> Parser a) -> Value -> Parser (Const a a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser a
forall a. FromJSON a => Value -> Parser a
parseJSON

instance ToJSON a => ToJSONForeach (Const a) where
  toJSONForeach :: forall (a :: k). Sing a -> Const a a -> Value
toJSONForeach Sing a
_ = (a -> Value) -> Const a a -> Value
forall a b. Coercible a b => a -> b
coerce (forall a. ToJSON a => a -> Value
toJSON @a)

-- I need to get rid of the ToJSONForall and FromJSONForeach constraints
-- on these two instances.
instance (ToJSONKeyForall f, ToJSONForall f) => ToJSONKey (Exists f) where
  toJSONKey :: ToJSONKeyFunction (Exists f)
toJSONKey = case ToJSONKeyFunctionForall f
forall {k} (f :: k -> *).
ToJSONKeyForall f =>
ToJSONKeyFunctionForall f
toJSONKeyForall of
    ToJSONKeyTextForall forall (a :: k). f a -> Key
t forall (a :: k). f a -> Encoding' Key
e -> (Exists f -> Key)
-> (Exists f -> Encoding' Key) -> ToJSONKeyFunction (Exists f)
forall a. (a -> Key) -> (a -> Encoding' Key) -> ToJSONKeyFunction a
ToJSONKeyText (\(Exists f a
a) -> f a -> Key
forall (a :: k). f a -> Key
t f a
a) (\(Exists f a
a) -> f a -> Encoding' Key
forall (a :: k). f a -> Encoding' Key
e f a
a)
    ToJSONKeyValueForall forall (a :: k). f a -> Value
v forall (a :: k). f a -> Encoding
e -> (Exists f -> Value)
-> (Exists f -> Encoding) -> ToJSONKeyFunction (Exists f)
forall a. (a -> Value) -> (a -> Encoding) -> ToJSONKeyFunction a
ToJSONKeyValue (\Exists f
x -> case Exists f
x of Exists f a
a -> f a -> Value
forall (a :: k). f a -> Value
v f a
a) (\(Exists f a
a) -> f a -> Encoding
forall (a :: k). f a -> Encoding
e f a
a)

instance (FromJSONKeyExists f, FromJSONExists f) => FromJSONKey (Exists f) where
  fromJSONKey :: FromJSONKeyFunction (Exists f)
fromJSONKey = FromJSONKeyFunction (Exists f)
forall {k} (f :: k -> *).
FromJSONKeyExists f =>
FromJSONKeyFunction (Exists f)
fromJSONKeyExists

instance ToJSONForall f => ToJSON (Exists f) where
  toJSON :: Exists f -> Value
toJSON (Exists f a
a) = f a -> Value
forall (a :: k). f a -> Value
forall {k} (f :: k -> *) (a :: k). ToJSONForall f => f a -> Value
toJSONForall f a
a

instance FromJSONExists f => FromJSON (Exists f) where
  parseJSON :: Value -> Parser (Exists f)
parseJSON Value
v = Value -> Parser (Exists f)
forall k (f :: k -> *).
FromJSONExists f =>
Value -> Parser (Exists f)
parseJSONExists Value
v

instance (Aeson.ToJSON1 f, ToJSONForall g) => ToJSONForall (Compose f g) where
  toJSONForall :: forall (a :: k). Compose f g a -> Value
toJSONForall (Compose f (g a)
x) = (g a -> Bool)
-> (g a -> Value) -> ([g a] -> Value) -> f (g a) -> Value
forall a.
(a -> Bool) -> (a -> Value) -> ([a] -> Value) -> f a -> Value
forall (f :: * -> *) a.
ToJSON1 f =>
(a -> Bool) -> (a -> Value) -> ([a] -> Value) -> f a -> Value
Aeson.liftToJSON (\g a
_ -> Bool
False) g a -> Value
forall (a :: k). g a -> Value
forall {k} (f :: k -> *) (a :: k). ToJSONForall f => f a -> Value
toJSONForall ([Value] -> Value
forall a. ToJSON a => a -> Value
Aeson.toJSON ([Value] -> Value) -> ([g a] -> [Value]) -> [g a] -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (g a -> Value) -> [g a] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map g a -> Value
forall (a :: k). g a -> Value
forall {k} (f :: k -> *) (a :: k). ToJSONForall f => f a -> Value
toJSONForall) f (g a)
x

instance (Aeson.ToJSON1 f, ToJSONForeach g) => ToJSONForeach (Compose f g) where
  toJSONForeach :: forall (a :: k). Sing a -> Compose f g a -> Value
toJSONForeach Sing a
s (Compose f (g a)
x) = (g a -> Bool)
-> (g a -> Value) -> ([g a] -> Value) -> f (g a) -> Value
forall a.
(a -> Bool) -> (a -> Value) -> ([a] -> Value) -> f a -> Value
forall (f :: * -> *) a.
ToJSON1 f =>
(a -> Bool) -> (a -> Value) -> ([a] -> Value) -> f a -> Value
Aeson.liftToJSON (\g a
_ -> Bool
False) (Sing a -> g a -> Value
forall (a :: k). Sing a -> g a -> Value
forall {k} (f :: k -> *) (a :: k).
ToJSONForeach f =>
Sing a -> f a -> Value
toJSONForeach Sing a
s) ([Value] -> Value
forall a. ToJSON a => a -> Value
Aeson.toJSON ([Value] -> Value) -> ([g a] -> [Value]) -> [g a] -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (g a -> Value) -> [g a] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map (Sing a -> g a -> Value
forall (a :: k). Sing a -> g a -> Value
forall {k} (f :: k -> *) (a :: k).
ToJSONForeach f =>
Sing a -> f a -> Value
toJSONForeach Sing a
s)) f (g a)
x

instance (Aeson.FromJSON1 f, FromJSONForeach g) => FromJSONForeach (Compose f g) where
  parseJSONForeach :: forall (a :: k). Sing a -> Value -> Parser (Compose f g a)
parseJSONForeach Sing a
s = (f (g a) -> Compose f g a)
-> Parser (f (g a)) -> Parser (Compose f g a)
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f (g a) -> Compose f g a
forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (Parser (f (g a)) -> Parser (Compose f g a))
-> (Value -> Parser (f (g a))) -> Value -> Parser (Compose f g a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (g a)
-> (Value -> Parser (g a))
-> (Value -> Parser [g a])
-> Value
-> Parser (f (g a))
forall a.
Maybe a
-> (Value -> Parser a)
-> (Value -> Parser [a])
-> Value
-> Parser (f a)
forall (f :: * -> *) a.
FromJSON1 f =>
Maybe a
-> (Value -> Parser a)
-> (Value -> Parser [a])
-> Value
-> Parser (f a)
Aeson.liftParseJSON Maybe (g a)
forall a. Maybe a
Nothing
    (Sing a -> Value -> Parser (g a)
forall (a :: k). Sing a -> Value -> Parser (g a)
forall {k} (f :: k -> *) (a :: k).
FromJSONForeach f =>
Sing a -> Value -> Parser (f a)
parseJSONForeach Sing a
s)
    (String -> (Array -> Parser [g a]) -> Value -> Parser [g a]
forall a. String -> (Array -> Parser a) -> Value -> Parser a
Aeson.withArray String
"Compose" ((Vector (g a) -> [g a]) -> Parser (Vector (g a)) -> Parser [g a]
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Vector (g a) -> [g a]
forall a. Vector a -> [a]
V.toList (Parser (Vector (g a)) -> Parser [g a])
-> (Array -> Parser (Vector (g a))) -> Array -> Parser [g a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> Parser (g a)) -> Array -> Parser (Vector (g a))
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Vector a -> m (Vector b)
V.mapM (Sing a -> Value -> Parser (g a)
forall (a :: k). Sing a -> Value -> Parser (g a)
forall {k} (f :: k -> *) (a :: k).
FromJSONForeach f =>
Sing a -> Value -> Parser (f a)
parseJSONForeach Sing a
s)))

class ToJSONSing k where
  toJSONSing :: forall (a :: k). Sing a -> Aeson.Value

instance (ToJSONForeach f, ToJSONSing k) => ToJSON (Some (f :: k -> Type)) where
  toJSON :: Some f -> Value
toJSON (Some Sing a
s f a
v) = [Value] -> Value
forall a. ToJSON a => a -> Value
toJSON [Sing a -> Value
forall (a :: k). Sing a -> Value
forall k (a :: k). ToJSONSing k => Sing a -> Value
toJSONSing Sing a
s, Sing a -> f a -> Value
forall (a :: k). Sing a -> f a -> Value
forall {k} (f :: k -> *) (a :: k).
ToJSONForeach f =>
Sing a -> f a -> Value
toJSONForeach Sing a
s f a
v]

class FromJSONSing k where
  parseJSONSing :: Aeson.Value -> Aeson.Parser (Exists (Sing :: k -> Type))

instance (Aeson.FromJSON1 f, FromJSONForall g) => FromJSONForall (Compose f g) where
  parseJSONForall :: forall (a :: k). Sing a -> Value -> Parser (Compose f g a)
parseJSONForall Sing a
s = (f (g a) -> Compose f g a)
-> Parser (f (g a)) -> Parser (Compose f g a)
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f (g a) -> Compose f g a
forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (Parser (f (g a)) -> Parser (Compose f g a))
-> (Value -> Parser (f (g a))) -> Value -> Parser (Compose f g a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (g a)
-> (Value -> Parser (g a))
-> (Value -> Parser [g a])
-> Value
-> Parser (f (g a))
forall a.
Maybe a
-> (Value -> Parser a)
-> (Value -> Parser [a])
-> Value
-> Parser (f a)
forall (f :: * -> *) a.
FromJSON1 f =>
Maybe a
-> (Value -> Parser a)
-> (Value -> Parser [a])
-> Value
-> Parser (f a)
Aeson.liftParseJSON Maybe (g a)
forall a. Maybe a
Nothing
      (Sing a -> Value -> Parser (g a)
forall (a :: k). Sing a -> Value -> Parser (g a)
forall {k} (f :: k -> *) (a :: k).
FromJSONForall f =>
Sing a -> Value -> Parser (f a)
parseJSONForall Sing a
s)
          (String -> (Array -> Parser [g a]) -> Value -> Parser [g a]
forall a. String -> (Array -> Parser a) -> Value -> Parser a
Aeson.withArray String
"Compose" ((Vector (g a) -> [g a]) -> Parser (Vector (g a)) -> Parser [g a]
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Vector (g a) -> [g a]
forall a. Vector a -> [a]
V.toList (Parser (Vector (g a)) -> Parser [g a])
-> (Array -> Parser (Vector (g a))) -> Array -> Parser [g a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> Parser (g a)) -> Array -> Parser (Vector (g a))
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Vector a -> m (Vector b)
V.mapM (Sing a -> Value -> Parser (g a)
forall (a :: k). Sing a -> Value -> Parser (g a)
forall {k} (f :: k -> *) (a :: k).
FromJSONForall f =>
Sing a -> Value -> Parser (f a)
parseJSONForall Sing a
s)))

instance (FromJSONForeach f, FromJSONSing k) => FromJSON (Some (f :: k -> Type)) where
  parseJSON :: Value -> Parser (Some f)
parseJSON = String -> (Array -> Parser (Some f)) -> Value -> Parser (Some f)
forall a. String -> (Array -> Parser a) -> Value -> Parser a
Aeson.withArray String
"Some" ((Array -> Parser (Some f)) -> Value -> Parser (Some f))
-> (Array -> Parser (Some f)) -> Value -> Parser (Some f)
forall a b. (a -> b) -> a -> b
$ \Array
v -> if Array -> Int
forall a. Vector a -> Int
V.length Array
v Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2
    then do
      let x :: Value
x = Array -> Int -> Value
forall a. Vector a -> Int -> a
V.unsafeIndex Array
v Int
0
          y :: Value
y = Array -> Int -> Value
forall a. Vector a -> Int -> a
V.unsafeIndex Array
v Int
1
      Exists Sing a
s <- Value -> Parser (Exists Sing)
forall k. FromJSONSing k => Value -> Parser (Exists Sing)
parseJSONSing Value
x :: Aeson.Parser (Exists (Sing :: k -> Type))
      f a
val <- Sing a -> Value -> Parser (f a)
forall (a :: k). Sing a -> Value -> Parser (f a)
forall {k} (f :: k -> *) (a :: k).
FromJSONForeach f =>
Sing a -> Value -> Parser (f a)
parseJSONForeach Sing a
s Value
y
      Some f -> Parser (Some f)
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (Sing a -> f a -> Some f
forall k (f :: k -> *) (a :: k). Sing a -> f a -> Some f
Some Sing a
s f a
val)
    else String -> Parser (Some f)
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"array of length 2 expected"

-- This name is not great. I need to figure out a better naming
-- scheme that allows this area to grow.
toJSONMapForeachKey :: (ToJSONKeyForeach f, ToJSONForeach v)
  => Sing a
  -> Map (f a) (v a)
  -> Aeson.Value
toJSONMapForeachKey :: forall {k} (f :: k -> *) (v :: k -> *) (a :: k).
(ToJSONKeyForeach f, ToJSONForeach v) =>
Sing a -> Map (f a) (v a) -> Value
toJSONMapForeachKey Sing a
s Map (f a) (v a)
m = case ToJSONKeyFunctionForall (Product Sing f)
forall {k} (f :: k -> *).
ToJSONKeyForeach f =>
ToJSONKeyFunctionForall (Product Sing f)
toJSONKeyForeach of
  ToJSONKeyTextForall forall (a :: k). Product Sing f a -> Key
keyToText forall (a :: k). Product Sing f a -> Encoding' Key
_ -> HashMap Key Value -> Value
forall a. ToJSON a => a -> Value
toJSON (HashMap Key Value -> Value) -> HashMap Key Value -> Value
forall a b. (a -> b) -> a -> b
$ (HashMap Key Value -> f a -> v a -> HashMap Key Value)
-> HashMap Key Value -> Map (f a) (v a) -> HashMap Key Value
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
M.foldlWithKey'
    ( \HashMap Key Value
hm f a
key v a
val -> Key -> Value -> HashMap Key Value -> HashMap Key Value
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert (Product Sing f a -> Key
forall (a :: k). Product Sing f a -> Key
keyToText (Sing a -> f a -> Product Sing f a
forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
Pair Sing a
s f a
key)) (Sing a -> v a -> Value
forall (a :: k). Sing a -> v a -> Value
forall {k} (f :: k -> *) (a :: k).
ToJSONForeach f =>
Sing a -> f a -> Value
toJSONForeach Sing a
s v a
val) HashMap Key Value
hm
    ) HashMap Key Value
forall k v. HashMap k v
HM.empty Map (f a) (v a)
m
  ToJSONKeyValueForall forall (a :: k). Product Sing f a -> Value
keyToValue forall (a :: k). Product Sing f a -> Encoding
_ -> [(Value, Value)] -> Value
forall a. ToJSON a => a -> Value
toJSON ([(Value, Value)] -> Value) -> [(Value, Value)] -> Value
forall a b. (a -> b) -> a -> b
$ (f a -> v a -> [(Value, Value)] -> [(Value, Value)])
-> [(Value, Value)] -> Map (f a) (v a) -> [(Value, Value)]
forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
M.foldrWithKey' 
    ( \f a
key v a
val [(Value, Value)]
xs -> (Product Sing f a -> Value
forall (a :: k). Product Sing f a -> Value
keyToValue (Sing a -> f a -> Product Sing f a
forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
Pair Sing a
s f a
key), Sing a -> v a -> Value
forall (a :: k). Sing a -> v a -> Value
forall {k} (f :: k -> *) (a :: k).
ToJSONForeach f =>
Sing a -> f a -> Value
toJSONForeach Sing a
s v a
val) (Value, Value) -> [(Value, Value)] -> [(Value, Value)]
forall a. a -> [a] -> [a]
: [(Value, Value)]
xs
    ) [] Map (f a) (v a)
m

-- | Parse a 'Map' whose key type is higher-kinded. This only creates a valid 'Map'
--   if the 'OrdForeach' instance agrees with the 'Ord' instance.
parseJSONMapForeachKey :: forall k (f :: k -> Type) (a :: k) v. (FromJSONKeyForeach f, OrdForeach f, Unreify k)
  => (Aeson.Value -> Aeson.Parser v)
  -> Sing a
  -> Aeson.Value
  -> Aeson.Parser (Map (f a) v)
parseJSONMapForeachKey :: forall k (f :: k -> *) (a :: k) v.
(FromJSONKeyForeach f, OrdForeach f, Unreify k) =>
(Value -> Parser v) -> Sing a -> Value -> Parser (Map (f a) v)
parseJSONMapForeachKey Value -> Parser v
valueParser Sing a
s Value
obj = Sing a -> (Reify a => Parser (Map (f a) v)) -> Parser (Map (f a) v)
forall (a :: k) b. Sing a -> (Reify a => b) -> b
forall k (a :: k) b. Unreify k => Sing a -> (Reify a => b) -> b
unreify Sing a
s ((Reify a => Parser (Map (f a) v)) -> Parser (Map (f a) v))
-> (Reify a => Parser (Map (f a) v)) -> Parser (Map (f a) v)
forall a b. (a -> b) -> a -> b
$ case FromJSONKeyFunctionForeach f
forall {k} (f :: k -> *).
FromJSONKeyForeach f =>
FromJSONKeyFunctionForeach f
fromJSONKeyForeach of
  FromJSONKeyTextParserForeach forall (a :: k). Sing a -> Key -> Parser (f a)
f -> String
-> (Object -> Parser (Map (f a) v))
-> Value
-> Parser (Map (f a) v)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"Map k v"
    ( (Map (ApplyForeach f a) v -> Map (f a) v)
-> Parser (Map (ApplyForeach f a) v) -> Parser (Map (f a) v)
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((ApplyForeach f a -> f a)
-> Map (ApplyForeach f a) v -> Map (f a) v
forall k1 k2 a. (k1 -> k2) -> Map k1 a -> Map k2 a
M.mapKeysMonotonic ApplyForeach f a -> f a
forall {k} (f :: k -> *) (a :: k). ApplyForeach f a -> f a
getApplyForeach) (Parser (Map (ApplyForeach f a) v) -> Parser (Map (f a) v))
-> (Object -> Parser (Map (ApplyForeach f a) v))
-> Object
-> Parser (Map (f a) v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Key
 -> Value
 -> Parser (Map (ApplyForeach f a) v)
 -> Parser (Map (ApplyForeach f a) v))
-> Parser (Map (ApplyForeach f a) v)
-> Object
-> Parser (Map (ApplyForeach f a) v)
forall v a. (Key -> v -> a -> a) -> a -> KeyMap v -> a
KM.foldrWithKey
      (\Key
k Value
v Parser (Map (ApplyForeach f a) v)
m -> ApplyForeach f a
-> v -> Map (ApplyForeach f a) v -> Map (ApplyForeach f a) v
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert
        (ApplyForeach f a
 -> v -> Map (ApplyForeach f a) v -> Map (ApplyForeach f a) v)
-> Parser (ApplyForeach f a)
-> Parser
     (v -> Map (ApplyForeach f a) v -> Map (ApplyForeach f a) v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser (f a) -> Parser (ApplyForeach f a)
forall a b. Coercible a b => a -> b
coerce (Sing a -> Key -> Parser (f a)
forall (a :: k). Sing a -> Key -> Parser (f a)
f Sing a
s Key
k :: Aeson.Parser (f a)) :: Aeson.Parser (ApplyForeach f a)) Parser (ApplyForeach f a)
-> JSONPathElement -> Parser (ApplyForeach f a)
forall a. Parser a -> JSONPathElement -> Parser a
<?> Key -> JSONPathElement
Key Key
k
        Parser (v -> Map (ApplyForeach f a) v -> Map (ApplyForeach f a) v)
-> Parser v
-> Parser (Map (ApplyForeach f a) v -> Map (ApplyForeach f a) v)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value -> Parser v
valueParser Value
v Parser v -> JSONPathElement -> Parser v
forall a. Parser a -> JSONPathElement -> Parser a
<?> Key -> JSONPathElement
Key Key
k
        Parser (Map (ApplyForeach f a) v -> Map (ApplyForeach f a) v)
-> Parser (Map (ApplyForeach f a) v)
-> Parser (Map (ApplyForeach f a) v)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Map (ApplyForeach f a) v)
m
      ) (Map (ApplyForeach f a) v -> Parser (Map (ApplyForeach f a) v)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Map (ApplyForeach f a) v
forall k a. Map k a
M.empty)
    ) Value
obj
  FromJSONKeyValueForeach forall (a :: k). Sing a -> Value -> Parser (f a)
f -> String
-> (Array -> Parser (Map (f a) v)) -> Value -> Parser (Map (f a) v)
forall a. String -> (Array -> Parser a) -> Value -> Parser a
Aeson.withArray String
"Map k v"
    ( ([(ApplyForeach f a, v)] -> Map (f a) v)
-> Parser [(ApplyForeach f a, v)] -> Parser (Map (f a) v)
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((ApplyForeach f a -> f a)
-> Map (ApplyForeach f a) v -> Map (f a) v
forall k1 k2 a. (k1 -> k2) -> Map k1 a -> Map k2 a
M.mapKeysMonotonic ApplyForeach f a -> f a
forall {k} (f :: k -> *) (a :: k). ApplyForeach f a -> f a
getApplyForeach (Map (ApplyForeach f a) v -> Map (f a) v)
-> ([(ApplyForeach f a, v)] -> Map (ApplyForeach f a) v)
-> [(ApplyForeach f a, v)]
-> Map (f a) v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(ApplyForeach f a, v)] -> Map (ApplyForeach f a) v
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList)
    (Parser [(ApplyForeach f a, v)] -> Parser (Map (f a) v))
-> (Array -> Parser [(ApplyForeach f a, v)])
-> Array
-> Parser (Map (f a) v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Parser [(f a, v)] -> Parser [(ApplyForeach f a, v)]
forall a b. Coercible a b => a -> b
coerce :: Aeson.Parser [(f a, v)] -> Aeson.Parser [(ApplyForeach f a, v)])
    (Parser [(f a, v)] -> Parser [(ApplyForeach f a, v)])
-> (Array -> Parser [(f a, v)])
-> Array
-> Parser [(ApplyForeach f a, v)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Parser (f a, v)] -> Parser [(f a, v)]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
TRV.sequence
    ([Parser (f a, v)] -> Parser [(f a, v)])
-> (Array -> [Parser (f a, v)]) -> Array -> Parser [(f a, v)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Value -> Parser (f a, v))
-> [Int] -> [Value] -> [Parser (f a, v)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith ((Value -> Parser (f a))
-> (Value -> Parser v) -> Int -> Value -> Parser (f a, v)
forall a b.
(Value -> Parser a)
-> (Value -> Parser b) -> Int -> Value -> Parser (a, b)
parseIndexedJSONPair (Sing a -> Value -> Parser (f a)
forall (a :: k). Sing a -> Value -> Parser (f a)
f Sing a
s) Value -> Parser v
valueParser) [Int
0..]
    ([Value] -> [Parser (f a, v)])
-> (Array -> [Value]) -> Array -> [Parser (f a, v)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Array -> [Value]
forall a. Vector a -> [a]
V.toList
    ) Value
obj

-- copied from aeson
parseIndexedJSONPair :: (Aeson.Value -> Aeson.Parser a) -> (Aeson.Value -> Aeson.Parser b) -> Int -> Aeson.Value -> Aeson.Parser (a, b)
parseIndexedJSONPair :: forall a b.
(Value -> Parser a)
-> (Value -> Parser b) -> Int -> Value -> Parser (a, b)
parseIndexedJSONPair Value -> Parser a
keyParser Value -> Parser b
valParser Int
idx Value
value = Value -> Parser (a, b)
p Value
value Parser (a, b) -> JSONPathElement -> Parser (a, b)
forall a. Parser a -> JSONPathElement -> Parser a
<?> Int -> JSONPathElement
Index Int
idx
  where
    p :: Value -> Parser (a, b)
p = String -> (Array -> Parser (a, b)) -> Value -> Parser (a, b)
forall a. String -> (Array -> Parser a) -> Value -> Parser a
Aeson.withArray String
"(k,v)" ((Array -> Parser (a, b)) -> Value -> Parser (a, b))
-> (Array -> Parser (a, b)) -> Value -> Parser (a, b)
forall a b. (a -> b) -> a -> b
$ \Array
ab ->
        let n :: Int
n = Array -> Int
forall a. Vector a -> Int
V.length Array
ab
        in if Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2
             then (,) (a -> b -> (a, b)) -> Parser a -> Parser (b -> (a, b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value -> Parser a) -> Int -> Array -> Parser a
forall a. (Value -> Parser a) -> Int -> Array -> Parser a
parseJSONElemAtIndex Value -> Parser a
keyParser Int
0 Array
ab
                      Parser (b -> (a, b)) -> Parser b -> Parser (a, b)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Value -> Parser b) -> Int -> Array -> Parser b
forall a. (Value -> Parser a) -> Int -> Array -> Parser a
parseJSONElemAtIndex Value -> Parser b
valParser Int
1 Array
ab
             else String -> Parser (a, b)
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser (a, b)) -> String -> Parser (a, b)
forall a b. (a -> b) -> a -> b
$ String
"cannot unpack array of length " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                         Int -> String
forall a. Show a => a -> String
show Int
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" into a pair"
{-# INLINE parseIndexedJSONPair #-}

-- copied from aeson
parseJSONElemAtIndex :: (Aeson.Value -> Aeson.Parser a) -> Int -> V.Vector Aeson.Value -> Aeson.Parser a
parseJSONElemAtIndex :: forall a. (Value -> Parser a) -> Int -> Array -> Parser a
parseJSONElemAtIndex Value -> Parser a
p Int
idx Array
ary = Value -> Parser a
p (Array -> Int -> Value
forall a. Vector a -> Int -> a
V.unsafeIndex Array
ary Int
idx) Parser a -> JSONPathElement -> Parser a
forall a. Parser a -> JSONPathElement -> Parser a
<?> Int -> JSONPathElement
Index Int
idx