module Asana.Api.CustomField
  ( CustomField(..)
  , CustomFields(..)
  , customEnumId
  , EnumOption(..)
  , putCustomField
  , putCustomFields
  ) where

import Asana.Api.Prelude

import Asana.Api.Gid (Gid, gidToText)
import Asana.Api.Request
import Data.Aeson
import Data.Aeson.Casing (aesonPrefix, snakeCase)
import Data.List (find)
import Data.Scientific (Scientific)
import Data.String (fromString)
import qualified Data.Text as T

data CustomField
  = CustomNumber Gid Text (Maybe Scientific)
  | CustomEnum Gid Text [EnumOption] (Maybe Text)
  | CustomText Gid Text (Maybe Text)
  | Other -- ^ Unexpected types dumped here
  deriving stock (CustomField -> CustomField -> Bool
(CustomField -> CustomField -> Bool)
-> (CustomField -> CustomField -> Bool) -> Eq CustomField
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CustomField -> CustomField -> Bool
$c/= :: CustomField -> CustomField -> Bool
== :: CustomField -> CustomField -> Bool
$c== :: CustomField -> CustomField -> Bool
Eq, (forall x. CustomField -> Rep CustomField x)
-> (forall x. Rep CustomField x -> CustomField)
-> Generic CustomField
forall x. Rep CustomField x -> CustomField
forall x. CustomField -> Rep CustomField x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CustomField x -> CustomField
$cfrom :: forall x. CustomField -> Rep CustomField x
Generic, Int -> CustomField -> ShowS
[CustomField] -> ShowS
CustomField -> String
(Int -> CustomField -> ShowS)
-> (CustomField -> String)
-> ([CustomField] -> ShowS)
-> Show CustomField
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CustomField] -> ShowS
$cshowList :: [CustomField] -> ShowS
show :: CustomField -> String
$cshow :: CustomField -> String
showsPrec :: Int -> CustomField -> ShowS
$cshowsPrec :: Int -> CustomField -> ShowS
Show)

newtype CustomFields = CustomFields { CustomFields -> [CustomField]
getCustomFields :: [CustomField] }
  deriving stock (Int -> CustomFields -> ShowS
[CustomFields] -> ShowS
CustomFields -> String
(Int -> CustomFields -> ShowS)
-> (CustomFields -> String)
-> ([CustomFields] -> ShowS)
-> Show CustomFields
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CustomFields] -> ShowS
$cshowList :: [CustomFields] -> ShowS
show :: CustomFields -> String
$cshow :: CustomFields -> String
showsPrec :: Int -> CustomFields -> ShowS
$cshowsPrec :: Int -> CustomFields -> ShowS
Show, CustomFields -> CustomFields -> Bool
(CustomFields -> CustomFields -> Bool)
-> (CustomFields -> CustomFields -> Bool) -> Eq CustomFields
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CustomFields -> CustomFields -> Bool
$c/= :: CustomFields -> CustomFields -> Bool
== :: CustomFields -> CustomFields -> Bool
$c== :: CustomFields -> CustomFields -> Bool
Eq)
  deriving newtype (Value -> Parser [CustomFields]
Value -> Parser CustomFields
(Value -> Parser CustomFields)
-> (Value -> Parser [CustomFields]) -> FromJSON CustomFields
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [CustomFields]
$cparseJSONList :: Value -> Parser [CustomFields]
parseJSON :: Value -> Parser CustomFields
$cparseJSON :: Value -> Parser CustomFields
FromJSON)

instance ToJSON CustomFields where
  toJSON :: CustomFields -> Value
