{-# LANGUAGE DeriveLift #-}

module Argo.Internal.Json.Null where

import qualified Argo.Internal.Literal as Literal
import qualified Argo.Internal.Type.Decoder as Decoder
import qualified Argo.Internal.Type.Encoder as Encoder
import qualified Argo.Vendor.Builder as Builder
import qualified Argo.Vendor.DeepSeq as DeepSeq
import qualified Argo.Vendor.TemplateHaskell as TH
import qualified Argo.Vendor.Transformers as Trans

newtype Null
    = Null ()
    deriving (Null -> Null -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Null -> Null -> Bool
$c/= :: Null -> Null -> Bool
== :: Null -> Null -> Bool
$c== :: Null -> Null -> Bool
Eq, forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => Null -> m Exp
forall (m :: * -> *). Quote m => Null -> Code m Null
liftTyped :: forall (m :: * -> *). Quote m => Null -> Code m Null
$cliftTyped :: forall (m :: * -> *). Quote m => Null -> Code m Null
lift :: forall (m :: * -> *). Quote m => Null -> m Exp
$clift :: forall (m :: * -> *). Quote m => Null -> m Exp
TH.Lift, Int -> Null -> ShowS
[Null] -> ShowS
Null -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Null] -> ShowS
$cshowList :: [Null] -> ShowS
show :: Null -> String
$cshow :: Null -> String
showsPrec :: Int -> Null -> ShowS
$cshowsPrec :: Int -> Null -> ShowS
Show)

instance DeepSeq.NFData Null where
    rnf :: Null -> ()
rnf = forall a. NFData a => a -> ()
DeepSeq.rnf forall b c a. (b -> c) -> (a -> b) -> a -> c
. Null -> ()
toUnit

fromUnit :: () -> Null
fromUnit :: () -> Null
fromUnit = () -> Null
Null

toUnit :: Null -> ()
toUnit :: Null -> ()
toUnit (Null ()
x) = ()
x

encode :: Null -> Encoder.Encoder ()
encode :: Null -> Encoder ()
encode = forall a b. a -> b -> a
const forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Trans.lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
Trans.tell forall a b. (a -> b) -> a -> b
$ ByteString -> Builder
Builder.byteString ByteString
Literal.null

decode :: Decoder.Decoder Null
decode :: Decoder Null
decode = () -> Null
fromUnit () forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ByteString -> Decoder ()
Decoder.byteString ByteString
Literal.null forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Decoder ()
Decoder.spaces