{-# LANGUAGE TemplateHaskellQuotes #-}

module Argo.Type.Null where

import qualified Argo.Decoder as Decoder
import qualified Argo.Literal as Literal
import qualified Control.DeepSeq as DeepSeq
import qualified Data.ByteString.Builder as Builder
import qualified Language.Haskell.TH.Syntax as TH

newtype Null
    = Null ()
    deriving (Null -> Null -> Bool
(Null -> Null -> Bool) -> (Null -> Null -> Bool) -> Eq Null
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, Int -> Null -> ShowS
[Null] -> ShowS
Null -> String
(Int -> Null -> ShowS)
-> (Null -> String) -> ([Null] -> ShowS) -> Show Null
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 TH.Lift Null where
    liftTyped :: Null -> Q (TExp Null)
liftTyped (Null ()
x) = [|| Null x ||]

instance DeepSeq.NFData Null where
    rnf :: Null -> ()
rnf (Null ()
x) = () -> ()
forall a. NFData a => a -> ()
DeepSeq.rnf ()
x

encode :: Null -> Builder.Builder
encode :: Null -> Builder
encode = Builder -> Null -> Builder
forall a b. a -> b -> a
const (Builder -> Null -> Builder) -> Builder -> Null -> Builder
forall a b. (a -> b) -> a -> b
$ ByteString -> Builder
Builder.byteString ByteString
Literal.null

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