{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
module FCMClient.Types (
J.FCMData
, FCMPriority(..)
, FCMLocValue(..)
, J.FCMNotification
, J.fcmTitle
, J.fcmBody
, J.fcmIcon
, J.fcmSound
, J.fcmTag
, J.fcmColor
, J.fcmBadge
, J.fcmClickAction
, J.fcmBodyLocKey
, fcmBodyLocArgs
, J.fcmTitleLocKey
, fcmTitleLocArgs
, J.FCMMessage
, J.fcmTo
, J.fcmRegistrationIDs
, J.fcmCondition
, J.fcmCollapseKey
, fcmPriority
, fcmContentAvailable
, fcmDelayWhileIdle
, J.fcmTimeToLive
, J.fcmRestrictedPackageName
, fcmDryRun
, J.fcmData
, J.fcmNotification
, fcmWithNotification
, J.FCMResult ( J.FCMResultSuccess
, J.FCMResultError
)
, J._FCMResultSuccess
, J._FCMResultError
, J.FCMClientError ( J.FCMErrorResponseInvalidJSON
, J.FCMErrorResponseInvalidAuth
, J.FCMServerError
, J.FCMClientJSONError
, J.FCMClientHTTPError
)
, J.fcmErrorMessage
, J.fcmErrorHttpStatus
, J._FCMErrorResponseInvalidJSON
, J._FCMErrorResponseInvalidAuth
, J._FCMServerError
, J._FCMClientJSONError
, J._FCMClientHTTPError
, J.FCMResponseBody(..)
, J.FCMMessageResponse
, J._FCMMessageResponse
, J._FCMTopicResponse
, J.fcmCanonicalIds
, J.fcmFailure
, J.fcmMulticastId
, J.fcmResults
, J.fcmSuccess
, J.FCMMessageResponseResult(..)
, J._FCMMessageResponseResultOk
, J._FCMMessageResponseResultError
, J.FCMMessageResponseResultOk
, J.fcmMessageId
, J.fcmRegistrationId
, J.FCMTopicResponse(..)
, J.FCMTopicResponseOk
, J._FCMTopicResponseOk
, J._FCMTopicResponseError
, J.fcmTopicMessageId
, J.FCMError(..)
) where
import Control.Lens
import Data.Aeson
import Data.Aeson.Types as J
import Data.Default.Class
import Data.List.NonEmpty (nonEmpty)
import Data.Maybe
import Data.Scientific (Scientific)
import Data.String
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Lazy as LT
import qualified Data.Text.Lazy.Encoding as TE
import qualified FCMClient.JSON.Types as J
data FCMPriority = FCMPriorityNormal
| FCMPriorityHigh
deriving (Eq, Show, Ord)
data FCMLocValue = FCMLocString !Text
| FCMLocNumber !Scientific
| FCMLocBool !Bool
deriving (Eq, Read, Show, Ord)
instance ToJSON FCMLocValue where
toJSON (FCMLocString x) = toJSON x
toJSON (FCMLocNumber x) = toJSON x
toJSON (FCMLocBool x) = toJSON x
toEncoding (FCMLocString x) = toEncoding x
toEncoding (FCMLocNumber x) = toEncoding x
toEncoding (FCMLocBool x) = toEncoding x
instance FromJSON FCMLocValue where
parseJSON (J.String x) = return $ FCMLocString x
parseJSON (J.Number x) = return $ FCMLocNumber x
parseJSON (J.Bool x) = return $ FCMLocBool x
parseJSON _ = fail "FCMLocValue"
instance IsString FCMLocValue where
fromString = FCMLocString . T.pack
aesonTxtPr :: (Applicative f, Choice p, ToJSON a1, FromJSON a)
=> p [a] (f [a1])
-> p (Maybe Text) (f (Maybe Text))
aesonTxtPr =
(prism' (fmap (LT.toStrict . TE.decodeUtf8)) (Just . (fmap (TE.encodeUtf8 . LT.fromStrict)))) .
(prism' (fmap (encode) . nonEmpty) (Just . fromMaybe [] . decode . fromMaybe ""))
fcmBodyLocArgs :: (Applicative f)
=> ([FCMLocValue] -> f [FCMLocValue])
-> J.FCMNotification -> f J.FCMNotification
fcmBodyLocArgs = J.fcmBodyLocArgs . aesonTxtPr
fcmTitleLocArgs :: (Applicative f)
=> ([FCMLocValue] -> f [FCMLocValue])
-> J.FCMNotification -> f J.FCMNotification
fcmTitleLocArgs = J.fcmTitleLocArgs . aesonTxtPr
fcmPriority :: (Applicative f)
=> (FCMPriority -> f FCMPriority)
-> J.FCMMessage -> f J.FCMMessage
fcmPriority = J.fcmPriority . (prism' fcmPriorityToText (Just .textToFcmPriority))
where fcmPriorityToText FCMPriorityNormal = Nothing
fcmPriorityToText FCMPriorityHigh = Just "high"
textToFcmPriority (Just "high") = FCMPriorityHigh
textToFcmPriority _ = FCMPriorityNormal
maybeBoolPr :: (Applicative f)
=> (Bool -> f Bool)
-> (Maybe Bool) -> f (Maybe Bool)
maybeBoolPr = prism' (\x -> if x then Just x else Nothing) (Just . fromMaybe False)
fcmContentAvailable :: (Applicative f)
=> (Bool -> f Bool)
-> J.FCMMessage -> f J.FCMMessage
fcmContentAvailable = J.fcmContentAvailable . maybeBoolPr
fcmDelayWhileIdle :: (Applicative f)
=> (Bool -> f Bool)
-> J.FCMMessage -> f J.FCMMessage
fcmDelayWhileIdle = J.fcmDelayWhileIdle . maybeBoolPr
fcmDryRun :: (Applicative f)
=> (Bool -> f Bool)
-> J.FCMMessage -> f J.FCMMessage
fcmDryRun = J.fcmDryRun . maybeBoolPr
fcmWithNotification :: (Applicative f)
=> (J.FCMNotification -> f J.FCMNotification)
-> J.FCMMessage -> f J.FCMMessage
fcmWithNotification = J.fcmNotification . justNotif
where justNotif f maybeN = case maybeN
of Nothing -> fmap Just (f def)
Just n -> fmap Just (f n)