{-# LANGUAGE DeriveFoldable         #-}
{-# LANGUAGE DeriveFunctor          #-}
{-# LANGUAGE DeriveTraversable      #-}
{-# LANGUAGE FlexibleContexts       #-}
{-# LANGUAGE FlexibleInstances      #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE MultiParamTypeClasses  #-}
{-# LANGUAGE NoImplicitPrelude      #-}
{-# LANGUAGE RankNTypes             #-}
{-# LANGUAGE TypeFamilies           #-}
-- | Types and functions for handling our representation of a JSON object.
module Waargonaut.Types.JObject
  (
    -- * Object Type
    JObject (..)
  , HasJObject (..)

    -- * Key/value pair type
  , JAssoc (..)
  , HasJAssoc (..)

    -- * Map-like object representation
  , MapLikeObj
  , toMapLikeObj
  , fromMapLikeObj
  , _MapLikeObj

    -- * Parser
  , parseJObject
  ) where

import           Prelude                         (Eq, Int, Show, elem, fst, not,
                                                  otherwise, (==))

import           Control.Category                (id, (.))
import           Control.Lens                    (AsEmpty (..), At (..), Index,
                                                  IxValue, Ixed (..), Lens',
                                                  Prism', Rewrapped,
                                                  Wrapped (..), cons, iso,
                                                  nearly, prism', to, ( # ),
                                                  (<&>), (^.), _Wrapped)
import           Control.Lens.Extras             (is)

import           Control.Monad                   (Monad)
import           Data.Bifoldable                 (Bifoldable (bifoldMap))
import           Data.Bifunctor                  (Bifunctor (bimap))
import           Data.Bitraversable              (Bitraversable (bitraverse))
import           Data.Bool                       (Bool (..))
import           Data.Foldable                   (Foldable, find, foldr)
import           Data.Function                   (($))
import           Data.Functor                    (Functor, (<$>))
import           Data.Maybe                      (Maybe (..), maybe)
import           Data.Monoid                     (Monoid (mappend, mempty))
import           Data.Semigroup                  (Semigroup ((<>)))
import           Data.Text                       (Text)
import           Data.Traversable                (Traversable, traverse)

import qualified Data.Witherable                 as W

import           Text.Parser.Char                (CharParsing, char)

import           Waargonaut.Types.CommaSep       (CommaSeparated (..),
                                                  parseCommaSeparated)

import           Waargonaut.Types.JObject.JAssoc (HasJAssoc (..), JAssoc (..),
                                                  jAssocAlterF, parseJAssoc)

import           Waargonaut.Types.JString        (_JStringText)


-- $setup
-- >>> :set -XOverloadedStrings
-- >>> import Utils
-- >>> import Waargonaut.Types.Json
-- >>> import Waargonaut.Types.Whitespace
-- >>> import Control.Monad (return)
-- >>> import Data.Either (Either (..), isLeft)
-- >>> import Waargonaut.Decode.Error (DecodeError)
-- >>> import Data.Digit (HeXDigit)
----

-- | The representation of a JSON object.
--
-- The <https://tools.ietf.org/html/rfc8259#section-4 JSON RFC8259> indicates
-- that names within an object "should" be unique. But the standard does not
-- enforce this, leaving it to the various implementations to decide how to
-- handle it.
--
-- As there are multiple possibilities for deciding which key to use when
-- enforcing uniqueness, Waargonaut accepts duplicate keys, allowing you to
-- decide how to handle it.
--
-- This type is the "list of tuples of key and value" structure, as such it is a
-- wrapper around the 'CommaSeparated' data type.
--
newtype JObject ws a =
  JObject (CommaSeparated ws (JAssoc ws a))
  deriving (JObject ws a -> JObject ws a -> Bool
(JObject ws a -> JObject ws a -> Bool)
-> (JObject ws a -> JObject ws a -> Bool) -> Eq (JObject ws a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall ws a. (Eq ws, Eq a) => JObject ws a -> JObject ws a -> Bool
/= :: JObject ws a -> JObject ws a -> Bool
$c/= :: forall ws a. (Eq ws, Eq a) => JObject ws a -> JObject ws a -> Bool
== :: JObject ws a -> JObject ws a -> Bool
$c== :: forall ws a. (Eq ws, Eq a) => JObject ws a -> JObject ws a -> Bool
Eq, Int -> JObject ws a -> ShowS
[JObject ws a] -> ShowS
JObject ws a -> String
(Int -> JObject ws a -> ShowS)
-> (JObject ws a -> String)
-> ([JObject ws a] -> ShowS)
-> Show (JObject ws a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall ws a. (Show ws, Show a) => Int -> JObject ws a -> ShowS
forall ws a. (Show ws, Show a) => [JObject ws a] -> ShowS
forall ws a. (Show ws, Show a) => JObject ws a -> String
showList :: [JObject ws a] -> ShowS
$cshowList :: forall ws a. (Show ws, Show a) => [JObject ws a] -> ShowS
show :: JObject ws a -> String
$cshow :: forall ws a. (Show ws, Show a) => JObject ws a -> String
showsPrec :: Int -> JObject ws a -> ShowS
$cshowsPrec :: forall ws a. (Show ws, Show a) => Int -> JObject ws a -> ShowS
Show, a -> JObject ws b -> JObject ws a
(a -> b) -> JObject ws a -> JObject ws b
(forall a b. (a -> b) -> JObject ws a -> JObject ws b)
-> (forall a b. a -> JObject ws b -> JObject ws a)
-> Functor (JObject ws)
forall a b. a -> JObject ws b -> JObject ws a
forall a b. (a -> b) -> JObject ws a -> JObject ws b
forall ws a b. a -> JObject ws b -> JObject ws a
forall ws a b. (a -> b) -> JObject ws a -> JObject ws b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> JObject ws b -> JObject ws a
$c<$ :: forall ws a b. a -> JObject ws b -> JObject ws a
fmap :: (a -> b) -> JObject ws a -> JObject ws b
$cfmap :: forall ws a b. (a -> b) -> JObject ws a -> JObject ws b
Functor, JObject ws a -> Bool
(a -> m) -> JObject ws a -> m
(a -> b -> b) -> b -> JObject ws a -> b
(forall m. Monoid m => JObject ws m -> m)
-> (forall m a. Monoid m => (a -> m) -> JObject ws a -> m)
-> (forall m a. Monoid m => (a -> m) -> JObject ws a -> m)
-> (forall a b. (a -> b -> b) -> b -> JObject ws a -> b)
-> (forall a b. (a -> b -> b) -> b -> JObject ws a -> b)
-> (forall b a. (b -> a -> b) -> b -> JObject ws a -> b)
-> (forall b a. (b -> a -> b) -> b -> JObject ws a -> b)
-> (forall a. (a -> a -> a) -> JObject ws a -> a)
-> (forall a. (a -> a -> a) -> JObject ws a -> a)
-> (forall a. JObject ws a -> [a])
-> (forall a. JObject ws a -> Bool)
-> (forall a. JObject ws a -> Int)
-> (forall a. Eq a => a -> JObject ws a -> Bool)
-> (forall a. Ord a => JObject ws a -> a)
-> (forall a. Ord a => JObject ws a -> a)
-> (forall a. Num a => JObject ws a -> a)
-> (forall a. Num a => JObject ws a -> a)
-> Foldable (JObject ws)
forall a. Eq a => a -> JObject ws a -> Bool
forall a. Num a => JObject ws a -> a
forall a. Ord a => JObject ws a -> a
forall m. Monoid m => JObject ws m -> m
forall a. JObject ws a -> Bool
forall a. JObject ws a -> Int
forall a. JObject ws a -> [a]
forall a. (a -> a -> a) -> JObject ws a -> a
forall ws a. Eq a => a -> JObject ws a -> Bool
forall ws a. Num a => JObject ws a -> a
forall ws a. Ord a => JObject ws a -> a
forall m a. Monoid m => (a -> m) -> JObject ws a -> m
forall ws m. Monoid m => JObject ws m -> m
forall ws a. JObject ws a -> Bool
forall ws a. JObject ws a -> Int
forall ws a. JObject ws a -> [a]
forall b a. (b -> a -> b) -> b -> JObject ws a -> b
forall a b. (a -> b -> b) -> b -> JObject ws a -> b
forall ws a. (a -> a -> a) -> JObject ws a -> a
forall ws m a. Monoid m => (a -> m) -> JObject ws a -> m
forall ws b a. (b -> a -> b) -> b -> JObject ws a -> b
forall ws a b. (a -> b -> b) -> b -> JObject ws a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: JObject ws a -> a
$cproduct :: forall ws a. Num a => JObject ws a -> a
sum :: JObject ws a -> a
$csum :: forall ws a. Num a => JObject ws a -> a
minimum :: JObject ws a -> a
$cminimum :: forall ws a. Ord a => JObject ws a -> a
maximum :: JObject ws a -> a
$cmaximum :: forall ws a. Ord a => JObject ws a -> a
elem :: a -> JObject ws a -> Bool
$celem :: forall ws a. Eq a => a -> JObject ws a -> Bool
length :: JObject ws a -> Int
$clength :: forall ws a. JObject ws a -> Int
null :: JObject ws a -> Bool
$cnull :: forall ws a. JObject ws a -> Bool
toList :: JObject ws a -> [a]
$ctoList :: forall ws a. JObject ws a -> [a]
foldl1 :: (a -> a -> a) -> JObject ws a -> a
$cfoldl1 :: forall ws a. (a -> a -> a) -> JObject ws a -> a
foldr1 :: (a -> a -> a) -> JObject ws a -> a
$cfoldr1 :: forall ws a. (a -> a -> a) -> JObject ws a -> a
foldl' :: (b -> a -> b) -> b -> JObject ws a -> b
$cfoldl' :: forall ws b a. (b -> a -> b) -> b -> JObject ws a -> b
foldl :: (b -> a -> b) -> b -> JObject ws a -> b
$cfoldl :: forall ws b a. (b -> a -> b) -> b -> JObject ws a -> b
foldr' :: (a -> b -> b) -> b -> JObject ws a -> b
$cfoldr' :: forall ws a b. (a -> b -> b) -> b -> JObject ws a -> b
foldr :: (a -> b -> b) -> b -> JObject ws a -> b
$cfoldr :: forall ws a b. (a -> b -> b) -> b -> JObject ws a -> b
foldMap' :: (a -> m) -> JObject ws a -> m
$cfoldMap' :: forall ws m a. Monoid m => (a -> m) -> JObject ws a -> m
foldMap :: (a -> m) -> JObject ws a -> m
$cfoldMap :: forall ws m a. Monoid m => (a -> m) -> JObject ws a -> m
fold :: JObject ws m -> m
$cfold :: forall ws m. Monoid m => JObject ws m -> m
Foldable, Functor (JObject ws)
Foldable (JObject ws)
Functor (JObject ws)
-> Foldable (JObject ws)
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> JObject ws a -> f (JObject ws b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    JObject ws (f a) -> f (JObject ws a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> JObject ws a -> m (JObject ws b))
-> (forall (m :: * -> *) a.
    Monad m =>
    JObject ws (m a) -> m (JObject ws a))
-> Traversable (JObject ws)
(a -> f b) -> JObject ws a -> f (JObject ws b)
forall ws. Functor (JObject ws)
forall ws. Foldable (JObject ws)
forall ws (m :: * -> *) a.
Monad m =>
JObject ws (m a) -> m (JObject ws a)
forall ws (f :: * -> *) a.
Applicative f =>
JObject ws (f a) -> f (JObject ws a)
forall ws (m :: * -> *) a b.
Monad m =>
(a -> m b) -> JObject ws a -> m (JObject ws b)
forall ws (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> JObject ws a -> f (JObject ws b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
JObject ws (m a) -> m (JObject ws a)
forall (f :: * -> *) a.
Applicative f =>
JObject ws (f a) -> f (JObject ws a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> JObject ws a -> m (JObject ws b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> JObject ws a -> f (JObject ws b)
sequence :: JObject ws (m a) -> m (JObject ws a)
$csequence :: forall ws (m :: * -> *) a.
Monad m =>
JObject ws (m a) -> m (JObject ws a)
mapM :: (a -> m b) -> JObject ws a -> m (JObject ws b)
$cmapM :: forall ws (m :: * -> *) a b.
Monad m =>
(a -> m b) -> JObject ws a -> m (JObject ws b)
sequenceA :: JObject ws (f a) -> f (JObject ws a)
$csequenceA :: forall ws (f :: * -> *) a.
Applicative f =>
JObject ws (f a) -> f (JObject ws a)
traverse :: (a -> f b) -> JObject ws a -> f (JObject ws b)
$ctraverse :: forall ws (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> JObject ws a -> f (JObject ws b)
$cp2Traversable :: forall ws. Foldable (JObject ws)
$cp1Traversable :: forall ws. Functor (JObject ws)
Traversable)

instance (Semigroup ws, Monoid ws) => AsEmpty (JObject ws a) where
  _Empty :: p () (f ()) -> p (JObject ws a) (f (JObject ws a))
_Empty = JObject ws a -> (JObject ws a -> Bool) -> Prism' (JObject ws a) ()
forall a. a -> (a -> Bool) -> Prism' a ()
nearly (Tagged
  (CommaSeparated ws (JAssoc ws a))
  (Identity (CommaSeparated ws (JAssoc ws a)))
-> Tagged (JObject ws a) (Identity (JObject ws a))
forall s t. Rewrapping s t => Iso s t (Unwrapped s) (Unwrapped t)
_Wrapped (Tagged
   (CommaSeparated ws (JAssoc ws a))
   (Identity (CommaSeparated ws (JAssoc ws a)))
 -> Tagged (JObject ws a) (Identity (JObject ws a)))
-> CommaSeparated ws (JAssoc ws a) -> JObject ws a
forall t b. AReview t b -> b -> t
# Tagged () (Identity ())
-> Tagged
     (CommaSeparated ws (JAssoc ws a))
     (Identity (CommaSeparated ws (JAssoc ws a)))
forall a. AsEmpty a => Prism' a ()
_Empty (Tagged () (Identity ())
 -> Tagged
      (CommaSeparated ws (JAssoc ws a))
      (Identity (CommaSeparated ws (JAssoc ws a))))
-> () -> CommaSeparated ws (JAssoc ws a)
forall t b. AReview t b -> b -> t
# ()) (JObject ws a -> Getting Bool (JObject ws a) Bool -> Bool
forall s a. s -> Getting a s a -> a
^. (CommaSeparated ws (JAssoc ws a)
 -> Const Bool (CommaSeparated ws (JAssoc ws a)))
-> JObject ws a -> Const Bool (JObject ws a)
forall s t. Rewrapping s t => Iso s t (Unwrapped s) (Unwrapped t)
_Wrapped ((CommaSeparated ws (JAssoc ws a)
  -> Const Bool (CommaSeparated ws (JAssoc ws a)))
 -> JObject ws a -> Const Bool (JObject ws a))
-> ((Bool -> Const Bool Bool)
    -> CommaSeparated ws (JAssoc ws a)
    -> Const Bool (CommaSeparated ws (JAssoc ws a)))
-> Getting Bool (JObject ws a) Bool
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (CommaSeparated ws (JAssoc ws a) -> Bool)
-> (Bool -> Const Bool Bool)
-> CommaSeparated ws (JAssoc ws a)
-> Const Bool (CommaSeparated ws (JAssoc ws a))
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to (APrism
  (CommaSeparated ws (JAssoc ws a))
  (CommaSeparated ws (JAssoc ws a))
  ()
  ()
-> CommaSeparated ws (JAssoc ws a) -> Bool
forall s t a b. APrism s t a b -> s -> Bool
is APrism
  (CommaSeparated ws (JAssoc ws a))
  (CommaSeparated ws (JAssoc ws a))
  ()
  ()
forall a. AsEmpty a => Prism' a ()
_Empty))
  {-# INLINE _Empty #-}

instance JObject ws a ~ t => Rewrapped (JObject ws a) t

instance Wrapped (JObject ws a) where
  type Unwrapped (JObject ws a) = CommaSeparated ws (JAssoc ws a)
  _Wrapped' :: p (Unwrapped (JObject ws a)) (f (Unwrapped (JObject ws a)))
-> p (JObject ws a) (f (JObject ws a))
_Wrapped' = (JObject ws a -> CommaSeparated ws (JAssoc ws a))
-> (CommaSeparated ws (JAssoc ws a) -> JObject ws a)
-> Iso
     (JObject ws a)
     (JObject ws a)
     (CommaSeparated ws (JAssoc ws a))
     (CommaSeparated ws (JAssoc ws a))
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso (\ (JObject CommaSeparated ws (JAssoc ws a)
x) -> CommaSeparated ws (JAssoc ws a)
x) CommaSeparated ws (JAssoc ws a) -> JObject ws a
forall ws a. CommaSeparated ws (JAssoc ws a) -> JObject ws a
JObject

type instance IxValue (JObject ws a) = a
type instance Index (JObject ws a)   = Int

instance (Semigroup ws, Monoid ws) => Semigroup (JObject ws a) where
  (JObject CommaSeparated ws (JAssoc ws a)
a) <> :: JObject ws a -> JObject ws a -> JObject ws a
<> (JObject CommaSeparated ws (JAssoc ws a)
b) = CommaSeparated ws (JAssoc ws a) -> JObject ws a
forall ws a. CommaSeparated ws (JAssoc ws a) -> JObject ws a
JObject (CommaSeparated ws (JAssoc ws a)
a CommaSeparated ws (JAssoc ws a)
-> CommaSeparated ws (JAssoc ws a)
-> CommaSeparated ws (JAssoc ws a)
forall a. Semigroup a => a -> a -> a
<> CommaSeparated ws (JAssoc ws a)
b)

instance (Semigroup ws, Monoid ws) => Monoid (JObject ws a) where
  mempty :: JObject ws a
mempty = CommaSeparated ws (JAssoc ws a) -> JObject ws a
forall ws a. CommaSeparated ws (JAssoc ws a) -> JObject ws a
JObject CommaSeparated ws (JAssoc ws a)
forall a. Monoid a => a
mempty
  mappend :: JObject ws a -> JObject ws a -> JObject ws a
mappend = JObject ws a -> JObject ws a -> JObject ws a
forall a. Semigroup a => a -> a -> a
(<>)

instance Bifunctor JObject where
  bimap :: (a -> b) -> (c -> d) -> JObject a c -> JObject b d
bimap a -> b
f c -> d
g (JObject CommaSeparated a (JAssoc a c)
c) = CommaSeparated b (JAssoc b d) -> JObject b d
forall ws a. CommaSeparated ws (JAssoc ws a) -> JObject ws a
JObject ((a -> b)
-> (JAssoc a c -> JAssoc b d)
-> CommaSeparated a (JAssoc a c)
-> CommaSeparated b (JAssoc b d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap a -> b
f ((a -> b) -> (c -> d) -> JAssoc a c -> JAssoc b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap a -> b
f c -> d
g) CommaSeparated a (JAssoc a c)
c)

instance Bifoldable JObject where
  bifoldMap :: (a -> m) -> (b -> m) -> JObject a b -> m
bifoldMap a -> m
f b -> m
g (JObject CommaSeparated a (JAssoc a b)
c) = (a -> m) -> (JAssoc a b -> m) -> CommaSeparated a (JAssoc a b) -> m
forall (p :: * -> * -> *) m a b.
(Bifoldable p, Monoid m) =>
(a -> m) -> (b -> m) -> p a b -> m
bifoldMap a -> m
f ((a -> m) -> (b -> m) -> JAssoc a b -> m
forall (p :: * -> * -> *) m a b.
(Bifoldable p, Monoid m) =>
(a -> m) -> (b -> m) -> p a b -> m
bifoldMap a -> m
f b -> m
g) CommaSeparated a (JAssoc a b)
c

instance Bitraversable JObject where
  bitraverse :: (a -> f c) -> (b -> f d) -> JObject a b -> f (JObject c d)
bitraverse a -> f c
f b -> f d
g (JObject CommaSeparated a (JAssoc a b)
c) = CommaSeparated c (JAssoc c d) -> JObject c d
forall ws a. CommaSeparated ws (JAssoc ws a) -> JObject ws a
JObject (CommaSeparated c (JAssoc c d) -> JObject c d)
-> f (CommaSeparated c (JAssoc c d)) -> f (JObject c d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f c)
-> (JAssoc a b -> f (JAssoc c d))
-> CommaSeparated a (JAssoc a b)
-> f (CommaSeparated c (JAssoc c d))
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse a -> f c
f ((a -> f c) -> (b -> f d) -> JAssoc a b -> f (JAssoc c d)
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse a -> f c
f b -> f d
g) CommaSeparated a (JAssoc a b)
c

-- | Without having an obviously correct "first" or "last" decision on which
-- 'Waargonaut.Types.JString' key is the "right" one to use, a 'JObject' can only be indexed by a
-- numeric value.
instance Monoid ws => Ixed (JObject ws a) where
  ix :: Index (JObject ws a)
-> Traversal' (JObject ws a) (IxValue (JObject ws a))
ix Index (JObject ws a)
i IxValue (JObject ws a) -> f (IxValue (JObject ws a))
f (JObject CommaSeparated ws (JAssoc ws a)
cs) = CommaSeparated ws (JAssoc ws a) -> JObject ws a
forall ws a. CommaSeparated ws (JAssoc ws a) -> JObject ws a
JObject (CommaSeparated ws (JAssoc ws a) -> JObject ws a)
-> f (CommaSeparated ws (JAssoc ws a)) -> f (JObject ws a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Index (CommaSeparated ws (JAssoc ws a))
-> (IxValue (CommaSeparated ws (JAssoc ws a))
    -> f (IxValue (CommaSeparated ws (JAssoc ws a))))
-> CommaSeparated ws (JAssoc ws a)
-> f (CommaSeparated ws (JAssoc ws a))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index (CommaSeparated ws (JAssoc ws a))
Index (JObject ws a)
i ((a -> f a) -> JAssoc ws a -> f (JAssoc ws a)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f a
IxValue (JObject ws a) -> f (IxValue (JObject ws a))
f) CommaSeparated ws (JAssoc ws a)
cs

-- | Type class to represent something that has a 'JObject' within it.
class HasJObject c ws a | c -> ws a where
  jObject :: Lens' c (JObject ws a)

instance HasJObject (JObject ws a) ws a where
  jObject :: (JObject ws a -> f (JObject ws a))
-> JObject ws a -> f (JObject ws a)
jObject = (JObject ws a -> f (JObject ws a))
-> JObject ws a -> f (JObject ws a)
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id

-- | This is a newtype around our 'JObject' for when we want to use the
-- "map-like" representation of our JSON object. This data type will enforce that
-- the first key found is treated as the desired element, and all subsequent
-- occurrences of that key are discarded.
newtype MapLikeObj ws a = MLO
  { MapLikeObj ws a -> JObject ws a
fromMapLikeObj :: JObject ws a -- ^ Access the underlying 'JObject'.
  }
  deriving (MapLikeObj ws a -> MapLikeObj ws a -> Bool
(MapLikeObj ws a -> MapLikeObj ws a -> Bool)
-> (MapLikeObj ws a -> MapLikeObj ws a -> Bool)
-> Eq (MapLikeObj ws a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall ws a.
(Eq ws, Eq a) =>
MapLikeObj ws a -> MapLikeObj ws a -> Bool
/= :: MapLikeObj ws a -> MapLikeObj ws a -> Bool
$c/= :: forall ws a.
(Eq ws, Eq a) =>
MapLikeObj ws a -> MapLikeObj ws a -> Bool
== :: MapLikeObj ws a -> MapLikeObj ws a -> Bool
$c== :: forall ws a.
(Eq ws, Eq a) =>
MapLikeObj ws a -> MapLikeObj ws a -> Bool
Eq, Int -> MapLikeObj ws a -> ShowS
[MapLikeObj ws a] -> ShowS
MapLikeObj ws a -> String
(Int -> MapLikeObj ws a -> ShowS)
-> (MapLikeObj ws a -> String)
-> ([MapLikeObj ws a] -> ShowS)
-> Show (MapLikeObj ws a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall ws a. (Show ws, Show a) => Int -> MapLikeObj ws a -> ShowS
forall ws a. (Show ws, Show a) => [MapLikeObj ws a] -> ShowS
forall ws a. (Show ws, Show a) => MapLikeObj ws a -> String
showList :: [MapLikeObj ws a] -> ShowS
$cshowList :: forall ws a. (Show ws, Show a) => [MapLikeObj ws a] -> ShowS
show :: MapLikeObj ws a -> String
$cshow :: forall ws a. (Show ws, Show a) => MapLikeObj ws a -> String
showsPrec :: Int -> MapLikeObj ws a -> ShowS
$cshowsPrec :: forall ws a. (Show ws, Show a) => Int -> MapLikeObj ws a -> ShowS
Show, a -> MapLikeObj ws b -> MapLikeObj ws a
(a -> b) -> MapLikeObj ws a -> MapLikeObj ws b
(forall a b. (a -> b) -> MapLikeObj ws a -> MapLikeObj ws b)
-> (forall a b. a -> MapLikeObj ws b -> MapLikeObj ws a)
-> Functor (MapLikeObj ws)
forall a b. a -> MapLikeObj ws b -> MapLikeObj ws a
forall a b. (a -> b) -> MapLikeObj ws a -> MapLikeObj ws b
forall ws a b. a -> MapLikeObj ws b -> MapLikeObj ws a
forall ws a b. (a -> b) -> MapLikeObj ws a -> MapLikeObj ws b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> MapLikeObj ws b -> MapLikeObj ws a
$c<$ :: forall ws a b. a -> MapLikeObj ws b -> MapLikeObj ws a
fmap :: (a -> b) -> MapLikeObj ws a -> MapLikeObj ws b
$cfmap :: forall ws a b. (a -> b) -> MapLikeObj ws a -> MapLikeObj ws b
Functor, MapLikeObj ws a -> Bool
(a -> m) -> MapLikeObj ws a -> m
(a -> b -> b) -> b -> MapLikeObj ws a -> b
(forall m. Monoid m => MapLikeObj ws m -> m)
-> (forall m a. Monoid m => (a -> m) -> MapLikeObj ws a -> m)
-> (forall m a. Monoid m => (a -> m) -> MapLikeObj ws a -> m)
-> (forall a b. (a -> b -> b) -> b -> MapLikeObj ws a -> b)
-> (forall a b. (a -> b -> b) -> b -> MapLikeObj ws a -> b)
-> (forall b a. (b -> a -> b) -> b -> MapLikeObj ws a -> b)
-> (forall b a. (b -> a -> b) -> b -> MapLikeObj ws a -> b)
-> (forall a. (a -> a -> a) -> MapLikeObj ws a -> a)
-> (forall a. (a -> a -> a) -> MapLikeObj ws a -> a)
-> (forall a. MapLikeObj ws a -> [a])
-> (forall a. MapLikeObj ws a -> Bool)
-> (forall a. MapLikeObj ws a -> Int)
-> (forall a. Eq a => a -> MapLikeObj ws a -> Bool)
-> (forall a. Ord a => MapLikeObj ws a -> a)
-> (forall a. Ord a => MapLikeObj ws a -> a)
-> (forall a. Num a => MapLikeObj ws a -> a)
-> (forall a. Num a => MapLikeObj ws a -> a)
-> Foldable (MapLikeObj ws)
forall a. Eq a => a -> MapLikeObj ws a -> Bool
forall a. Num a => MapLikeObj ws a -> a
forall a. Ord a => MapLikeObj ws a -> a
forall m. Monoid m => MapLikeObj ws m -> m
forall a. MapLikeObj ws a -> Bool
forall a. MapLikeObj ws a -> Int
forall a. MapLikeObj ws a -> [a]
forall a. (a -> a -> a) -> MapLikeObj ws a -> a
forall ws a. Eq a => a -> MapLikeObj ws a -> Bool
forall ws a. Num a => MapLikeObj ws a -> a
forall ws a. Ord a => MapLikeObj ws a -> a
forall m a. Monoid m => (a -> m) -> MapLikeObj ws a -> m
forall ws m. Monoid m => MapLikeObj ws m -> m
forall ws a. MapLikeObj ws a -> Bool
forall ws a. MapLikeObj ws a -> Int
forall ws a. MapLikeObj ws a -> [a]
forall b a. (b -> a -> b) -> b -> MapLikeObj ws a -> b
forall a b. (a -> b -> b) -> b -> MapLikeObj ws a -> b
forall ws a. (a -> a -> a) -> MapLikeObj ws a -> a
forall ws m a. Monoid m => (a -> m) -> MapLikeObj ws a -> m
forall ws b a. (b -> a -> b) -> b -> MapLikeObj ws a -> b
forall ws a b. (a -> b -> b) -> b -> MapLikeObj ws a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: MapLikeObj ws a -> a
$cproduct :: forall ws a. Num a => MapLikeObj ws a -> a
sum :: MapLikeObj ws a -> a
$csum :: forall ws a. Num a => MapLikeObj ws a -> a
minimum :: MapLikeObj ws a -> a
$cminimum :: forall ws a. Ord a => MapLikeObj ws a -> a
maximum :: MapLikeObj ws a -> a
$cmaximum :: forall ws a. Ord a => MapLikeObj ws a -> a
elem :: a -> MapLikeObj ws a -> Bool
$celem :: forall ws a. Eq a => a -> MapLikeObj ws a -> Bool
length :: MapLikeObj ws a -> Int
$clength :: forall ws a. MapLikeObj ws a -> Int
null :: MapLikeObj ws a -> Bool
$cnull :: forall ws a. MapLikeObj ws a -> Bool
toList :: MapLikeObj ws a -> [a]
$ctoList :: forall ws a. MapLikeObj ws a -> [a]
foldl1 :: (a -> a -> a) -> MapLikeObj ws a -> a
$cfoldl1 :: forall ws a. (a -> a -> a) -> MapLikeObj ws a -> a
foldr1 :: (a -> a -> a) -> MapLikeObj ws a -> a
$cfoldr1 :: forall ws a. (a -> a -> a) -> MapLikeObj ws a -> a
foldl' :: (b -> a -> b) -> b -> MapLikeObj ws a -> b
$cfoldl' :: forall ws b a. (b -> a -> b) -> b -> MapLikeObj ws a -> b
foldl :: (b -> a -> b) -> b -> MapLikeObj ws a -> b
$cfoldl :: forall ws b a. (b -> a -> b) -> b -> MapLikeObj ws a -> b
foldr' :: (a -> b -> b) -> b -> MapLikeObj ws a -> b
$cfoldr' :: forall ws a b. (a -> b -> b) -> b -> MapLikeObj ws a -> b
foldr :: (a -> b -> b) -> b -> MapLikeObj ws a -> b
$cfoldr :: forall ws a b. (a -> b -> b) -> b -> MapLikeObj ws a -> b
foldMap' :: (a -> m) -> MapLikeObj ws a -> m
$cfoldMap' :: forall ws m a. Monoid m => (a -> m) -> MapLikeObj ws a -> m
foldMap :: (a -> m) -> MapLikeObj ws a -> m
$cfoldMap :: forall ws m a. Monoid m => (a -> m) -> MapLikeObj ws a -> m
fold :: MapLikeObj ws m -> m
$cfold :: forall ws m. Monoid m => MapLikeObj ws m -> m
Foldable, Functor (MapLikeObj ws)
Foldable (MapLikeObj ws)
Functor (MapLikeObj ws)
-> Foldable (MapLikeObj ws)
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> MapLikeObj ws a -> f (MapLikeObj ws b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    MapLikeObj ws (f a) -> f (MapLikeObj ws a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> MapLikeObj ws a -> m (MapLikeObj ws b))
-> (forall (m :: * -> *) a.
    Monad m =>
    MapLikeObj ws (m a) -> m (MapLikeObj ws a))
-> Traversable (MapLikeObj ws)
(a -> f b) -> MapLikeObj ws a -> f (MapLikeObj ws b)
forall ws. Functor (MapLikeObj ws)
forall ws. Foldable (MapLikeObj ws)
forall ws (m :: * -> *) a.
Monad m =>
MapLikeObj ws (m a) -> m (MapLikeObj ws a)
forall ws (f :: * -> *) a.
Applicative f =>
MapLikeObj ws (f a) -> f (MapLikeObj ws a)
forall ws (m :: * -> *) a b.
Monad m =>
(a -> m b) -> MapLikeObj ws a -> m (MapLikeObj ws b)
forall ws (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> MapLikeObj ws a -> f (MapLikeObj ws b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
MapLikeObj ws (m a) -> m (MapLikeObj ws a)
forall (f :: * -> *) a.
Applicative f =>
MapLikeObj ws (f a) -> f (MapLikeObj ws a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> MapLikeObj ws a -> m (MapLikeObj ws b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> MapLikeObj ws a -> f (MapLikeObj ws b)
sequence :: MapLikeObj ws (m a) -> m (MapLikeObj ws a)
$csequence :: forall ws (m :: * -> *) a.
Monad m =>
MapLikeObj ws (m a) -> m (MapLikeObj ws a)
mapM :: (a -> m b) -> MapLikeObj ws a -> m (MapLikeObj ws b)
$cmapM :: forall ws (m :: * -> *) a b.
Monad m =>
(a -> m b) -> MapLikeObj ws a -> m (MapLikeObj ws b)
sequenceA :: MapLikeObj ws (f a) -> f (MapLikeObj ws a)
$csequenceA :: forall ws (f :: * -> *) a.
Applicative f =>
MapLikeObj ws (f a) -> f (MapLikeObj ws a)
traverse :: (a -> f b) -> MapLikeObj ws a -> f (MapLikeObj ws b)
$ctraverse :: forall ws (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> MapLikeObj ws a -> f (MapLikeObj ws b)
$cp2Traversable :: forall ws. Foldable (MapLikeObj ws)
$cp1Traversable :: forall ws. Functor (MapLikeObj ws)
Traversable)

-- |
-- 'Control.Lens.Prism' for working with a 'JObject' as a 'MapLikeObj'. This optic will keep
-- the first unique key on a given 'JObject' and this information is not
-- recoverable. If you want to create a 'MapLikeObj' from a 'JObject' and keep
-- what is removed, then use the 'toMapLikeObj' function.
--
_MapLikeObj :: (Semigroup ws, Monoid ws) => Prism' (JObject ws a) (MapLikeObj ws a)
_MapLikeObj :: Prism' (JObject ws a) (MapLikeObj ws a)
_MapLikeObj = (MapLikeObj ws a -> JObject ws a)
-> (JObject ws a -> Maybe (MapLikeObj ws a))
-> Prism' (JObject ws a) (MapLikeObj ws a)
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' MapLikeObj ws a -> JObject ws a
forall ws a. MapLikeObj ws a -> JObject ws a
fromMapLikeObj (MapLikeObj ws a -> Maybe (MapLikeObj ws a)
forall a. a -> Maybe a
Just (MapLikeObj ws a -> Maybe (MapLikeObj ws a))
-> (JObject ws a -> MapLikeObj ws a)
-> JObject ws a
-> Maybe (MapLikeObj ws a)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (MapLikeObj ws a, [JAssoc ws a]) -> MapLikeObj ws a
forall a b. (a, b) -> a
fst ((MapLikeObj ws a, [JAssoc ws a]) -> MapLikeObj ws a)
-> (JObject ws a -> (MapLikeObj ws a, [JAssoc ws a]))
-> JObject ws a
-> MapLikeObj ws a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. JObject ws a -> (MapLikeObj ws a, [JAssoc ws a])
forall ws a.
(Semigroup ws, Monoid ws) =>
JObject ws a -> (MapLikeObj ws a, [JAssoc ws a])
toMapLikeObj)

instance MapLikeObj ws a ~ t => Rewrapped (MapLikeObj ws a) t

instance Wrapped (MapLikeObj ws a) where
  type Unwrapped (MapLikeObj ws a) = JObject ws a
  _Wrapped' :: p (Unwrapped (MapLikeObj ws a)) (f (Unwrapped (MapLikeObj ws a)))
-> p (MapLikeObj ws a) (f (MapLikeObj ws a))
_Wrapped' = (MapLikeObj ws a -> JObject ws a)
-> (JObject ws a -> MapLikeObj ws a)
-> Iso
     (MapLikeObj ws a) (MapLikeObj ws a) (JObject ws a) (JObject ws a)
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso (\ (MLO JObject ws a
x) -> JObject ws a
x) JObject ws a -> MapLikeObj ws a
forall ws a. JObject ws a -> MapLikeObj ws a
MLO

instance (Monoid ws, Semigroup ws) => AsEmpty (MapLikeObj ws a) where
  _Empty :: p () (f ()) -> p (MapLikeObj ws a) (f (MapLikeObj ws a))
_Empty = MapLikeObj ws a
-> (MapLikeObj ws a -> Bool) -> Prism' (MapLikeObj ws a) ()
forall a. a -> (a -> Bool) -> Prism' a ()
nearly (Tagged (JObject ws a) (Identity (JObject ws a))
-> Tagged (MapLikeObj ws a) (Identity (MapLikeObj ws a))
forall s t. Rewrapping s t => Iso s t (Unwrapped s) (Unwrapped t)
_Wrapped (Tagged (JObject ws a) (Identity (JObject ws a))
 -> Tagged (MapLikeObj ws a) (Identity (MapLikeObj ws a)))
-> JObject ws a -> MapLikeObj ws a
forall t b. AReview t b -> b -> t
# Tagged () (Identity ())
-> Tagged (JObject ws a) (Identity (JObject ws a))
forall a. AsEmpty a => Prism' a ()
_Empty (Tagged () (Identity ())
 -> Tagged (JObject ws a) (Identity (JObject ws a)))
-> () -> JObject ws a
forall t b. AReview t b -> b -> t
# ()) (MapLikeObj ws a -> Getting Bool (MapLikeObj ws a) Bool -> Bool
forall s a. s -> Getting a s a -> a
^. (JObject ws a -> Const Bool (JObject ws a))
-> MapLikeObj ws a -> Const Bool (MapLikeObj ws a)
forall s t. Rewrapping s t => Iso s t (Unwrapped s) (Unwrapped t)
_Wrapped ((JObject ws a -> Const Bool (JObject ws a))
 -> MapLikeObj ws a -> Const Bool (MapLikeObj ws a))
-> ((Bool -> Const Bool Bool)
    -> JObject ws a -> Const Bool (JObject ws a))
-> Getting Bool (MapLikeObj ws a) Bool
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (JObject ws a -> Bool)
-> (Bool -> Const Bool Bool)
-> JObject ws a
-> Const Bool (JObject ws a)
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to (APrism (JObject ws a) (JObject ws a) () () -> JObject ws a -> Bool
forall s t a b. APrism s t a b -> s -> Bool
is APrism (JObject ws a) (JObject ws a) () ()
forall a. AsEmpty a => Prism' a ()
_Empty))
  {-# INLINE _Empty #-}

type instance IxValue (MapLikeObj ws a) = a
type instance Index (MapLikeObj ws a)   = Text

instance Monoid ws => Ixed (MapLikeObj ws a) where

-- | Unlike 'JObject' this type has an opinionated stance on which key is the
-- "correct" one, so we're able to have an 'At' instance.
instance Monoid ws => At (MapLikeObj ws a) where
  at :: Index (MapLikeObj ws a)
-> Lens' (MapLikeObj ws a) (Maybe (IxValue (MapLikeObj ws a)))
at Index (MapLikeObj ws a)
k Maybe (IxValue (MapLikeObj ws a))
-> f (Maybe (IxValue (MapLikeObj ws a)))
f (MLO (JObject CommaSeparated ws (JAssoc ws a)
cs)) = Text
-> (Maybe a -> f (Maybe a))
-> Maybe (JAssoc ws a)
-> f (Maybe (JAssoc ws a))
forall ws (f :: * -> *) a.
(Monoid ws, Functor f) =>
Text
-> (Maybe a -> f (Maybe a))
-> Maybe (JAssoc ws a)
-> f (Maybe (JAssoc ws a))
jAssocAlterF Text
Index (MapLikeObj ws a)
k Maybe a -> f (Maybe a)
Maybe (IxValue (MapLikeObj ws a))
-> f (Maybe (IxValue (MapLikeObj ws a)))
f ((JAssoc ws a -> Bool)
-> CommaSeparated ws (JAssoc ws a) -> Maybe (JAssoc ws a)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (Text -> JAssoc ws a -> Bool
forall ws a. Text -> JAssoc ws a -> Bool
textKeyMatch Text
Index (MapLikeObj ws a)
k) CommaSeparated ws (JAssoc ws a)
cs) f (Maybe (JAssoc ws a))
-> (Maybe (JAssoc ws a) -> MapLikeObj ws a) -> f (MapLikeObj ws a)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&>
    JObject ws a -> MapLikeObj ws a
forall ws a. JObject ws a -> MapLikeObj ws a
MLO (JObject ws a -> MapLikeObj ws a)
-> (Maybe (JAssoc ws a) -> JObject ws a)
-> Maybe (JAssoc ws a)
-> MapLikeObj ws a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. CommaSeparated ws (JAssoc ws a) -> JObject ws a
forall ws a. CommaSeparated ws (JAssoc ws a) -> JObject ws a
JObject (CommaSeparated ws (JAssoc ws a) -> JObject ws a)
-> (Maybe (JAssoc ws a) -> CommaSeparated ws (JAssoc ws a))
-> Maybe (JAssoc ws a)
-> JObject ws a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. CommaSeparated ws (JAssoc ws a)
-> (JAssoc ws a -> CommaSeparated ws (JAssoc ws a))
-> Maybe (JAssoc ws a)
-> CommaSeparated ws (JAssoc ws a)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ((JAssoc ws a -> Bool)
-> CommaSeparated ws (JAssoc ws a)
-> CommaSeparated ws (JAssoc ws a)
forall (f :: * -> *) a. Filterable f => (a -> Bool) -> f a -> f a
W.filter (Bool -> Bool
not (Bool -> Bool) -> (JAssoc ws a -> Bool) -> JAssoc ws a -> Bool
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text -> JAssoc ws a -> Bool
forall ws a. Text -> JAssoc ws a -> Bool
textKeyMatch Text
Index (MapLikeObj ws a)
k) CommaSeparated ws (JAssoc ws a)
cs) (JAssoc ws a
-> CommaSeparated ws (JAssoc ws a)
-> CommaSeparated ws (JAssoc ws a)
forall s a. Cons s s a a => a -> s -> s
`cons` CommaSeparated ws (JAssoc ws a)
cs)

instance Bifunctor MapLikeObj where
  bimap :: (a -> b) -> (c -> d) -> MapLikeObj a c -> MapLikeObj b d
bimap a -> b
f c -> d
g (MLO JObject a c
o) = JObject b d -> MapLikeObj b d
forall ws a. JObject ws a -> MapLikeObj ws a
MLO ((a -> b) -> (c -> d) -> JObject a c -> JObject b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap a -> b
f c -> d
g JObject a c
o)

instance Bifoldable MapLikeObj where
  bifoldMap :: (a -> m) -> (b -> m) -> MapLikeObj a b -> m
bifoldMap a -> m
f b -> m
g (MLO JObject a b
o) = (a -> m) -> (b -> m) -> JObject a b -> m
forall (p :: * -> * -> *) m a b.
(Bifoldable p, Monoid m) =>
(a -> m) -> (b -> m) -> p a b -> m
bifoldMap a -> m
f b -> m
g JObject a b
o

instance Bitraversable MapLikeObj where
  bitraverse :: (a -> f c) -> (b -> f d) -> MapLikeObj a b -> f (MapLikeObj c d)
bitraverse a -> f c
f b -> f d
g (MLO JObject a b
o) = JObject c d -> MapLikeObj c d
forall ws a. JObject ws a -> MapLikeObj ws a
MLO (JObject c d -> MapLikeObj c d)
-> f (JObject c d) -> f (MapLikeObj c d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f c) -> (b -> f d) -> JObject a b -> f (JObject c d)
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse a -> f c
f b -> f d
g JObject a b
o

-- | Take a 'JObject' and produce a 'MapLikeObj' where the first key is
-- considered the unique value. Subsequence occurrences of that key and it's value
-- are collected and returned as a list.
toMapLikeObj :: (Semigroup ws, Monoid ws) => JObject ws a -> (MapLikeObj ws a, [JAssoc ws a])
toMapLikeObj :: JObject ws a -> (MapLikeObj ws a, [JAssoc ws a])
toMapLikeObj (JObject CommaSeparated ws (JAssoc ws a)
xs) = (\([JString]
_,CommaSeparated ws (JAssoc ws a)
a,[JAssoc ws a]
b) -> (JObject ws a -> MapLikeObj ws a
forall ws a. JObject ws a -> MapLikeObj ws a
MLO (CommaSeparated ws (JAssoc ws a) -> JObject ws a
forall ws a. CommaSeparated ws (JAssoc ws a) -> JObject ws a
JObject CommaSeparated ws (JAssoc ws a)
a), [JAssoc ws a]
b)) (([JString], CommaSeparated ws (JAssoc ws a), [JAssoc ws a])
 -> (MapLikeObj ws a, [JAssoc ws a]))
-> ([JString], CommaSeparated ws (JAssoc ws a), [JAssoc ws a])
-> (MapLikeObj ws a, [JAssoc ws a])
forall a b. (a -> b) -> a -> b
$ (JAssoc ws a
 -> ([JString], CommaSeparated ws (JAssoc ws a), [JAssoc ws a])
 -> ([JString], CommaSeparated ws (JAssoc ws a), [JAssoc ws a]))
-> ([JString], CommaSeparated ws (JAssoc ws a), [JAssoc ws a])
-> CommaSeparated ws (JAssoc ws a)
-> ([JString], CommaSeparated ws (JAssoc ws a), [JAssoc ws a])
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr JAssoc ws a
-> ([JString], CommaSeparated ws (JAssoc ws a), [JAssoc ws a])
-> ([JString], CommaSeparated ws (JAssoc ws a), [JAssoc ws a])
forall s ws a.
Cons s s (JAssoc ws a) (JAssoc ws a) =>
JAssoc ws a
-> ([JString], s, [JAssoc ws a]) -> ([JString], s, [JAssoc ws a])
f ([JString]
forall a. Monoid a => a
mempty,CommaSeparated ws (JAssoc ws a)
forall a. Monoid a => a
mempty,[JAssoc ws a]
forall a. Monoid a => a
mempty) CommaSeparated ws (JAssoc ws a)
xs
  where
    f :: JAssoc ws a
-> ([JString], s, [JAssoc ws a]) -> ([JString], s, [JAssoc ws a])
f JAssoc ws a
x ([JString]
ys,s
acc,[JAssoc ws a]
discards)
      | JAssoc ws a -> JString
forall ws a. JAssoc ws a -> JString
_jsonAssocKey JAssoc ws a
x JString -> [JString] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [JString]
ys = ([JString]
ys, s
acc, JAssoc ws a
xJAssoc ws a -> [JAssoc ws a] -> [JAssoc ws a]
forall a. a -> [a] -> [a]
:[JAssoc ws a]
discards)
      | Bool
otherwise                 = (JAssoc ws a -> JString
forall ws a. JAssoc ws a -> JString
_jsonAssocKey JAssoc ws a
xJString -> [JString] -> [JString]
forall a. a -> [a] -> [a]
:[JString]
ys, JAssoc ws a -> s -> s
forall s a. Cons s s a a => a -> s -> s
cons JAssoc ws a
x s
acc, [JAssoc ws a]
discards)

-- Compare a 'Text' to the key for a 'JAssoc' value.
textKeyMatch :: Text -> JAssoc ws a -> Bool
textKeyMatch :: Text -> JAssoc ws a -> Bool
textKeyMatch Text
k = (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
k) (Text -> Bool) -> (JAssoc ws a -> Text) -> JAssoc ws a -> Bool
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (JAssoc ws a -> Getting Text (JAssoc ws a) Text -> Text
forall s a. s -> Getting a s a -> a
^. (JString -> Const Text JString)
-> JAssoc ws a -> Const Text (JAssoc ws a)
forall c ws a. HasJAssoc c ws a => Lens' c JString
jsonAssocKey ((JString -> Const Text JString)
 -> JAssoc ws a -> Const Text (JAssoc ws a))
-> ((Text -> Const Text Text) -> JString -> Const Text JString)
-> Getting Text (JAssoc ws a) Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Text -> Const Text Text) -> JString -> Const Text JString
forall (p :: * -> * -> *) (f :: * -> *).
(Profunctor p, Applicative f) =>
p Text (f Text) -> p JString (f JString)
_JStringText)

-- |
--
-- >>> testparse (parseJObject parseWhitespace parseWaargonaut) "{\"foo\":null }"
-- Right (JObject (CommaSeparated (WS []) (Just (Elems {_elemsElems = [], _elemsLast = Elem {_elemVal = JAssoc {_jsonAssocKey = JString' [UnescapedJChar (Unescaped 'f'),UnescapedJChar (Unescaped 'o'),UnescapedJChar (Unescaped 'o')], _jsonAssocKeyTrailingWS = WS [], _jsonAssocValPreceedingWS = WS [], _jsonAssocVal = Json (JNull (WS [Space]))}, _elemTrailing = Nothing}}))))
--
-- >>> testparse (parseJObject parseWhitespace parseWaargonaut) "{\"foo\":null, }"
-- Right (JObject (CommaSeparated (WS []) (Just (Elems {_elemsElems = [], _elemsLast = Elem {_elemVal = JAssoc {_jsonAssocKey = JString' [UnescapedJChar (Unescaped 'f'),UnescapedJChar (Unescaped 'o'),UnescapedJChar (Unescaped 'o')], _jsonAssocKeyTrailingWS = WS [], _jsonAssocValPreceedingWS = WS [], _jsonAssocVal = Json (JNull (WS []))}, _elemTrailing = Just (Comma,WS [Space])}}))))
--
parseJObject
  :: ( Monad f
     , CharParsing f
     )
  => f ws
  -> f a
  -> f (JObject ws a)
parseJObject :: f ws -> f a -> f (JObject ws a)
parseJObject f ws
ws f a
a = CommaSeparated ws (JAssoc ws a) -> JObject ws a
forall ws a. CommaSeparated ws (JAssoc ws a) -> JObject ws a
JObject (CommaSeparated ws (JAssoc ws a) -> JObject ws a)
-> f (CommaSeparated ws (JAssoc ws a)) -> f (JObject ws a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  f Char
-> f Char
-> f ws
-> f (JAssoc ws a)
-> f (CommaSeparated ws (JAssoc ws a))
forall (f :: * -> *) open close ws a.
(Monad f, CharParsing f) =>
f open -> f close -> f ws -> f a -> f (CommaSeparated ws a)
parseCommaSeparated (Char -> f Char
forall (m :: * -> *). CharParsing m => Char -> m Char
char Char
'{') (Char -> f Char
forall (m :: * -> *). CharParsing m => Char -> m Char
char Char
'}') f ws
ws (f ws -> f a -> f (JAssoc ws a)
forall (f :: * -> *) ws a.
(Monad f, CharParsing f) =>
f ws -> f a -> f (JAssoc ws a)
parseJAssoc f ws
ws f a
a)