{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

-- | A type for wrapping a single type in a record when encoding to and from JSON.
-- See `SingleField` for this type.
module Data.Aeson.SingleField (SingleField (..)) where

import Data.Aeson
import Data.Proxy (Proxy (..))
import GHC.Exts (fromString)
import GHC.TypeLits (KnownSymbol, Symbol, symbolVal)

-- | When interacting with or producing JSON, it is common to wrap a single field in
-- an object with a single field. This can be a bit awkward to use from Haskell - we
-- tend to write a single `ToJSON` and `FromJSON` instance for each type, making this
-- extra wrapping cumbersome.
--
-- This newtype wrapper can helper with this. @SingleField field a@ contains a single
-- value of @a@. The difference is that the `ToJSON` and `FromJSON` instances will wrap
-- the @a@ in an object with a single field @field@. @field@ is a /type level/ string,
-- using data kinds.
--
-- >>> encode (SingleField @"myField" 3)
-- "{\"myField\":3}"
--
-- >>> getSingleField <$> decode @(SingleField "myField" Int) (encode $ SingleField @"myField" 123)
-- Just 123
newtype SingleField (field :: Symbol) (a :: *) = SingleField {SingleField field a -> a
getSingleField :: a}
  deriving (SingleField field a -> SingleField field a -> Bool
(SingleField field a -> SingleField field a -> Bool)
-> (SingleField field a -> SingleField field a -> Bool)
-> Eq (SingleField field a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (field :: Symbol) a.
Eq a =>
SingleField field a -> SingleField field a -> Bool
/= :: SingleField field a -> SingleField field a -> Bool
$c/= :: forall (field :: Symbol) a.
Eq a =>
SingleField field a -> SingleField field a -> Bool
== :: SingleField field a -> SingleField field a -> Bool
$c== :: forall (field :: Symbol) a.
Eq a =>
SingleField field a -> SingleField field a -> Bool
Eq, Int -> SingleField field a -> ShowS
[SingleField field a] -> ShowS
SingleField field a -> String
(Int -> SingleField field a -> ShowS)
-> (SingleField field a -> String)
-> ([SingleField field a] -> ShowS)
-> Show (SingleField field a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (field :: Symbol) a.
Show a =>
Int -> SingleField field a -> ShowS
forall (field :: Symbol) a.
Show a =>
[SingleField field a] -> ShowS
forall (field :: Symbol) a. Show a => SingleField field a -> String
showList :: [SingleField field a] -> ShowS
$cshowList :: forall (field :: Symbol) a.
Show a =>
[SingleField field a] -> ShowS
show :: SingleField field a -> String
$cshow :: forall (field :: Symbol) a. Show a => SingleField field a -> String
showsPrec :: Int -> SingleField field a -> ShowS
$cshowsPrec :: forall (field :: Symbol) a.
Show a =>
Int -> SingleField field a -> ShowS
Show, a -> SingleField field b -> SingleField field a
(a -> b) -> SingleField field a -> SingleField field b
(forall a b.
 (a -> b) -> SingleField field a -> SingleField field b)
-> (forall a b. a -> SingleField field b -> SingleField field a)
-> Functor (SingleField field)
forall a b. a -> SingleField field b -> SingleField field a
forall a b. (a -> b) -> SingleField field a -> SingleField field b
forall (field :: Symbol) a b.
a -> SingleField field b -> SingleField field a
forall (field :: Symbol) a b.
(a -> b) -> SingleField field a -> SingleField field b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> SingleField field b -> SingleField field a
$c<$ :: forall (field :: Symbol) a b.
a -> SingleField field b -> SingleField field a
fmap :: (a -> b) -> SingleField field a -> SingleField field b
$cfmap :: forall (field :: Symbol) a b.
(a -> b) -> SingleField field a -> SingleField field b
Functor)

keyFromProxy :: KnownSymbol n => Proxy n -> Key
keyFromProxy :: Proxy n -> Key
keyFromProxy = String -> Key
forall a. IsString a => String -> a
fromString (String -> Key) -> (Proxy n -> String) -> Proxy n -> Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy n -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal

instance (ToJSON a, KnownSymbol field) => ToJSON (SingleField field a) where
  toJSON :: SingleField field a -> Value
toJSON (SingleField a
a) = [Pair] -> Value
object [Proxy field -> Key
forall (n :: Symbol). KnownSymbol n => Proxy n -> Key
keyFromProxy (Proxy field
forall k (t :: k). Proxy t
Proxy @field) Key -> a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= a
a]

instance (FromJSON a, KnownSymbol field) => FromJSON (SingleField field a) where
  parseJSON :: Value -> Parser (SingleField field a)
parseJSON = String
-> (Object -> Parser (SingleField field a))
-> Value
-> Parser (SingleField field a)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject (String
"SingleField " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Proxy field -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy field
forall k (t :: k). Proxy t
Proxy @field)) ((Object -> Parser (SingleField field a))
 -> Value -> Parser (SingleField field a))
-> (Object -> Parser (SingleField field a))
-> Value
-> Parser (SingleField field a)
forall a b. (a -> b) -> a -> b
$
    \Object
obj -> a -> SingleField field a
forall (field :: Symbol) a. a -> SingleField field a
SingleField (a -> SingleField field a)
-> Parser a -> Parser (SingleField field a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
obj Object -> Key -> Parser a
forall a. FromJSON a => Object -> Key -> Parser a
.: Proxy field -> Key
forall (n :: Symbol). KnownSymbol n => Proxy n -> Key
keyFromProxy (Proxy field
forall k (t :: k). Proxy t
Proxy @field))