toJSON (CustomFields [CustomField]
fields) = [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ (CustomField -> [Pair]) -> [CustomField] -> [Pair]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap CustomField -> [Pair]
forall a. KeyValue a => CustomField -> [a]
toPair [CustomField]
fields
   where
    toPair :: CustomField -> [a]
toPair = \case
      CustomNumber Gid
gid Text
_ Maybe Scientific
n -> [Gid -> Key
forall c. IsString c => Gid -> c
gidToKey Gid
gid Key -> Maybe Scientific -> a
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Scientific
n]
      e :: CustomField
e@(CustomEnum Gid
gid Text
_ [EnumOption]
_ Maybe Text
_) -> [Gid -> Key
forall c. IsString c => Gid -> c
gidToKey Gid
gid Key -> Maybe Gid -> a
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= CustomField -> Maybe Gid
customEnumId CustomField
e]
      CustomField
_ -> []

    -- fromString will give us Text for aeson-1.x and Key for aeson-2.x
    gidToKey :: Gid -> c
gidToKey = String -> c
forall a. IsString a => String -> a
fromString (String -> c) -> (Gid -> String) -> Gid -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> String) -> (Gid -> Text) -> Gid -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Gid -> Text
gidToText

data EnumOption = EnumOption
  { EnumOption -> Gid
eoGid :: Gid
  , EnumOption -> Text
eoName :: Text
  }
  deriving stock (EnumOption -> EnumOption -> Bool
(EnumOption -> EnumOption -> Bool)
-> (EnumOption -> EnumOption -> Bool) -> Eq EnumOption
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EnumOption -> EnumOption -> Bool
$c/= :: EnumOption -> EnumOption -> Bool
== :: EnumOption -> EnumOption -> Bool
$c== :: EnumOption -> EnumOption -> Bool
Eq, (forall x. EnumOption -> Rep EnumOption x)
-> (forall x. Rep EnumOption x -> EnumOption) -> Generic EnumOption
forall x. Rep EnumOption x -> EnumOption
forall x. EnumOption -> Rep EnumOption x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep EnumOption x -> EnumOption
$cfrom :: forall x. EnumOption -> Rep EnumOption x
Generic, Int -> EnumOption -> ShowS
[EnumOption] -> ShowS
EnumOption -> String
(Int -> EnumOption -> ShowS)
-> (EnumOption -> String)
-> ([EnumOption] -> ShowS)
-> Show EnumOption
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EnumOption] -> ShowS
$cshowList :: [EnumOption] -> ShowS
show :: EnumOption -> String
$cshow :: EnumOption -> String
showsPrec :: Int -> EnumOption -> ShowS
$cshowsPrec :: Int -> EnumOption -> ShowS
Show)

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

-- | Return a @'CustomField'@s value's Enum id, if possible
--
-- - Must be a @'CustomEnum'@
-- - Must have a value
-- - Must have an option with the same name as that value
--
customEnumId :: CustomField -> Maybe Gid
customEnumId :: CustomField -> Maybe Gid
customEnumId (CustomEnum Gid
_ Text
_ [EnumOption]
opts Maybe Text
mValue) = do
  Text
value <- Maybe Text
mValue
  EnumOption
option <- (EnumOption -> Bool) -> [EnumOption] -> Maybe EnumOption
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
value) (Text -> Bool) -> (EnumOption -> Text) -> EnumOption -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EnumOption -> Text
eoName) [EnumOption]
opts
  Gid -> Maybe Gid
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Gid -> Maybe Gid) -> Gid -> Maybe Gid
forall a b. (a -> b) -> a -> b
$ EnumOption -> Gid
eoGid EnumOption
option
customEnumId CustomField
_ = Maybe Gid
forall a. Maybe a
Nothing

instance FromJSON CustomField where
  parseJSON :: Value -> Parser CustomField
parseJSON = String
-> (Object -> Parser CustomField) -> Value -> Parser CustomField
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"CustomField" ((Object -> Parser CustomField) -> Value -> Parser CustomField)
-> (Object -> Parser CustomField) -> Value -> Parser CustomField
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    Text
oType <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type"

    case (Text
oType :: Text) of
      Text
