-- | A globally unique identifier
module Asana.Api.Gid
  ( Gid
  , AsanaReference(..)
  , gidToText
  , textToGid
  ) where

import Asana.Api.Prelude

import Data.Aeson
  (FromJSON(..), FromJSONKey, ToJSON, ToJSONKey, genericParseJSON)
import Data.Aeson.Casing (aesonPrefix, snakeCase)
import Data.Hashable (Hashable)

newtype Gid = Gid { Gid -> Text
gidToText :: Text }
  deriving stock (Gid -> Gid -> Bool
(Gid -> Gid -> Bool) -> (Gid -> Gid -> Bool) -> Eq Gid
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Gid -> Gid -> Bool
$c/= :: Gid -> Gid -> Bool
== :: Gid -> Gid -> Bool
$c== :: Gid -> Gid -> Bool
Eq, (forall x. Gid -> Rep Gid x)
-> (forall x. Rep Gid x -> Gid) -> Generic Gid
forall x. Rep Gid x -> Gid
forall x. Gid -> Rep Gid x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Gid x -> Gid
$cfrom :: forall x. Gid -> Rep Gid x
Generic, Int -> Gid -> ShowS
[Gid] -> ShowS
Gid -> String
(Int -> Gid -> ShowS)
-> (Gid -> String) -> ([Gid] -> ShowS) -> Show Gid
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Gid] -> ShowS
$cshowList :: [Gid] -> ShowS
show :: Gid -> String
$cshow :: Gid -> String
showsPrec :: Int -> Gid -> ShowS
$cshowsPrec :: Int -> Gid -> ShowS
Show)
  deriving newtype (Value -> Parser [Gid]
Value -> Parser Gid
(Value -> Parser Gid) -> (Value -> Parser [Gid]) -> FromJSON Gid
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Gid]
$cparseJSONList :: Value -> Parser [Gid]
parseJSON :: Value -> Parser Gid
$cparseJSON :: Value -> Parser Gid
FromJSON, [Gid] -> Encoding
[Gid] -> Value
Gid -> Encoding
Gid -> Value
(Gid -> Value)
-> (Gid -> Encoding)
-> ([Gid] -> Value)
-> ([Gid] -> Encoding)
-> ToJSON Gid
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Gid] -> Encoding
$ctoEncodingList :: [Gid] -> Encoding
toJSONList :: [Gid] -> Value
$ctoJSONList :: [Gid] -> Value
toEncoding :: Gid -> Encoding
$ctoEncoding :: Gid -> Encoding
toJSON :: Gid -> Value
$ctoJSON :: Gid -> Value
ToJSON, ToJSONKeyFunction [Gid]
ToJSONKeyFunction Gid
ToJSONKeyFunction Gid -> ToJSONKeyFunction [Gid] -> ToJSONKey Gid
forall a.
ToJSONKeyFunction a -> ToJSONKeyFunction [a] -> ToJSONKey a
toJSONKeyList :: ToJSONKeyFunction [Gid]
$ctoJSONKeyList :: ToJSONKeyFunction [Gid]
toJSONKey :: ToJSONKeyFunction Gid
$ctoJSONKey :: ToJSONKeyFunction Gid
ToJSONKey, FromJSONKeyFunction [Gid]
FromJSONKeyFunction Gid
FromJSONKeyFunction Gid
-> FromJSONKeyFunction [Gid] -> FromJSONKey Gid
forall a.
FromJSONKeyFunction a -> FromJSONKeyFunction [a] -> FromJSONKey a
fromJSONKeyList :: FromJSONKeyFunction [Gid]
$cfromJSONKeyList :: FromJSONKeyFunction [Gid]
fromJSONKey :: FromJSONKeyFunction Gid
$cfromJSONKey :: FromJSONKeyFunction Gid
FromJSONKey, Eq Gid
Eq Gid -> (Int -> Gid -> Int) -> (Gid -> Int) -> Hashable Gid
Int -> Gid -> Int
Gid -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: Gid -> Int
$chash :: Gid -> Int
hashWithSalt :: Int -> Gid -> Int
$chashWithSalt :: Int -> Gid -> Int
$cp1Hashable :: Eq Gid
Hashable)

-- | An object @{ gid: <Gid> }@
newtype AsanaReference = AsanaReference { AsanaReference -> Gid
arGid :: Gid }
  deriving stock (AsanaReference -> AsanaReference -> Bool
(AsanaReference -> AsanaReference -> Bool)
-> (AsanaReference -> AsanaReference -> Bool) -> Eq AsanaReference
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AsanaReference -> AsanaReference -> Bool
$c/= :: AsanaReference -> AsanaReference -> Bool
== :: AsanaReference -> AsanaReference -> Bool
$c== :: AsanaReference -> AsanaReference -> Bool
Eq, (forall x. AsanaReference -> Rep AsanaReference x)
-> (forall x. Rep AsanaReference x -> AsanaReference)
-> Generic AsanaReference
forall x. Rep AsanaReference x -> AsanaReference
forall x. AsanaReference -> Rep AsanaReference x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AsanaReference x -> AsanaReference
$cfrom :: forall x. AsanaReference -> Rep AsanaReference x
Generic, Int -> AsanaReference -> ShowS
[AsanaReference] -> ShowS
AsanaReference -> String
(Int -> AsanaReference -> ShowS)
-> (AsanaReference -> String)
-> ([AsanaReference] -> ShowS)
-> Show AsanaReference
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AsanaReference] -> ShowS
$cshowList :: [AsanaReference] -> ShowS
show :: AsanaReference -> String
$cshow :: AsanaReference -> String
showsPrec :: Int -> AsanaReference -> ShowS
$cshowsPrec :: Int -> AsanaReference -> ShowS
Show)

instance FromJSON AsanaReference where
  parseJSON :: Value -> Parser AsanaReference
parseJSON = Options -> Value -> Parser AsanaReference
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (Options -> Value -> Parser AsanaReference)
-> Options -> Value -> Parser AsanaReference
forall a b. (a -> b) -> a -> b
$ ShowS -> Options
aesonPrefix ShowS
snakeCase

textToGid :: Text -> Gid
textToGid :: Text -> Gid
textToGid = Text -> Gid
Gid