{-# LANGUAGE OverloadedStrings #-}
module FCMClient.Types (
module Control.Lens
, module Data.Aeson
, module Data.Default.Class
, module Data.Scientific
, module FCMClient.JSON.Types
, FCMLocValue(..)
, FCMPriority(..)
, fcmBodyLocArgs
, fcmContentAvailable
, fcmDelayWhileIdle
, fcmDryRun
, fcmPriority
, fcmTitleLocArgs
, fcmWithNotification
) where
import Control.Lens
import Data.Aeson (encode, decode)
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 FCMClient.JSON.Types hiding ( fcmBodyLocArgs
, fcmContentAvailable
, fcmDelayWhileIdle
, fcmDryRun
, fcmPriority
, fcmTitleLocArgs
)
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)