"text" -> Gid -> Text -> Maybe Text -> CustomField
CustomText (Gid -> Text -> Maybe Text -> CustomField)
-> Parser Gid -> Parser (Text -> Maybe Text -> CustomField)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Gid
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"gid" Parser (Text -> Maybe Text -> CustomField)
-> Parser Text -> Parser (Maybe Text -> CustomField)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name" Parser (Maybe Text -> CustomField)
-> Parser (Maybe Text) -> Parser CustomField
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"text_value"
      Text
"number" ->
        Gid -> Text -> Maybe Scientific -> CustomField
CustomNumber (Gid -> Text -> Maybe Scientific -> CustomField)
-> Parser Gid -> Parser (Text -> Maybe Scientific -> CustomField)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Gid
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"gid" Parser (Text -> Maybe Scientific -> CustomField)
-> Parser Text -> Parser (Maybe Scientific -> CustomField)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name" Parser (Maybe Scientific -> CustomField)
-> Parser (Maybe Scientific) -> Parser CustomField
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Scientific)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"number_value"
      Text
"enum" -> do
        Value
value <- Object
o Object -> Key -> Parser Value
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"enum_value"
        Gid -> Text -> [EnumOption] -> Maybe Text -> CustomField
CustomEnum
          (Gid -> Text -> [EnumOption] -> Maybe Text -> CustomField)
-> Parser Gid
-> Parser (Text -> [EnumOption] -> Maybe Text -> CustomField)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser Gid
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"gid")
          Parser (Text -> [EnumOption] -> Maybe Text -> CustomField)
-> Parser Text
-> Parser ([EnumOption] -> Maybe Text -> CustomField)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name")
          Parser ([EnumOption] -> Maybe Text -> CustomField)
-> Parser [EnumOption] -> Parser (Maybe Text -> CustomField)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser [EnumOption]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"enum_options")
          Parser (Maybe Text -> CustomField)
-> Parser (Maybe Text) -> Parser CustomField
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> case Value
value of
                Object Object
vo -> Object
vo Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"name"
                Value
_ -> Maybe Text -> Parser (Maybe Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Text
forall a. Maybe a
Nothing
      Text
_ -> CustomField -> Parser CustomField
forall (f :: * -> *) a. Applicative f => a -> f a
pure CustomField
Other

putCustomField
  :: (MonadUnliftIO m, MonadLogger m, MonadReader env m, HasAsanaAccessKey env)
  => Gid
  -> CustomField
  -> m ()
putCustomField :: Gid -> CustomField -> m ()
putCustomField Gid
taskId = Gid -> CustomFields -> m ()
forall (m :: * -> *) env.
(MonadUnliftIO m, MonadLogger m, MonadReader env m,
 HasAsanaAccessKey env) =>
Gid -> CustomFields -> m ()
putCustomFields Gid
taskId (CustomFields -> m ())
-> (CustomField -> CustomFields) -> CustomField -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [CustomField] -> CustomFields
CustomFields ([CustomField] -> CustomFields)
-> (CustomField -> [CustomField]) -> CustomField -> CustomFields
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CustomField -> [CustomField]
forall (f :: * -> *) a. Applicative f => a -> f a
pure

putCustomFields
  :: (MonadUnliftIO m, MonadLogger m, MonadReader env m, HasAsanaAccessKey env)
  => Gid
  -> CustomFields
  -> m ()
putCustomFields :: Gid -> CustomFields -> m ()
putCustomFields Gid
taskId CustomFields
fields =
  m Value -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m Value -> m ()) -> m Value -> m ()
forall a b. (a -> b) -> a -> b
$ String -> ApiData Value -> m Value
forall (m :: * -> *) env a.
(MonadUnliftIO m, MonadLogger m, MonadReader env m,
 HasAsanaAccessKey env, ToJSON a) =>
String -> a -> m Value
put (String
"/tasks/" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack (Gid -> Text
gidToText Gid
taskId)) (ApiData Value -> m Value) -> ApiData Value -> m Value
forall a b. (a -> b) -> a -> b
$ Value -> ApiData Value
forall a. a -> ApiData a
ApiData
    ([Pair] -> Value
object [Key
"custom_fields" Key -> CustomFields -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= CustomFields
fields])