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

import qualified Data.HashMap.Strict as HM
import qualified Data.Text           as T

-- | 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
<> 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
$ \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
            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]
++ Text -> String
forall a. Show a => a -> String
show Text
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
<?> 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     a -> Value
to [a] -> Value
_ (SingObject 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 a -> Encoding
to [a] -> Encoding
_ (SingObject 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

-- | @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