{-# LANGUAGE CPP                 #-}
{-# LANGUAGE DataKinds           #-}
{-# LANGUAGE DeriveDataTypeable  #-}
{-# LANGUAGE DeriveFoldable      #-}
{-# LANGUAGE DeriveFunctor       #-}
{-# LANGUAGE DeriveTraversable   #-}
{-# LANGUAGE KindSignatures      #-}
{-# LANGUAGE ScopedTypeVariables #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Data.Aeson.Extra.SymTag
-- Copyright   :  (C) 2015-2016 Oleg Grenrus
-- License     :  BSD3
-- Maintainer  :  Oleg Grenrus <oleg.grenrus@iki.fi>
--
module Data.Aeson.Extra.SingObject (
    SingObject(..),
    mkSingObject,
    getSingObject,
    ) where

import Prelude ()
import Prelude.Compat

import Control.DeepSeq     (NFData (..))
import Data.Aeson
import Data.Aeson.Encoding (pair)
import Data.Aeson.Internal (JSONPathElement (Key))
import Data.Proxy          (Proxy (..))
import Data.String         (fromString)
import Data.Typeable       (Typeable)
import GHC.TypeLits        (KnownSymbol, Symbol, symbolVal)

import qualified Data.Text as T

#if MIN_VERSION_aeson(2,0,0)
import qualified Data.Aeson.Key    as Key
import qualified Data.Aeson.KeyMap as KM
#else
import qualified Data.HashMap.Strict as KM
#endif



-- | Singleton value object
--
-- > λ > decode "{\"value\": 42 }" :: Maybe (SingObject "value" Int)
-- > Just (SingObject 42)
--
-- > λ > encode (SingObject 42 :: SingObject "value" Int)
-- > "{\"value\":42}"
--
-- /Available with: base >=4.7/
newtype SingObject (s :: Symbol) a = SingObject a
  deriving (SingObject s a -> SingObject s a -> Bool
(SingObject s a -> SingObject s a -> Bool)
-> (SingObject s a -> SingObject s a -> Bool)
-> Eq (SingObject s a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (s :: Symbol) a.
Eq a =>
SingObject s a -> SingObject s a -> Bool
/= :: SingObject s a -> SingObject s a -> Bool
$c/= :: forall (s :: Symbol) a.
Eq a =>
SingObject s a -> SingObject s a -> Bool
== :: SingObject s a -> SingObject s a -> Bool
$c== :: forall (s :: Symbol) a.
Eq a =>
SingObject s a -> SingObject s a -> Bool
Eq, Eq (SingObject s a)
Eq (SingObject s a)
-> (SingObject s a -> SingObject s a -> Ordering)
-> (SingObject s a -> SingObject s a -> Bool)
-> (SingObject s a -> SingObject s a -> Bool)
-> (SingObject s a -> SingObject s a -> Bool)
-> (SingObject s a -> SingObject s a -> Bool)
-> (SingObject s a -> SingObject s a -> SingObject s a)
-> (SingObject s a -> SingObject s a -> SingObject s a)
-> Ord (SingObject s a)
SingObject s a -> SingObject s a -> Bool
SingObject s a -> SingObject s a -> Ordering
SingObject s a -> SingObject s a -> SingObject s a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall (s :: Symbol) a. Ord a => Eq (SingObject s a)
forall (s :: Symbol) a.
Ord a =>
SingObject s a -> SingObject s a -> Bool
forall (s :: Symbol) a.
Ord a =>
SingObject s a -> SingObject s a -> Ordering
forall (s :: Symbol) a.
Ord a =>
SingObject s a -> SingObject s a -> SingObject s a
min :: SingObject s a -> SingObject s a -> SingObject s a
$cmin :: forall (s :: Symbol) a.
Ord a =>
SingObject s a -> SingObject s a -> SingObject s a
max :: SingObject s a -> SingObject s a -> SingObject s a
$cmax :: forall (s :: Symbol) a.
Ord a =>
SingObject s a -> SingObject s a -> SingObject s a
>= :: SingObject s a -> SingObject s a -> Bool
$c>= :: forall (s :: Symbol) a.
Ord a =>
SingObject s a -> SingObject s a -> Bool
> :: SingObject s a -> SingObject s a -> Bool
$c> :: forall (s :: Symbol) a.
Ord a =>
SingObject s a -> SingObject s a -> Bool
<= :: SingObject s a -> SingObject s a -> Bool
$c<= :: forall (s :: Symbol) a.
Ord a =>
SingObject s a -> SingObject s a -> Bool
< :: SingObject s a -> SingObject s a -> Bool
$c< :: forall (s :: Symbol) a.
Ord a =>
SingObject s a -> SingObject s a -> Bool
compare :: SingObject s a -> SingObject s a -> Ordering
$ccompare :: forall (s :: Symbol) a.
Ord a =>
SingObject s a -> SingObject s a -> Ordering
$cp1Ord :: forall (s :: Symbol) a. Ord a => Eq (SingObject s a)
Ord, Int -> SingObject s a -> ShowS
[SingObject s a] -> ShowS
SingObject s a -> String
(Int -> SingObject s a -> ShowS)
-> (SingObject s a -> String)
-> ([SingObject s a] -> ShowS)
-> Show (SingObject s a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (s :: Symbol) a. Show a => Int -> SingObject s a -> ShowS
forall (s :: Symbol) a. Show a => [SingObject s a] -> ShowS
forall (s :: Symbol) a. Show a => SingObject s a -> String
showList :: [SingObject s a] -> ShowS
$cshowList :: forall (s :: Symbol) a. Show a => [SingObject s a] -> ShowS
show :: SingObject s a -> String
$cshow :: forall (s :: Symbol) a. Show a => SingObject s a -> String
showsPrec :: Int -> SingObject s a -> ShowS
$cshowsPrec :: forall (s :: Symbol) a. Show a => Int -> SingObject s a -> ShowS
Show, ReadPrec [SingObject s a]
ReadPrec (SingObject s a)
Int -> ReadS (SingObject s a)
ReadS [SingObject s a]
(Int -> ReadS (SingObject s a))
-> ReadS [SingObject s a]
-> ReadPrec (SingObject s a)
-> ReadPrec [SingObject s a]
-> Read (SingObject s a)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall (s :: Symbol) a. Read a => ReadPrec [SingObject s a]
forall (s :: Symbol) a. Read a => ReadPrec (SingObject s a)
forall (s :: Symbol) a. Read a => Int -> ReadS (SingObject s a)
forall (s :: Symbol) a. Read a => ReadS [SingObject s a]
readListPrec :: ReadPrec [SingObject s a]
$creadListPrec :: forall (s :: Symbol) a. Read a => ReadPrec [SingObject s a]
readPrec :: ReadPrec (SingObject s a)
$creadPrec :: forall (s :: Symbol) a. Read a => ReadPrec (SingObject s a)
readList :: ReadS [SingObject s a]
$creadList :: forall (s :: Symbol) a. Read a => ReadS [SingObject s a]
readsPrec :: Int -> ReadS (SingObject s a)
$creadsPrec :: forall (s :: Symbol) a. Read a => Int -> ReadS (SingObject s a)
Read, a -> SingObject s b -> SingObject s a
(a -> b) -> SingObject s a -> SingObject s b
(forall a b. (a -> b) -> SingObject s a -> SingObject s b)
-> (forall a b. a -> SingObject s b -> SingObject s a)
-> Functor (SingObject s)
forall a b. a -> SingObject s b -> SingObject s a
forall a b. (a -> b) -> SingObject s a -> SingObject s b
forall (s :: Symbol) a b. a -> SingObject s b -> SingObject s a
forall (s :: Symbol) a b.
(a -> b) -> SingObject s a -> SingObject s b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> SingObject s b -> SingObject s a
$c<$ :: forall (s :: Symbol) a b. a -> SingObject s b -> SingObject s a
fmap :: (a -> b) -> SingObject s a -> SingObject s b
$cfmap :: forall (s :: Symbol) a b.
(a -> b) -> SingObject s a -> SingObject s b
Functor, SingObject s a -> Bool
(a -> m) -> SingObject s a -> m
(a -> b -> b) -> b -> SingObject s a -> b
(forall m. Monoid m => SingObject s m -> m)
-> (forall m a. Monoid m => (a -> m) -> SingObject s a -> m)
-> (forall m a. Monoid m => (a -> m) -> SingObject s a -> m)
-> (forall a b. (a -> b -> b) -> b -> SingObject s a -> b)
-> (forall a b. (a -> b -> b) -> b -> SingObject s a -> b)
-> (forall b a. (b -> a -> b) -> b -> SingObject s a -> b)
-> (forall b a. (b -> a -> b) -> b -> SingObject s a -> b)
-> (forall a. (a -> a -> a) -> SingObject s a -> a)
-> (forall a. (a -> a -> a) -> SingObject s a -> a)
-> (forall a. SingObject s a -> [a])
-> (forall a. SingObject s a -> Bool)
-> (forall a. SingObject s a -> Int)
-> (forall a. Eq a => a -> SingObject s a -> Bool)
-> (forall a. Ord a => SingObject s a -> a)
-> (forall a. Ord a => SingObject s a -> a)
-> (forall a. Num a => SingObject s a -> a)
-> (forall a. Num a => SingObject s a -> a)
-> Foldable (SingObject s)
forall a. Eq a => a -> SingObject s a -> Bool
forall a. Num a => SingObject s a -> a
forall a. Ord a => SingObject s a -> a
forall m. Monoid m => SingObject s m -> m
forall a. SingObject s a -> Bool
forall a. SingObject s a -> Int
forall a. SingObject s a -> [a]
forall a. (a -> a -> a) -> SingObject s a -> a
forall m a. Monoid m => (a -> m) -> SingObject s a -> m
forall b a. (b -> a -> b) -> b -> SingObject s a -> b
forall a b. (a -> b -> b) -> b -> SingObject s a -> b
forall (s :: Symbol) a. Eq a => a -> SingObject s a -> Bool
forall (s :: Symbol) a. Num a => SingObject s a -> a
forall (s :: Symbol) a. Ord a => SingObject s a -> a
forall (s :: Symbol) m. Monoid m => SingObject s m -> m
forall (s :: Symbol) a. SingObject s a -> Bool
forall (s :: Symbol) a. SingObject s a -> Int
forall (s :: Symbol) a. SingObject s a -> [a]
forall (s :: Symbol) a. (a -> a -> a) -> SingObject s a -> a
forall (s :: Symbol) m a.
Monoid m =>
(a -> m) -> SingObject s a -> m
forall (s :: Symbol) b a. (b -> a -> b) -> b -> SingObject s a -> b
forall (s :: Symbol) a b. (a -> b -> b) -> b -> SingObject s 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 :: SingObject s a -> a
$cproduct :: forall (s :: Symbol) a. Num a => SingObject s a -> a
sum :: SingObject s a -> a
$csum :: forall (s :: Symbol) a. Num a => SingObject s a -> a
minimum :: SingObject s a -> a
$cminimum :: forall (s :: Symbol) a. Ord a => SingObject s a -> a
maximum :: SingObject s a -> a
$cmaximum :: forall (s :: Symbol) a. Ord a => SingObject s a -> a
elem :: a -> SingObject s a -> Bool
$celem :: forall (s :: Symbol) a. Eq a => a -> SingObject s a -> Bool
length :: SingObject s a -> Int
$clength :: forall (s :: Symbol) a. SingObject s a -> Int
null :: SingObject s a -> Bool
$cnull :: forall (s :: Symbol) a. SingObject s a -> Bool
toList :: SingObject s a -> [a]
$ctoList :: forall (s :: Symbol) a. SingObject s a -> [a]
foldl1 :: (a -> a -> a) -> SingObject s a -> a
$cfoldl1 :: forall (s :: Symbol) a. (a -> a -> a) -> SingObject s a -> a
foldr1 :: (a -> a -> a) -> SingObject s a -> a
$cfoldr1 :: forall (s :: Symbol) a. (a -> a -> a) -> SingObject s a -> a
foldl' :: (b -> a -> b) -> b -> SingObject s a -> b
$cfoldl' :: forall (s :: Symbol) b a. (b -> a -> b) -> b -> SingObject s a -> b
foldl :: (b -> a -> b) -> b -> SingObject s a -> b
$cfoldl :: forall (s :: Symbol) b a. (b -> a -> b) -> b -> SingObject s a -> b
foldr' :: (a -> b -> b) -> b -> SingObject s a -> b
$cfoldr' :: forall (s :: Symbol) a b. (a -> b -> b) -> b -> SingObject s a -> b
foldr :: (a -> b -> b) -> b -> SingObject s a -> b
$cfoldr :: forall (s :: Symbol) a b. (a -> b -> b) -> b -> SingObject s a -> b
foldMap' :: (a -> m) -> SingObject s a -> m
$cfoldMap' :: forall (s :: Symbol) m a.
Monoid m =>
(a -> m) -> SingObject s a -> m
foldMap :: (a -> m) -> SingObject s a -> m
$cfoldMap :: forall (s :: Symbol) m a.
Monoid m =>
(a -> m) -> SingObject s a -> m
fold :: SingObject s m -> m
$cfold :: forall (s :: Symbol) m. Monoid m => SingObject s m -> m
Foldable, Functor (SingObject s)
Foldable (SingObject s)
Functor (SingObject s)
-> Foldable (SingObject s)
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> SingObject s a -> f (SingObject s b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    SingObject s (f a) -> f (SingObject s a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> SingObject s a -> m (SingObject s b))
-> (forall (m :: * -> *) a.
    Monad m =>
    SingObject s (m a) -> m (SingObject s a))
-> Traversable (SingObject s)
(a -> f b) -> SingObject s a -> f (SingObject s b)
forall (s :: Symbol). Functor (SingObject s)
forall (s :: Symbol). Foldable (SingObject s)
forall (s :: Symbol) (m :: * -> *) a.
Monad m =>
SingObject s (m a) -> m (SingObject s a)
forall (s :: Symbol) (f :: * -> *) a.
Applicative f =>
SingObject s (f a) -> f (SingObject s a)
forall (s :: Symbol) (m :: * -> *) a b.
Monad m =>
(a -> m b) -> SingObject s a -> m (SingObject s b)
forall (s :: Symbol) (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> SingObject s a -> f (SingObject s 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 =>
SingObject s (m a) -> m (SingObject s a)
forall (f :: * -> *) a.
Applicative f =>
SingObject s (f a) -> f (SingObject s a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> SingObject s a -> m (SingObject s b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> SingObject s a -> f (SingObject s b)
sequence :: SingObject s (m a) -> m (SingObject s a)
$csequence :: forall (s :: Symbol) (m :: * -> *) a.
Monad m =>
SingObject s (m a) -> m (SingObject s a)
mapM :: (a -> m b) -> SingObject s a -> m (SingObject s b)
$cmapM :: forall (s :: Symbol) (m :: * -> *) a b.
Monad m =>
(a -> m b) -> SingObject s a -> m (SingObject s b)
sequenceA :: SingObject s (f a) -> f (SingObject s a)
$csequenceA :: forall (s :: Symbol) (f :: * -> *) a.
Applicative f =>
SingObject s (f a) -> f (SingObject s a)
traverse :: (a -> f b) -> SingObject s a -> f (SingObject s b)
$ctraverse :: forall (s :: Symbol) (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> SingObject s a -> f (SingObject s b)
$cp2Traversable :: forall (s :: Symbol). Foldable (SingObject s)
$cp1Traversable :: forall (s :: Symbol). Functor (SingObject s)
Traversable, Typeable)

mkSingObject :: Proxy s -> a -> SingObject s a
mkSingObject :: Proxy s -> a -> SingObject s a
mkSingObject Proxy s
_ = a -> SingObject s a
forall (s :: Symbol) a. a -> SingObject s a
SingObject

getSingObject :: Proxy s -> SingObject s a -> a
getSingObject :: Proxy s -> SingObject s a -> a
getSingObject Proxy s
_ (SingObject a
x) = a
x

instance KnownSymbol s => FromJSON1 (SingObject s) where
    liftParseJSON :: (Value -> Parser a)
-> (Value -> Parser [a]) -> Value -> Parser (SingObject s a)
liftParseJSON Value -> Parser a
p Value -> Parser [a]
_ = String
-> (Object -> Parser (SingObject s a))
-> Value
-> Parser (SingObject s a)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject (String
"SingObject "String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Key -> String
forall a. Show a => a -> String
show Key
key) ((Object -> Parser (SingObject s a))
 -> Value -> Parser (SingObject s a))
-> (Object -> Parser (SingObject s a))
-> Value
-> Parser (SingObject s a)
forall a b. (a -> b) -> a -> b
$ \Object
obj ->
        case Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
KM.lookup Key
key Object
obj of
            Maybe Value
Nothing -> String -> Parser (SingObject s a)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser (SingObject s a))
-> String -> Parser (SingObject s a)
forall a b. (a -> b) -> a -> b
$ String
"key " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Key -> String
forall a. Show a => a -> String
show Key
key String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" not present"
            Just Value
v  -> a -> SingObject s a
forall (s :: Symbol) a. a -> SingObject s a
SingObject (a -> SingObject s a) -> Parser a -> Parser (SingObject s a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser a
p Value
v Parser a -> JSONPathElement -> Parser a
forall a. Parser a -> JSONPathElement -> Parser a
<?> Key -> JSONPathElement
Key Key
key
     where
        key :: Key
key = String -> Key
forall a. IsString a => String -> a
fromString (String -> Key) -> String -> Key
forall a b. (a -> b) -> a -> b
$ Proxy s -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy s
forall k (t :: k). Proxy t
Proxy :: Proxy s)

instance KnownSymbol s => ToJSON1 (SingObject s) where
    liftToJSON :: (a -> Value) -> ([a] -> Value) -> SingObject s a -> Value
liftToJSON     a -> Value
to [a] -> Value
_ (SingObject a
x) =
        [Pair] -> Value
object [ Key
key Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= a -> Value
to a
x]
      where
        key :: Key
key = String -> Key
forall a. IsString a => String -> a
fromString (String -> Key) -> String -> Key
forall a b. (a -> b) -> a -> b
$ Proxy s -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy s
forall k (t :: k). Proxy t
Proxy :: Proxy s)
    liftToEncoding :: (a -> Encoding) -> ([a] -> Encoding) -> SingObject s a -> Encoding
liftToEncoding a -> Encoding
to [a] -> Encoding
_ (SingObject a
x) =
        Series -> Encoding
pairs (Series -> Encoding) -> Series -> Encoding
forall a b. (a -> b) -> a -> b
$ Key -> Encoding -> Series
pair Key
key (Encoding -> Series) -> Encoding -> Series
forall a b. (a -> b) -> a -> b
$ a -> Encoding
to a
x
      where
        key :: Key
key = String -> Key
forall a. IsString a => String -> a
fromString (String -> Key) -> String -> Key
forall a b. (a -> b) -> a -> b
$ Proxy s -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy s
forall k (t :: k). Proxy t
Proxy :: Proxy s)

instance  (KnownSymbol s, FromJSON a) => FromJSON (SingObject s a) where
    parseJSON :: Value -> Parser (SingObject s a)
parseJSON = Value -> Parser (SingObject s a)
forall (f :: * -> *) a.
(FromJSON1 f, FromJSON a) =>
Value -> Parser (f a)
parseJSON1

instance (KnownSymbol s, ToJSON a) => ToJSON (SingObject s a) where
    toJSON :: SingObject s a -> Value
toJSON     = SingObject s a -> Value
forall (f :: * -> *) a. (ToJSON1 f, ToJSON a) => f a -> Value
toJSON1
    toEncoding :: SingObject s a -> Encoding
toEncoding = SingObject s a -> Encoding
forall (f :: * -> *) a. (ToJSON1 f, ToJSON a) => f a -> Encoding
toEncoding1

-- | @since 0.4.1.0
instance NFData a => NFData (SingObject s a) where
    rnf :: SingObject s a -> ()
rnf (SingObject a
x) = a -> ()
forall a. NFData a => a -> ()
rnf a
x