{-# LANGUAGE TemplateHaskell #-}

module Hasura.GraphQL.Execute.Subscription.Options
  ( SubscriptionsOptions (..),
    LiveQueriesOptions,
    StreamQueriesOptions,
    BatchSize (..),
    RefetchInterval (..),
    mkSubscriptionsOptions,
    mkBatchSize,
    mkRefetchInterval,
  )
where

import Data.Aeson qualified as J
import Hasura.Base.Instances ()
import Hasura.Prelude
import Refined (NonNegative, Refined, refineFail, refineTH)

data SubscriptionsOptions = SubscriptionsOptions
  { SubscriptionsOptions -> BatchSize
_lqoBatchSize :: !BatchSize,
    SubscriptionsOptions -> RefetchInterval
_lqoRefetchInterval :: !RefetchInterval
  }
  deriving (Int -> SubscriptionsOptions -> ShowS
[SubscriptionsOptions] -> ShowS
SubscriptionsOptions -> String
(Int -> SubscriptionsOptions -> ShowS)
-> (SubscriptionsOptions -> String)
-> ([SubscriptionsOptions] -> ShowS)
-> Show SubscriptionsOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SubscriptionsOptions -> ShowS
showsPrec :: Int -> SubscriptionsOptions -> ShowS
$cshow :: SubscriptionsOptions -> String
show :: SubscriptionsOptions -> String
$cshowList :: [SubscriptionsOptions] -> ShowS
showList :: [SubscriptionsOptions] -> ShowS
Show, SubscriptionsOptions -> SubscriptionsOptions -> Bool
(SubscriptionsOptions -> SubscriptionsOptions -> Bool)
-> (SubscriptionsOptions -> SubscriptionsOptions -> Bool)
-> Eq SubscriptionsOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SubscriptionsOptions -> SubscriptionsOptions -> Bool
== :: SubscriptionsOptions -> SubscriptionsOptions -> Bool
$c/= :: SubscriptionsOptions -> SubscriptionsOptions -> Bool
/= :: SubscriptionsOptions -> SubscriptionsOptions -> Bool
Eq)

type LiveQueriesOptions = SubscriptionsOptions

type StreamQueriesOptions = SubscriptionsOptions

mkSubscriptionsOptions :: Maybe BatchSize -> Maybe RefetchInterval -> SubscriptionsOptions
mkSubscriptionsOptions :: Maybe BatchSize -> Maybe RefetchInterval -> SubscriptionsOptions
mkSubscriptionsOptions Maybe BatchSize
batchSize Maybe RefetchInterval
refetchInterval =
  SubscriptionsOptions
    { _lqoBatchSize :: BatchSize
_lqoBatchSize = BatchSize -> Maybe BatchSize -> BatchSize
forall a. a -> Maybe a -> a
fromMaybe (Refined NonNegative Int -> BatchSize
BatchSize $$(refineTH 100)) Maybe BatchSize
batchSize,
      _lqoRefetchInterval :: RefetchInterval
_lqoRefetchInterval = RefetchInterval -> Maybe RefetchInterval -> RefetchInterval
forall a. a -> Maybe a -> a
fromMaybe (Refined NonNegative DiffTime -> RefetchInterval
RefetchInterval $$(refineTH 1)) Maybe RefetchInterval
refetchInterval
    }

instance J.ToJSON SubscriptionsOptions where
  toJSON :: SubscriptionsOptions -> Value
toJSON (SubscriptionsOptions BatchSize
batchSize RefetchInterval
refetchInterval) =
    [Pair] -> Value
J.object
      [ Key
"batch_size" Key -> BatchSize -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
J..= BatchSize
batchSize,
        Key
"refetch_delay" Key -> RefetchInterval -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
J..= RefetchInterval
refetchInterval
      ]

instance J.FromJSON SubscriptionsOptions where
  parseJSON :: Value -> Parser SubscriptionsOptions
parseJSON = String
-> (Object -> Parser SubscriptionsOptions)
-> Value
-> Parser SubscriptionsOptions
forall a. String -> (Object -> Parser a) -> Value -> Parser a
J.withObject String
"live query options" \Object
o ->
    BatchSize -> RefetchInterval -> SubscriptionsOptions
SubscriptionsOptions
      (BatchSize -> RefetchInterval -> SubscriptionsOptions)
-> Parser BatchSize
-> Parser (RefetchInterval -> SubscriptionsOptions)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o
      Object -> Key -> Parser BatchSize
forall a. FromJSON a => Object -> Key -> Parser a
J..: Key
"batch_size"
      Parser (RefetchInterval -> SubscriptionsOptions)
-> Parser RefetchInterval -> Parser SubscriptionsOptions
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o
      Object -> Key -> Parser RefetchInterval
forall a. FromJSON a => Object -> Key -> Parser a
J..: Key
"refetch_delay"

newtype BatchSize = BatchSize {BatchSize -> Refined NonNegative Int
unBatchSize :: Refined NonNegative Int}
  deriving (Int -> BatchSize -> ShowS
[BatchSize] -> ShowS
BatchSize -> String
(Int -> BatchSize -> ShowS)
-> (BatchSize -> String)
-> ([BatchSize] -> ShowS)
-> Show BatchSize
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BatchSize -> ShowS
showsPrec :: Int -> BatchSize -> ShowS
$cshow :: BatchSize -> String
show :: BatchSize -> String
$cshowList :: [BatchSize] -> ShowS
showList :: [BatchSize] -> ShowS
Show, BatchSize -> BatchSize -> Bool
(BatchSize -> BatchSize -> Bool)
-> (BatchSize -> BatchSize -> Bool) -> Eq BatchSize
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BatchSize -> BatchSize -> Bool
== :: BatchSize -> BatchSize -> Bool
$c/= :: BatchSize -> BatchSize -> Bool
/= :: BatchSize -> BatchSize -> Bool
Eq, [BatchSize] -> Value
[BatchSize] -> Encoding
BatchSize -> Value
BatchSize -> Encoding
(BatchSize -> Value)
-> (BatchSize -> Encoding)
-> ([BatchSize] -> Value)
-> ([BatchSize] -> Encoding)
-> ToJSON BatchSize
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: BatchSize -> Value
toJSON :: BatchSize -> Value
$ctoEncoding :: BatchSize -> Encoding
toEncoding :: BatchSize -> Encoding
$ctoJSONList :: [BatchSize] -> Value
toJSONList :: [BatchSize] -> Value
$ctoEncodingList :: [BatchSize] -> Encoding
toEncodingList :: [BatchSize] -> Encoding
J.ToJSON, Value -> Parser [BatchSize]
Value -> Parser BatchSize
(Value -> Parser BatchSize)
-> (Value -> Parser [BatchSize]) -> FromJSON BatchSize
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser BatchSize
parseJSON :: Value -> Parser BatchSize
$cparseJSONList :: Value -> Parser [BatchSize]
parseJSONList :: Value -> Parser [BatchSize]
J.FromJSON)

mkBatchSize :: Int -> Maybe BatchSize
mkBatchSize :: Int -> Maybe BatchSize
mkBatchSize Int
x = Refined NonNegative Int -> BatchSize
BatchSize (Refined NonNegative Int -> BatchSize)
-> Maybe (Refined NonNegative Int) -> Maybe BatchSize
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Maybe (Refined NonNegative Int)
forall {k} (p :: k) x (m :: * -> *).
(Predicate p x, MonadFail m) =>
x -> m (Refined p x)
refineFail Int
x

-- TODO this is treated as milliseconds in fromEnv and as seconds in ToJSON.
--      ideally this would have e.g. ... unRefetchInterval :: Milliseconds
newtype RefetchInterval = RefetchInterval {RefetchInterval -> Refined NonNegative DiffTime
unRefetchInterval :: Refined NonNegative DiffTime}
  deriving (Int -> RefetchInterval -> ShowS
[RefetchInterval] -> ShowS
RefetchInterval -> String
(Int -> RefetchInterval -> ShowS)
-> (RefetchInterval -> String)
-> ([RefetchInterval] -> ShowS)
-> Show RefetchInterval
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RefetchInterval -> ShowS
showsPrec :: Int -> RefetchInterval -> ShowS
$cshow :: RefetchInterval -> String
show :: RefetchInterval -> String
$cshowList :: [RefetchInterval] -> ShowS
showList :: [RefetchInterval] -> ShowS
Show, RefetchInterval -> RefetchInterval -> Bool
(RefetchInterval -> RefetchInterval -> Bool)
-> (RefetchInterval -> RefetchInterval -> Bool)
-> Eq RefetchInterval
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RefetchInterval -> RefetchInterval -> Bool
== :: RefetchInterval -> RefetchInterval -> Bool
$c/= :: RefetchInterval -> RefetchInterval -> Bool
/= :: RefetchInterval -> RefetchInterval -> Bool
Eq, [RefetchInterval] -> Value
[RefetchInterval] -> Encoding
RefetchInterval -> Value
RefetchInterval -> Encoding
(RefetchInterval -> Value)
-> (RefetchInterval -> Encoding)
-> ([RefetchInterval] -> Value)
-> ([RefetchInterval] -> Encoding)
-> ToJSON RefetchInterval
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: RefetchInterval -> Value
toJSON :: RefetchInterval -> Value
$ctoEncoding :: RefetchInterval -> Encoding
toEncoding :: RefetchInterval -> Encoding
$ctoJSONList :: [RefetchInterval] -> Value
toJSONList :: [RefetchInterval] -> Value
$ctoEncodingList :: [RefetchInterval] -> Encoding
toEncodingList :: [RefetchInterval] -> Encoding
J.ToJSON, Value -> Parser [RefetchInterval]
Value -> Parser RefetchInterval
(Value -> Parser RefetchInterval)
-> (Value -> Parser [RefetchInterval]) -> FromJSON RefetchInterval
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser RefetchInterval
parseJSON :: Value -> Parser RefetchInterval
$cparseJSONList :: Value -> Parser [RefetchInterval]
parseJSONList :: Value -> Parser [RefetchInterval]
J.FromJSON)

mkRefetchInterval :: DiffTime -> Maybe RefetchInterval
mkRefetchInterval :: DiffTime -> Maybe RefetchInterval
mkRefetchInterval DiffTime
x = Refined NonNegative DiffTime -> RefetchInterval
RefetchInterval (Refined NonNegative DiffTime -> RefetchInterval)
-> Maybe (Refined NonNegative DiffTime) -> Maybe RefetchInterval
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DiffTime -> Maybe (Refined NonNegative DiffTime)
forall {k} (p :: k) x (m :: * -> *).
(Predicate p x, MonadFail m) =>
x -> m (Refined p x)
refineFail DiffTime
x