module Reddit.Types.Empty ( nothing ) where

import Control.Monad (liftM)
import Data.Aeson
import Data.Aeson.Types
import Data.Monoid
import Prelude
import qualified Data.Aeson.KeyMap as KeyMap

-- | More specific @void@ for forcing a @Empty@ @FromJSON@ instance
nothing :: Monad m => m Empty -> m ()
nothing :: m Empty -> m ()
nothing = (Empty -> ()) -> m Empty -> m ()
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ((Empty -> ()) -> m Empty -> m ())
-> (Empty -> ()) -> m Empty -> m ()
forall a b. (a -> b) -> a -> b
$ () -> Empty -> ()
forall a b. a -> b -> a
const ()

data Empty = Empty
  deriving (Int -> Empty -> ShowS
[Empty] -> ShowS
Empty -> String
(Int -> Empty -> ShowS)
-> (Empty -> String) -> ([Empty] -> ShowS) -> Show Empty
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Empty] -> ShowS
$cshowList :: [Empty] -> ShowS
show :: Empty -> String
$cshow :: Empty -> String
showsPrec :: Int -> Empty -> ShowS
$cshowsPrec :: Int -> Empty -> ShowS
Show, ReadPrec [Empty]
ReadPrec Empty
Int -> ReadS Empty
ReadS [Empty]
(Int -> ReadS Empty)
-> ReadS [Empty]
-> ReadPrec Empty
-> ReadPrec [Empty]
-> Read Empty
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Empty]
$creadListPrec :: ReadPrec [Empty]
readPrec :: ReadPrec Empty
$creadPrec :: ReadPrec Empty
readList :: ReadS [Empty]
$creadList :: ReadS [Empty]
readsPrec :: Int -> ReadS Empty
$creadsPrec :: Int -> ReadS Empty
Read, Empty -> Empty -> Bool
(Empty -> Empty -> Bool) -> (Empty -> Empty -> Bool) -> Eq Empty
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Empty -> Empty -> Bool
$c/= :: Empty -> Empty -> Bool
== :: Empty -> Empty -> Bool
$c== :: Empty -> Empty -> Bool
Eq)

instance FromJSON Empty where
  parseJSON :: Value -> Parser Empty
parseJSON (Object Object
o) =
    if Object -> Bool
forall v. KeyMap v -> Bool
KeyMap.null Object
o
      then Empty -> Parser Empty
forall (m :: * -> *) a. Monad m => a -> m a
return Empty
Empty
      else do
        [Value]
errs <- (Object
o Object -> Key -> Parser Object
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"json") Parser Object -> (Object -> Parser [Value]) -> Parser [Value]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Object -> Key -> Parser [Value]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"errors") :: Parser [Value]
        if [Value] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Value]
errs
          then Empty -> Parser Empty
forall (m :: * -> *) a. Monad m => a -> m a
return Empty
Empty
          else Parser Empty
forall a. Monoid a => a
mempty
  parseJSON Value
_ = Parser Empty
forall a. Monoid a => a
mempty