{-# LANGUAGE OverloadedStrings #-}

-- | Deduplication strategy carried by a job at enqueue.
module Arbiter.Core.Job.Dedup
  ( DedupKey (..)
  , dedupParts
  ) where

import Data.Aeson (FromJSON (..), ToJSON (..), object, withObject, (.:), (.=))
import Data.Aeson.Types (Parser)
import Data.Text (Text)
import GHC.Generics (Generic)

-- | Deduplication strategy, checked on INSERT via @ON CONFLICT@ on the dedup key.
data DedupKey
  = -- | Skip if a job with this key exists (@DO NOTHING@).
    IgnoreDuplicate Text
  | -- | Replace the existing job with this key (@DO UPDATE@), unless it is
    -- actively claimed, force-cancel flagged, or has children.
    ReplaceDuplicate Text
  deriving stock (DedupKey -> DedupKey -> Bool
(DedupKey -> DedupKey -> Bool)
-> (DedupKey -> DedupKey -> Bool) -> Eq DedupKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DedupKey -> DedupKey -> Bool
== :: DedupKey -> DedupKey -> Bool
$c/= :: DedupKey -> DedupKey -> Bool
/= :: DedupKey -> DedupKey -> Bool
Eq, (forall x. DedupKey -> Rep DedupKey x)
-> (forall x. Rep DedupKey x -> DedupKey) -> Generic DedupKey
forall x. Rep DedupKey x -> DedupKey
forall x. DedupKey -> Rep DedupKey x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DedupKey -> Rep DedupKey x
from :: forall x. DedupKey -> Rep DedupKey x
$cto :: forall x. Rep DedupKey x -> DedupKey
to :: forall x. Rep DedupKey x -> DedupKey
Generic, Int -> DedupKey -> ShowS
[DedupKey] -> ShowS
DedupKey -> String
(Int -> DedupKey -> ShowS)
-> (DedupKey -> String) -> ([DedupKey] -> ShowS) -> Show DedupKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DedupKey -> ShowS
showsPrec :: Int -> DedupKey -> ShowS
$cshow :: DedupKey -> String
show :: DedupKey -> String
$cshowList :: [DedupKey] -> ShowS
showList :: [DedupKey] -> ShowS
Show)

instance ToJSON DedupKey where
  toJSON :: DedupKey -> Value
toJSON (IgnoreDuplicate Text
key) = [Pair] -> Value
object [Key
"key" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
key, Key
"strategy" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"ignore" :: Text)]
  toJSON (ReplaceDuplicate Text
key) = [Pair] -> Value
object [Key
"key" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
key, Key
"strategy" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"replace" :: Text)]

instance FromJSON DedupKey where
  parseJSON :: Value -> Parser DedupKey
parseJSON = String -> (Object -> Parser DedupKey) -> Value -> Parser DedupKey
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"DedupKey" ((Object -> Parser DedupKey) -> Value -> Parser DedupKey)
-> (Object -> Parser DedupKey) -> Value -> Parser DedupKey
forall a b. (a -> b) -> a -> b
$ \Object
obj -> do
    key <- Object
obj Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"key"
    strategy <- obj .: "strategy" :: Parser Text
    case strategy of
      Text
"ignore" -> DedupKey -> Parser DedupKey
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DedupKey -> Parser DedupKey) -> DedupKey -> Parser DedupKey
forall a b. (a -> b) -> a -> b
$ Text -> DedupKey
IgnoreDuplicate Text
key
      Text
"replace" -> DedupKey -> Parser DedupKey
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DedupKey -> Parser DedupKey) -> DedupKey -> Parser DedupKey
forall a b. (a -> b) -> a -> b
$ Text -> DedupKey
ReplaceDuplicate Text
key
      Text
_ -> String -> Parser DedupKey
forall a. HasCallStack => String -> Parser a
forall (m :: * -> *) a.
(MonadFail m, HasCallStack) =>
String -> m a
fail (String -> Parser DedupKey) -> String -> Parser DedupKey
forall a b. (a -> b) -> a -> b
$ String
"Unknown dedup strategy: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a. Show a => a -> String
show Text
strategy

-- | The @dedup_key@ and @dedup_strategy@ column values for a 'DedupKey'.
dedupParts :: Maybe DedupKey -> (Maybe Text, Maybe Text)
dedupParts :: Maybe DedupKey -> (Maybe Text, Maybe Text)
dedupParts Maybe DedupKey
Nothing = (Maybe Text
forall a. Maybe a
Nothing, Maybe Text
forall a. Maybe a
Nothing)
dedupParts (Just (IgnoreDuplicate Text
key)) = (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
key, Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"ignore")
dedupParts (Just (ReplaceDuplicate Text
key)) = (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
key, Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"replace")