{-# 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
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, 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
Ord, Int -> SingObject s a -> ShowS
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)
ReadS [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, 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
<$ :: forall a b. a -> SingObject s b -> SingObject s a
$c<$ :: forall (s :: Symbol) a b. a -> SingObject s b -> SingObject s a
fmap :: forall a b. (a -> b) -> SingObject s a -> SingObject s b
$cfmap :: forall (s :: Symbol) a b.
(a -> b) -> SingObject s a -> SingObject s b
Functor, forall a. SingObject s a -> Bool
forall m a. Monoid m => (a -> m) -> SingObject s a -> m
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 :: forall a. Num a => SingObject s a -> a
$cproduct :: forall (s :: Symbol) a. Num a => SingObject s a -> a
sum :: forall a. Num a => SingObject s a -> a
$csum :: forall (s :: Symbol) a. Num a => SingObject s a -> a
minimum :: forall a. Ord a => SingObject s a -> a
$cminimum :: forall (s :: Symbol) a. Ord a => SingObject s a -> a
maximum :: forall a. Ord a => SingObject s a -> a
$cmaximum :: forall (s :: Symbol) a. Ord a => SingObject s a -> a
elem :: forall a. Eq a => a -> SingObject s a -> Bool
$celem :: forall (s :: Symbol) a. Eq a => a -> SingObject s a -> Bool
length :: forall a. SingObject s a -> Int
$clength :: forall (s :: Symbol) a. SingObject s a -> Int
null :: forall a. SingObject s a -> Bool
$cnull :: forall (s :: Symbol) a. SingObject s a -> Bool
toList :: forall a. SingObject s a -> [a]
$ctoList :: forall (s :: Symbol) a. SingObject s a -> [a]
foldl1 :: forall a. (a -> a -> a) -> SingObject s a -> a
$cfoldl1 :: forall (s :: Symbol) a. (a -> a -> a) -> SingObject s a -> a
foldr1 :: forall a. (a -> a -> a) -> SingObject s a -> a
$cfoldr1 :: forall (s :: Symbol) a. (a -> a -> a) -> SingObject s a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> SingObject s a -> b
$cfoldl' :: forall (s :: Symbol) b a. (b -> a -> b) -> b -> SingObject s a -> b
foldl :: forall b a. (b -> a -> b) -> b -> SingObject s a -> b
$cfoldl :: forall (s :: Symbol) b a. (b -> a -> b) -> b -> SingObject s a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> SingObject s a -> b
$cfoldr' :: forall (s :: Symbol) a b. (a -> b -> b) -> b -> SingObject s a -> b
foldr :: forall a b. (a -> b -> b) -> b -> SingObject s a -> b
$cfoldr :: forall (s :: Symbol) a b. (a -> b -> b) -> b -> SingObject s a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> SingObject s a -> m
$cfoldMap' :: forall (s :: Symbol) m a.
Monoid m =>
(a -> m) -> SingObject s a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> SingObject s a -> m
$cfoldMap :: forall (s :: Symbol) m a.
Monoid m =>
(a -> m) -> SingObject s a -> m
fold :: forall m. Monoid m => SingObject s m -> m
$cfold :: forall (s :: Symbol) m. Monoid m => SingObject s m -> m
Foldable, 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 (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> SingObject s a -> f (SingObject s b)
sequence :: forall (m :: * -> *) a.
Monad m =>
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 :: forall (m :: * -> *) a b.
Monad m =>
(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 :: forall (f :: * -> *) a.
Applicative f =>
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 :: forall (f :: * -> *) a b.
Applicative f =>
(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)
Traversable, Typeable)

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

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

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

instance KnownSymbol s => ToJSON1 (SingObject s) where
    liftToJSON :: forall a. (a -> Value) -> ([a] -> Value) -> SingObject s a -> Value
liftToJSON     a -> Value
to [a] -> Value
_ (SingObject a
x) =
        [Pair] -> Value
object [ Key
key forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= a -> Value
to a
x]
      where
        key :: Key
key = forall a. IsString a => String -> a
fromString forall a b. (a -> b) -> a -> b
$ forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
Proxy :: Proxy s)
    liftToEncoding :: forall a.
(a -> Encoding) -> ([a] -> Encoding) -> SingObject s a -> Encoding
liftToEncoding a -> Encoding
to [a] -> Encoding
_ (SingObject a
x) =
        Series -> Encoding
pairs forall a b. (a -> b) -> a -> b
$ Key -> Encoding -> Series
pair Key
key forall a b. (a -> b) -> a -> b
$ a -> Encoding
to a
x
      where
        key :: Key
key = forall a. IsString a => String -> a
fromString forall a b. (a -> b) -> a -> b
$ forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (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 = 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     = forall (f :: * -> *) a. (ToJSON1 f, ToJSON a) => f a -> Value
toJSON1
    toEncoding :: SingObject s a -> Encoding
toEncoding = 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) = forall a. NFData a => a -> ()
rnf a
x