{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveLift #-}

module Argo.Json.Name where

import qualified Argo.Decoder as Decoder
import qualified Argo.Encoder as Encoder
import qualified Argo.Json.String as String
import qualified Argo.Vendor.DeepSeq as DeepSeq
import qualified Argo.Vendor.TemplateHaskell as TH
import qualified GHC.Generics as Generics

newtype Name
    = Name String.String
    deriving (Name -> Name -> Bool
(Name -> Name -> Bool) -> (Name -> Name -> Bool) -> Eq Name
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Name -> Name -> Bool
$c/= :: Name -> Name -> Bool
== :: Name -> Name -> Bool
$c== :: Name -> Name -> Bool
Eq, (forall x. Name -> Rep Name x)
-> (forall x. Rep Name x -> Name) -> Generic Name
forall x. Rep Name x -> Name
forall x. Name -> Rep Name x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Name x -> Name
$cfrom :: forall x. Name -> Rep Name x
Generics.Generic, Name -> Q Exp
Name -> Q (TExp Name)
(Name -> Q Exp) -> (Name -> Q (TExp Name)) -> Lift Name
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: Name -> Q (TExp Name)
$cliftTyped :: Name -> Q (TExp Name)
lift :: Name -> Q Exp
$clift :: Name -> Q Exp
TH.Lift, Name -> ()
(Name -> ()) -> NFData Name
forall a. (a -> ()) -> NFData a
rnf :: Name -> ()
$crnf :: Name -> ()
DeepSeq.NFData, Int -> Name -> ShowS
[Name] -> ShowS
Name -> String
(Int -> Name -> ShowS)
-> (Name -> String) -> ([Name] -> ShowS) -> Show Name
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Name] -> ShowS
$cshowList :: [Name] -> ShowS
show :: Name -> String
$cshow :: Name -> String
showsPrec :: Int -> Name -> ShowS
$cshowsPrec :: Int -> Name -> ShowS
Show)

fromString :: String.String -> Name
fromString :: String -> Name
fromString = String -> Name
Name

toString :: Name -> String.String
toString :: Name -> String
toString (Name String
x) = String
x

encode :: Name -> Encoder.Encoder ()
encode :: Name -> Encoder ()
encode = String -> Encoder ()
String.encode (String -> Encoder ()) -> (Name -> String) -> Name -> Encoder ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> String
toString

decode :: Decoder.Decoder Name
decode :: Decoder Name
decode = String -> Name
fromString (String -> Name) -> Decoder String -> Decoder Name
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder String
String.decode