{-# 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.Compat
import Data.Proxy            (Proxy (..))
import Data.Semigroup.Compat ((<>))
import Data.Typeable         (Typeable)
import GHC.TypeLits          (KnownSymbol, Symbol, symbolVal)

import qualified Data.Text as T

#if MIN_VERSION_aeson(1,0,0)
import Data.Aeson.Encoding (pair)
import Data.Aeson.Internal (JSONPathElement (Key), (<?>))
import Data.Aeson.Types    hiding ((.:?))

import qualified Data.HashMap.Strict as HM
#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 _ = 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 _ (SingObject x :: a
x) = a
x

#if MIN_VERSION_aeson(1,0,0)

instance KnownSymbol s => FromJSON1 (SingObject s) where
    liftParseJSON :: (Value -> Parser a)
-> (Value -> Parser [a]) -> Value -> Parser (SingObject s a)
liftParseJSON p :: Value -> Parser a
p _ = String
-> (Object -> Parser (SingObject s a))
-> Value
-> Parser (SingObject s a)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject ("SingObject "String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a. Show a => a -> String
show Text
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
$ \obj :: Object
obj ->
        case Text -> Object -> Maybe Value
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup Text
key Object
obj of
            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
$ "key " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
key String -> ShowS
forall a. [a] -> [a] -> [a]
++ " not present"
            Just v :: 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
<?> Text -> JSONPathElement
Key Text
key
     where
        key :: Text
key = String -> Text
T.pack (String -> Text) -> String -> Text
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     to :: a -> Value
to _ (SingObject x :: a
x) =
        [Pair] -> Value
object [ Text
key Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= a -> Value
to a
x]
      where
        key :: Text
key = String -> Text
T.pack (String -> Text) -> String -> Text
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 to :: a -> Encoding
to _ (SingObject x :: a
x) =
        Series -> Encoding
pairs (Series -> Encoding) -> Series -> Encoding
forall a b. (a -> b) -> a -> b
$ Text -> Encoding -> Series
pair Text
key (Encoding -> Series) -> Encoding -> Series
forall a b. (a -> b) -> a -> b
$ a -> Encoding
to a
x
      where
        key :: Text
key = String -> Text
T.pack (String -> Text) -> String -> Text
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

#else
instance (KnownSymbol s, FromJSON a) => FromJSON (SingObject s a) where
  parseJSON = withObject ("SingObject "<> show key) $ \obj ->
    SingObject <$> obj .: T.pack key
    where key = symbolVal (Proxy :: Proxy s)

instance (KnownSymbol s, ToJSON a) => ToJSON (SingObject s a) where
#if MIN_VERSION_aeson(0,10,0)
  toEncoding (SingObject x) = pairs (T.pack key .= x)
    where key = symbolVal (Proxy :: Proxy s)
#endif
  toJSON (SingObject x) = object [T.pack key .= x]
    where key = symbolVal (Proxy :: Proxy s)
#endif

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