{-# LANGUAGE DeriveGeneric #-}
{-|
Module      : Data.Aeson.Unit
Description : Provides unit type that serialises into empty JSON object
Copyright   : (c) Anton Gushcha, 2016
License     : MIT
Maintainer  : ncrashed@gmail.com
Stability   : experimental
Portability : Portable

Common problem in REST interfaces when you need to return nothing as result,
usage of `()` will produce `[]` JSON. That causes problems in some JSON parsers
in other languages.

So, `Unit` serialises into empty JSON object:

>>> encode Unit
"{}"

-}
module Data.Aeson.Unit(
    Unit(..)
  ) where

import Control.Lens
import Data.Aeson
import Data.Swagger
import GHC.Generics

-- | Data type that serialise into empty object in aeson
--
-- >>> encode Unit
-- "{}"
--
-- >>> encode $ toSchema (Proxy :: Proxy Unit)
-- "{\"type\":\"object\"}"
--
-- Also the 'FromJSON' instance is just `pure Unit`, so it never fails.
data Unit = Unit
  deriving ((forall x. Unit -> Rep Unit x)
-> (forall x. Rep Unit x -> Unit) -> Generic Unit
forall x. Rep Unit x -> Unit
forall x. Unit -> Rep Unit x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Unit x -> Unit
$cfrom :: forall x. Unit -> Rep Unit x
Generic, Unit -> Unit -> Bool
(Unit -> Unit -> Bool) -> (Unit -> Unit -> Bool) -> Eq Unit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Unit -> Unit -> Bool
$c/= :: Unit -> Unit -> Bool
== :: Unit -> Unit -> Bool
$c== :: Unit -> Unit -> Bool
Eq, Int -> Unit -> ShowS
[Unit] -> ShowS
Unit -> String
(Int -> Unit -> ShowS)
-> (Unit -> String) -> ([Unit] -> ShowS) -> Show Unit
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Unit] -> ShowS
$cshowList :: [Unit] -> ShowS
show :: Unit -> String
$cshow :: Unit -> String
showsPrec :: Int -> Unit -> ShowS
$cshowsPrec :: Int -> Unit -> ShowS
Show, ReadPrec [Unit]
ReadPrec Unit
Int -> ReadS Unit
ReadS [Unit]
(Int -> ReadS Unit)
-> ReadS [Unit] -> ReadPrec Unit -> ReadPrec [Unit] -> Read Unit
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Unit]
$creadListPrec :: ReadPrec [Unit]
readPrec :: ReadPrec Unit
$creadPrec :: ReadPrec Unit
readList :: ReadS [Unit]
$creadList :: ReadS [Unit]
readsPrec :: Int -> ReadS Unit
$creadsPrec :: Int -> ReadS Unit
Read, Int -> Unit
Unit -> Int
Unit -> [Unit]
Unit -> Unit
Unit -> Unit -> [Unit]
Unit -> Unit -> Unit -> [Unit]
(Unit -> Unit)
-> (Unit -> Unit)
-> (Int -> Unit)
-> (Unit -> Int)
-> (Unit -> [Unit])
-> (Unit -> Unit -> [Unit])
-> (Unit -> Unit -> [Unit])
-> (Unit -> Unit -> Unit -> [Unit])
-> Enum Unit
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Unit -> Unit -> Unit -> [Unit]
$cenumFromThenTo :: Unit -> Unit -> Unit -> [Unit]
enumFromTo :: Unit -> Unit -> [Unit]
$cenumFromTo :: Unit -> Unit -> [Unit]
enumFromThen :: Unit -> Unit -> [Unit]
$cenumFromThen :: Unit -> Unit -> [Unit]
enumFrom :: Unit -> [Unit]
$cenumFrom :: Unit -> [Unit]
fromEnum :: Unit -> Int
$cfromEnum :: Unit -> Int
toEnum :: Int -> Unit
$ctoEnum :: Int -> Unit
pred :: Unit -> Unit
$cpred :: Unit -> Unit
succ :: Unit -> Unit
$csucc :: Unit -> Unit
Enum, Unit
Unit -> Unit -> Bounded Unit
forall a. a -> a -> Bounded a
maxBound :: Unit
$cmaxBound :: Unit
minBound :: Unit
$cminBound :: Unit
Bounded)

instance ToJSON Unit where
  toJSON :: Unit -> Value
toJSON _ = [Pair] -> Value
object []

-- | Always a success parse
instance FromJSON Unit where
  parseJSON :: Value -> Parser Unit
parseJSON _ = Unit -> Parser Unit
forall (f :: * -> *) a. Applicative f => a -> f a
pure Unit
Unit

instance ToSchema Unit where
  declareNamedSchema :: Proxy Unit -> Declare (Definitions Schema) NamedSchema
declareNamedSchema _ = do
    NamedSchema -> Declare (Definitions Schema) NamedSchema
forall (m :: * -> *) a. Monad m => a -> m a
return (NamedSchema -> Declare (Definitions Schema) NamedSchema)
-> NamedSchema -> Declare (Definitions Schema) NamedSchema
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Schema -> NamedSchema
NamedSchema Maybe Text
forall a. Maybe a
Nothing (Schema -> NamedSchema) -> Schema -> NamedSchema
forall a b. (a -> b) -> a -> b
$ Schema
forall a. Monoid a => a
mempty
      Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe (SwaggerType 'SwaggerKindSchema)
 -> Identity (Maybe (SwaggerType 'SwaggerKindSchema)))
-> Schema -> Identity Schema
forall s a. HasType s a => Lens' s a
type_ ((Maybe (SwaggerType 'SwaggerKindSchema)
  -> Identity (Maybe (SwaggerType 'SwaggerKindSchema)))
 -> Schema -> Identity Schema)
-> Maybe (SwaggerType 'SwaggerKindSchema) -> Schema -> Schema
forall s t a b. ASetter s t a b -> b -> s -> t
.~ SwaggerType 'SwaggerKindSchema
-> Maybe (SwaggerType 'SwaggerKindSchema)
forall a. a -> Maybe a
Just SwaggerType 'SwaggerKindSchema
SwaggerObject