{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Data.Mergeless.Item where

import Autodocodec
import Control.DeepSeq
import Data.Aeson (FromJSON, ToJSON)
import Data.Text (Text)
import Data.Validity
import Data.Validity.Containers ()
import GHC.Generics (Generic)

{-# ANN module ("HLint: ignore Use lambda-case" :: String) #-}

data ClientItem a
  = ClientEmpty
  | ClientAdded !a
  | ClientSynced !a
  | ClientDeleted
  deriving stock (Int -> ClientItem a -> ShowS
[ClientItem a] -> ShowS
ClientItem a -> String
(Int -> ClientItem a -> ShowS)
-> (ClientItem a -> String)
-> ([ClientItem a] -> ShowS)
-> Show (ClientItem a)
forall a. Show a => Int -> ClientItem a -> ShowS
forall a. Show a => [ClientItem a] -> ShowS
forall a. Show a => ClientItem a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ClientItem a] -> ShowS
$cshowList :: forall a. Show a => [ClientItem a] -> ShowS
show :: ClientItem a -> String
$cshow :: forall a. Show a => ClientItem a -> String
showsPrec :: Int -> ClientItem a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> ClientItem a -> ShowS
Show, ClientItem a -> ClientItem a -> Bool
(ClientItem a -> ClientItem a -> Bool)
-> (ClientItem a -> ClientItem a -> Bool) -> Eq (ClientItem a)
forall a. Eq a => ClientItem a -> ClientItem a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ClientItem a -> ClientItem a -> Bool
$c/= :: forall a. Eq a => ClientItem a -> ClientItem a -> Bool
== :: ClientItem a -> ClientItem a -> Bool
$c== :: forall a. Eq a => ClientItem a -> ClientItem a -> Bool
Eq, Eq (ClientItem a)
Eq (ClientItem a)
-> (ClientItem a -> ClientItem a -> Ordering)
-> (ClientItem a -> ClientItem a -> Bool)
-> (ClientItem a -> ClientItem a -> Bool)
-> (ClientItem a -> ClientItem a -> Bool)
-> (ClientItem a -> ClientItem a -> Bool)
-> (ClientItem a -> ClientItem a -> ClientItem a)
-> (ClientItem a -> ClientItem a -> ClientItem a)
-> Ord (ClientItem a)
ClientItem a -> ClientItem a -> Bool
ClientItem a -> ClientItem a -> Ordering
ClientItem a -> ClientItem a -> ClientItem a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (ClientItem a)
forall a. Ord a => ClientItem a -> ClientItem a -> Bool
forall a. Ord a => ClientItem a -> ClientItem a -> Ordering
forall a. Ord a => ClientItem a -> ClientItem a -> ClientItem a
min :: ClientItem a -> ClientItem a -> ClientItem a
$cmin :: forall a. Ord a => ClientItem a -> ClientItem a -> ClientItem a
max :: ClientItem a -> ClientItem a -> ClientItem a
$cmax :: forall a. Ord a => ClientItem a -> ClientItem a -> ClientItem a
>= :: ClientItem a -> ClientItem a -> Bool
$c>= :: forall a. Ord a => ClientItem a -> ClientItem a -> Bool
> :: ClientItem a -> ClientItem a -> Bool
$c> :: forall a. Ord a => ClientItem a -> ClientItem a -> Bool
<= :: ClientItem a -> ClientItem a -> Bool
$c<= :: forall a. Ord a => ClientItem a -> ClientItem a -> Bool
< :: ClientItem a -> ClientItem a -> Bool
$c< :: forall a. Ord a => ClientItem a -> ClientItem a -> Bool
compare :: ClientItem a -> ClientItem a -> Ordering
$ccompare :: forall a. Ord a => ClientItem a -> ClientItem a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (ClientItem a)
Ord, (forall x. ClientItem a -> Rep (ClientItem a) x)
-> (forall x. Rep (ClientItem a) x -> ClientItem a)
-> Generic (ClientItem a)
forall x. Rep (ClientItem a) x -> ClientItem a
forall x. ClientItem a -> Rep (ClientItem a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (ClientItem a) x -> ClientItem a
forall a x. ClientItem a -> Rep (ClientItem a) x
$cto :: forall a x. Rep (ClientItem a) x -> ClientItem a
$cfrom :: forall a x. ClientItem a -> Rep (ClientItem a) x
Generic)
  deriving (Value -> Parser [ClientItem a]
Value -> Parser (ClientItem a)
(Value -> Parser (ClientItem a))
-> (Value -> Parser [ClientItem a]) -> FromJSON (ClientItem a)
forall a. HasCodec a => Value -> Parser [ClientItem a]
forall a. HasCodec a => Value -> Parser (ClientItem a)
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [ClientItem a]
$cparseJSONList :: forall a. HasCodec a => Value -> Parser [ClientItem a]
parseJSON :: Value -> Parser (ClientItem a)
$cparseJSON :: forall a. HasCodec a => Value -> Parser (ClientItem a)
FromJSON, [ClientItem a] -> Encoding
[ClientItem a] -> Value
ClientItem a -> Encoding
ClientItem a -> Value
(ClientItem a -> Value)
-> (ClientItem a -> Encoding)
-> ([ClientItem a] -> Value)
-> ([ClientItem a] -> Encoding)
-> ToJSON (ClientItem a)
forall a. HasCodec a => [ClientItem a] -> Encoding
forall a. HasCodec a => [ClientItem a] -> Value
forall a. HasCodec a => ClientItem a -> Encoding
forall a. HasCodec a => ClientItem a -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [ClientItem a] -> Encoding
$ctoEncodingList :: forall a. HasCodec a => [ClientItem a] -> Encoding
toJSONList :: [ClientItem a] -> Value
$ctoJSONList :: forall a. HasCodec a => [ClientItem a] -> Value
toEncoding :: ClientItem a -> Encoding
$ctoEncoding :: forall a. HasCodec a => ClientItem a -> Encoding
toJSON :: ClientItem a -> Value
$ctoJSON :: forall a. HasCodec a => ClientItem a -> Value
ToJSON) via (Autodocodec (ClientItem a))

instance Validity a => Validity (ClientItem a)

instance NFData a => NFData (ClientItem a)

instance HasCodec a => HasCodec (ClientItem a) where
  codec :: JSONCodec (ClientItem a)
codec =
    Text
-> ObjectCodec (ClientItem a) (ClientItem a)
-> JSONCodec (ClientItem a)
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
object Text
"ClientItem" (ObjectCodec (ClientItem a) (ClientItem a)
 -> JSONCodec (ClientItem a))
-> ObjectCodec (ClientItem a) (ClientItem a)
-> JSONCodec (ClientItem a)
forall a b. (a -> b) -> a -> b
$
      (Either (Either () a) (Either a ()) -> ClientItem a)
-> (ClientItem a -> Either (Either () a) (Either a ()))
-> Codec
     Object
     (Either (Either () a) (Either a ()))
     (Either (Either () a) (Either a ()))
-> ObjectCodec (ClientItem a) (ClientItem a)
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec Either (Either () a) (Either a ()) -> ClientItem a
f ClientItem a -> Either (Either () a) (Either a ())
g (Codec
   Object
   (Either (Either () a) (Either a ()))
   (Either (Either () a) (Either a ()))
 -> ObjectCodec (ClientItem a) (ClientItem a))
-> Codec
     Object
     (Either (Either () a) (Either a ()))
     (Either (Either () a) (Either a ()))
-> ObjectCodec (ClientItem a) (ClientItem a)
forall a b. (a -> b) -> a -> b
$
        Codec Object (Either () a) (Either () a)
-> Codec Object (Either a ()) (Either a ())
-> Codec
     Object
     (Either (Either () a) (Either a ()))
     (Either (Either () a) (Either a ()))
forall context input1 output1 input2 output2.
Codec context input1 output1
-> Codec context input2 output2
-> Codec context (Either input1 input2) (Either output1 output2)
disjointEitherCodec
          ( Codec Object () ()
-> Codec Object a a -> Codec Object (Either () a) (Either () a)
forall context input1 output1 input2 output2.
Codec context input1 output1
-> Codec context input2 output2
-> Codec context (Either input1 input2) (Either output1 output2)
disjointEitherCodec
              (Text -> ObjectCodec () (() -> ())
forall b x. Text -> ObjectCodec b (x -> x)
typeField Text
"empty" ObjectCodec () (() -> ())
-> Codec Object () () -> Codec Object () ()
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> () -> Codec Object () ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
              (Text -> ObjectCodec a (a -> a)
forall b x. Text -> ObjectCodec b (x -> x)
typeField Text
"added" ObjectCodec a (a -> a) -> Codec Object a a -> Codec Object a a
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> Text -> Codec Object a a
forall output.
HasCodec output =>
Text -> Text -> ObjectCodec output output
requiredField Text
"value" Text
"item that was added, client-side")
          )
          ( Codec Object a a
-> Codec Object () () -> Codec Object (Either a ()) (Either a ())
forall context input1 output1 input2 output2.
Codec context input1 output1
-> Codec context input2 output2
-> Codec context (Either input1 input2) (Either output1 output2)
disjointEitherCodec
              (Text -> ObjectCodec a (a -> a)
forall b x. Text -> ObjectCodec b (x -> x)
typeField Text
"synced" ObjectCodec a (a -> a) -> Codec Object a a -> Codec Object a a
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> Text -> Codec Object a a
forall output.
HasCodec output =>
Text -> Text -> ObjectCodec output output
requiredField Text
"value" Text
"the item that is known, client-side")
              (Text -> ObjectCodec () (() -> ())
forall b x. Text -> ObjectCodec b (x -> x)
typeField Text
"deleted" ObjectCodec () (() -> ())
-> Codec Object () () -> Codec Object () ()
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> () -> Codec Object () ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
          )
    where
      f :: Either (Either () a) (Either a ()) -> ClientItem a
      f :: Either (Either () a) (Either a ()) -> ClientItem a
f = \case
        Left (Left ()) -> ClientItem a
forall a. ClientItem a
ClientEmpty
        Left (Right a
v) -> a -> ClientItem a
forall a. a -> ClientItem a
ClientAdded a
v
        Right (Left a
v) -> a -> ClientItem a
forall a. a -> ClientItem a
ClientSynced a
v
        Right (Right ()) -> ClientItem a
forall a. ClientItem a
ClientDeleted
      g :: ClientItem a -> Either (Either () a) (Either a ())
      g :: ClientItem a -> Either (Either () a) (Either a ())
g = \case
        ClientItem a
ClientEmpty -> Either () a -> Either (Either () a) (Either a ())
forall a b. a -> Either a b
Left (() -> Either () a
forall a b. a -> Either a b
Left ())
        ClientAdded a
v -> Either () a -> Either (Either () a) (Either a ())
forall a b. a -> Either a b
Left (a -> Either () a
forall a b. b -> Either a b
Right a
v)
        ClientSynced a
v -> Either a () -> Either (Either () a) (Either a ())
forall a b. b -> Either a b
Right (a -> Either a ()
forall a b. a -> Either a b
Left a
v)
        ClientItem a
ClientDeleted -> Either a () -> Either (Either () a) (Either a ())
forall a b. b -> Either a b
Right (() -> Either a ()
forall a b. b -> Either a b
Right ())

      typeField :: Text -> ObjectCodec b (x -> x)
      typeField :: Text -> ObjectCodec b (x -> x)
typeField Text
typeName = x -> x
forall a. a -> a
id (x -> x) -> Codec Object b Text -> ObjectCodec b (x -> x)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ValueCodec Text Text -> ObjectCodec Text Text
forall input output.
Text -> ValueCodec input output -> ObjectCodec input output
requiredFieldWith' Text
"type" (Text -> ValueCodec Text Text
literalTextCodec Text
typeName) ObjectCodec Text Text -> (b -> Text) -> Codec Object b Text
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= Text -> b -> Text
forall a b. a -> b -> a
const Text
typeName

-- | A synchronisation request for items with identifiers of type @i@ and values of type @a@
data ItemSyncRequest a
  = ItemSyncRequestPoll
  | ItemSyncRequestNew !a
  | ItemSyncRequestKnown
  | ItemSyncRequestDeleted
  deriving stock (Int -> ItemSyncRequest a -> ShowS
[ItemSyncRequest a] -> ShowS
ItemSyncRequest a -> String
(Int -> ItemSyncRequest a -> ShowS)
-> (ItemSyncRequest a -> String)
-> ([ItemSyncRequest a] -> ShowS)
-> Show (ItemSyncRequest a)
forall a. Show a => Int -> ItemSyncRequest a -> ShowS
forall a. Show a => [ItemSyncRequest a] -> ShowS
forall a. Show a => ItemSyncRequest a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ItemSyncRequest a] -> ShowS
$cshowList :: forall a. Show a => [ItemSyncRequest a] -> ShowS
show :: ItemSyncRequest a -> String
$cshow :: forall a. Show a => ItemSyncRequest a -> String
showsPrec :: Int -> ItemSyncRequest a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> ItemSyncRequest a -> ShowS
Show, ItemSyncRequest a -> ItemSyncRequest a -> Bool
(ItemSyncRequest a -> ItemSyncRequest a -> Bool)
-> (ItemSyncRequest a -> ItemSyncRequest a -> Bool)
-> Eq (ItemSyncRequest a)
forall a. Eq a => ItemSyncRequest a -> ItemSyncRequest a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ItemSyncRequest a -> ItemSyncRequest a -> Bool
$c/= :: forall a. Eq a => ItemSyncRequest a -> ItemSyncRequest a -> Bool
== :: ItemSyncRequest a -> ItemSyncRequest a -> Bool
$c== :: forall a. Eq a => ItemSyncRequest a -> ItemSyncRequest a -> Bool
Eq, Eq (ItemSyncRequest a)
Eq (ItemSyncRequest a)
-> (ItemSyncRequest a -> ItemSyncRequest a -> Ordering)
-> (ItemSyncRequest a -> ItemSyncRequest a -> Bool)
-> (ItemSyncRequest a -> ItemSyncRequest a -> Bool)
-> (ItemSyncRequest a -> ItemSyncRequest a -> Bool)
-> (ItemSyncRequest a -> ItemSyncRequest a -> Bool)
-> (ItemSyncRequest a -> ItemSyncRequest a -> ItemSyncRequest a)
-> (ItemSyncRequest a -> ItemSyncRequest a -> ItemSyncRequest a)
-> Ord (ItemSyncRequest a)
ItemSyncRequest a -> ItemSyncRequest a -> Bool
ItemSyncRequest a -> ItemSyncRequest a -> Ordering
ItemSyncRequest a -> ItemSyncRequest a -> ItemSyncRequest a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (ItemSyncRequest a)
forall a. Ord a => ItemSyncRequest a -> ItemSyncRequest a -> Bool
forall a.
Ord a =>
ItemSyncRequest a -> ItemSyncRequest a -> Ordering
forall a.
Ord a =>
ItemSyncRequest a -> ItemSyncRequest a -> ItemSyncRequest a
min :: ItemSyncRequest a -> ItemSyncRequest a -> ItemSyncRequest a
$cmin :: forall a.
Ord a =>
ItemSyncRequest a -> ItemSyncRequest a -> ItemSyncRequest a
max :: ItemSyncRequest a -> ItemSyncRequest a -> ItemSyncRequest a
$cmax :: forall a.
Ord a =>
ItemSyncRequest a -> ItemSyncRequest a -> ItemSyncRequest a
>= :: ItemSyncRequest a -> ItemSyncRequest a -> Bool
$c>= :: forall a. Ord a => ItemSyncRequest a -> ItemSyncRequest a -> Bool
> :: ItemSyncRequest a -> ItemSyncRequest a -> Bool
$c> :: forall a. Ord a => ItemSyncRequest a -> ItemSyncRequest a -> Bool
<= :: ItemSyncRequest a -> ItemSyncRequest a -> Bool
$c<= :: forall a. Ord a => ItemSyncRequest a -> ItemSyncRequest a -> Bool
< :: ItemSyncRequest a -> ItemSyncRequest a -> Bool
$c< :: forall a. Ord a => ItemSyncRequest a -> ItemSyncRequest a -> Bool
compare :: ItemSyncRequest a -> ItemSyncRequest a -> Ordering
$ccompare :: forall a.
Ord a =>
ItemSyncRequest a -> ItemSyncRequest a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (ItemSyncRequest a)
Ord, (forall x. ItemSyncRequest a -> Rep (ItemSyncRequest a) x)
-> (forall x. Rep (ItemSyncRequest a) x -> ItemSyncRequest a)
-> Generic (ItemSyncRequest a)
forall x. Rep (ItemSyncRequest a) x -> ItemSyncRequest a
forall x. ItemSyncRequest a -> Rep (ItemSyncRequest a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (ItemSyncRequest a) x -> ItemSyncRequest a
forall a x. ItemSyncRequest a -> Rep (ItemSyncRequest a) x
$cto :: forall a x. Rep (ItemSyncRequest a) x -> ItemSyncRequest a
$cfrom :: forall a x. ItemSyncRequest a -> Rep (ItemSyncRequest a) x
Generic)
  deriving (Value -> Parser [ItemSyncRequest a]
Value -> Parser (ItemSyncRequest a)
(Value -> Parser (ItemSyncRequest a))
-> (Value -> Parser [ItemSyncRequest a])
-> FromJSON (ItemSyncRequest a)
forall a. HasCodec a => Value -> Parser [ItemSyncRequest a]
forall a. HasCodec a => Value -> Parser (ItemSyncRequest a)
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [ItemSyncRequest a]
$cparseJSONList :: forall a. HasCodec a => Value -> Parser [ItemSyncRequest a]
parseJSON :: Value -> Parser (ItemSyncRequest a)
$cparseJSON :: forall a. HasCodec a => Value -> Parser (ItemSyncRequest a)
FromJSON, [ItemSyncRequest a] -> Encoding
[ItemSyncRequest a] -> Value
ItemSyncRequest a -> Encoding
ItemSyncRequest a -> Value
(ItemSyncRequest a -> Value)
-> (ItemSyncRequest a -> Encoding)
-> ([ItemSyncRequest a] -> Value)
-> ([ItemSyncRequest a] -> Encoding)
-> ToJSON (ItemSyncRequest a)
forall a. HasCodec a => [ItemSyncRequest a] -> Encoding
forall a. HasCodec a => [ItemSyncRequest a] -> Value
forall a. HasCodec a => ItemSyncRequest a -> Encoding
forall a. HasCodec a => ItemSyncRequest a -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [ItemSyncRequest a] -> Encoding
$ctoEncodingList :: forall a. HasCodec a => [ItemSyncRequest a] -> Encoding
toJSONList :: [ItemSyncRequest a] -> Value
$ctoJSONList :: forall a. HasCodec a => [ItemSyncRequest a] -> Value
toEncoding :: ItemSyncRequest a -> Encoding
$ctoEncoding :: forall a. HasCodec a => ItemSyncRequest a -> Encoding
toJSON :: ItemSyncRequest a -> Value
$ctoJSON :: forall a. HasCodec a => ItemSyncRequest a -> Value
ToJSON) via (Autodocodec (ItemSyncRequest a))

instance Validity a => Validity (ItemSyncRequest a)

instance NFData a => NFData (ItemSyncRequest a)

instance HasCodec a => HasCodec (ItemSyncRequest a) where
  codec :: JSONCodec (ItemSyncRequest a)
codec =
    Text
-> ObjectCodec (ItemSyncRequest a) (ItemSyncRequest a)
-> JSONCodec (ItemSyncRequest a)
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
object Text
"ItemSyncRequest" (ObjectCodec (ItemSyncRequest a) (ItemSyncRequest a)
 -> JSONCodec (ItemSyncRequest a))
-> ObjectCodec (ItemSyncRequest a) (ItemSyncRequest a)
-> JSONCodec (ItemSyncRequest a)
forall a b. (a -> b) -> a -> b
$
      (Either (Either () a) (Either () ()) -> ItemSyncRequest a)
-> (ItemSyncRequest a -> Either (Either () a) (Either () ()))
-> Codec
     Object
     (Either (Either () a) (Either () ()))
     (Either (Either () a) (Either () ()))
-> ObjectCodec (ItemSyncRequest a) (ItemSyncRequest a)
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec Either (Either () a) (Either () ()) -> ItemSyncRequest a
forall a. Either (Either () a) (Either () ()) -> ItemSyncRequest a
f ItemSyncRequest a -> Either (Either () a) (Either () ())
forall b. ItemSyncRequest b -> Either (Either () b) (Either () ())
g (Codec
   Object
   (Either (Either () a) (Either () ()))
   (Either (Either () a) (Either () ()))
 -> ObjectCodec (ItemSyncRequest a) (ItemSyncRequest a))
-> Codec
     Object
     (Either (Either () a) (Either () ()))
     (Either (Either () a) (Either () ()))
-> ObjectCodec (ItemSyncRequest a) (ItemSyncRequest a)
forall a b. (a -> b) -> a -> b
$
        Codec Object (Either () a) (Either () a)
-> Codec Object (Either () ()) (Either () ())
-> Codec
     Object
     (Either (Either () a) (Either () ()))
     (Either (Either () a) (Either () ()))
forall context input1 output1 input2 output2.
Codec context input1 output1
-> Codec context input2 output2
-> Codec context (Either input1 input2) (Either output1 output2)
disjointEitherCodec
          ( Codec Object () ()
-> Codec Object a a -> Codec Object (Either () a) (Either () a)
forall context input1 output1 input2 output2.
Codec context input1 output1
-> Codec context input2 output2
-> Codec context (Either input1 input2) (Either output1 output2)
disjointEitherCodec
              (Text -> ObjectCodec () (() -> ())
forall b x. Text -> ObjectCodec b (x -> x)
typeField Text
"empty" ObjectCodec () (() -> ())
-> Codec Object () () -> Codec Object () ()
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> () -> Codec Object () ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
              (Text -> ObjectCodec a (a -> a)
forall b x. Text -> ObjectCodec b (x -> x)
typeField Text
"added" ObjectCodec a (a -> a) -> Codec Object a a -> Codec Object a a
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> Text -> Codec Object a a
forall output.
HasCodec output =>
Text -> Text -> ObjectCodec output output
requiredField Text
"value" Text
"item that was added, client-side")
          )
          ( Codec Object () ()
-> Codec Object () () -> Codec Object (Either () ()) (Either () ())
forall context input1 output1 input2 output2.
Codec context input1 output1
-> Codec context input2 output2
-> Codec context (Either input1 input2) (Either output1 output2)
disjointEitherCodec
              (Text -> ObjectCodec () (() -> ())
forall b x. Text -> ObjectCodec b (x -> x)
typeField Text
"synced" ObjectCodec () (() -> ())
-> Codec Object () () -> Codec Object () ()
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> () -> Codec Object () ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
              (Text -> ObjectCodec () (() -> ())
forall b x. Text -> ObjectCodec b (x -> x)
typeField Text
"deleted" ObjectCodec () (() -> ())
-> Codec Object () () -> Codec Object () ()
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> () -> Codec Object () ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
          )
    where
      f :: Either (Either () a) (Either () ()) -> ItemSyncRequest a
f = \case
        Left (Left ()) -> ItemSyncRequest a
forall a. ItemSyncRequest a
ItemSyncRequestPoll
        Left (Right a
v) -> a -> ItemSyncRequest a
forall a. a -> ItemSyncRequest a
ItemSyncRequestNew a
v
        Right (Left ()) -> ItemSyncRequest a
forall a. ItemSyncRequest a
ItemSyncRequestKnown
        Right (Right ()) -> ItemSyncRequest a
forall a. ItemSyncRequest a
ItemSyncRequestDeleted

      g :: ItemSyncRequest b -> Either (Either () b) (Either () ())
g = \case
        ItemSyncRequest b
ItemSyncRequestPoll -> Either () b -> Either (Either () b) (Either () ())
forall a b. a -> Either a b
Left (() -> Either () b
forall a b. a -> Either a b
Left ())
        ItemSyncRequestNew b
v -> Either () b -> Either (Either () b) (Either () ())
forall a b. a -> Either a b
Left (b -> Either () b
forall a b. b -> Either a b
Right b
v)
        ItemSyncRequest b
ItemSyncRequestKnown -> Either () () -> Either (Either () b) (Either () ())
forall a b. b -> Either a b
Right (() -> Either () ()
forall a b. a -> Either a b
Left ())
        ItemSyncRequest b
ItemSyncRequestDeleted -> Either () () -> Either (Either () b) (Either () ())
forall a b. b -> Either a b
Right (() -> Either () ()
forall a b. b -> Either a b
Right ())

      typeField :: Text -> ObjectCodec b (x -> x)
      typeField :: Text -> ObjectCodec b (x -> x)
typeField Text
typeName = x -> x
forall a. a -> a
id (x -> x) -> Codec Object b Text -> ObjectCodec b (x -> x)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ValueCodec Text Text -> ObjectCodec Text Text
forall input output.
Text -> ValueCodec input output -> ObjectCodec input output
requiredFieldWith' Text
"type" (Text -> ValueCodec Text Text
literalTextCodec Text
typeName) ObjectCodec Text Text -> (b -> Text) -> Codec Object b Text
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= Text -> b -> Text
forall a b. a -> b -> a
const Text
typeName

makeItemSyncRequest :: ClientItem a -> ItemSyncRequest a
makeItemSyncRequest :: ClientItem a -> ItemSyncRequest a
makeItemSyncRequest ClientItem a
ci =
  case ClientItem a
ci of
    ClientItem a
ClientEmpty -> ItemSyncRequest a
forall a. ItemSyncRequest a
ItemSyncRequestPoll
    ClientAdded a
a -> a -> ItemSyncRequest a
forall a. a -> ItemSyncRequest a
ItemSyncRequestNew a
a
    ClientSynced a
_ -> ItemSyncRequest a
forall a. ItemSyncRequest a
ItemSyncRequestKnown
    ClientItem a
ClientDeleted -> ItemSyncRequest a
forall a. ItemSyncRequest a
ItemSyncRequestDeleted

-- | A synchronisation response for items with identifiers of type @i@ and values of type @a@
data ItemSyncResponse a
  = ItemSyncResponseInSyncEmpty
  | ItemSyncResponseInSyncFull
  | ItemSyncResponseClientAdded
  | ItemSyncResponseClientDeleted
  | ItemSyncResponseServerAdded !a
  | ItemSyncResponseServerDeleted
  deriving stock (Int -> ItemSyncResponse a -> ShowS
[ItemSyncResponse a] -> ShowS
ItemSyncResponse a -> String
(Int -> ItemSyncResponse a -> ShowS)
-> (ItemSyncResponse a -> String)
-> ([ItemSyncResponse a] -> ShowS)
-> Show (ItemSyncResponse a)
forall a. Show a => Int -> ItemSyncResponse a -> ShowS
forall a. Show a => [ItemSyncResponse a] -> ShowS
forall a. Show a => ItemSyncResponse a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ItemSyncResponse a] -> ShowS
$cshowList :: forall a. Show a => [ItemSyncResponse a] -> ShowS
show :: ItemSyncResponse a -> String
$cshow :: forall a. Show a => ItemSyncResponse a -> String
showsPrec :: Int -> ItemSyncResponse a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> ItemSyncResponse a -> ShowS
Show, ItemSyncResponse a -> ItemSyncResponse a -> Bool
(ItemSyncResponse a -> ItemSyncResponse a -> Bool)
-> (ItemSyncResponse a -> ItemSyncResponse a -> Bool)
-> Eq (ItemSyncResponse a)
forall a. Eq a => ItemSyncResponse a -> ItemSyncResponse a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ItemSyncResponse a -> ItemSyncResponse a -> Bool
$c/= :: forall a. Eq a => ItemSyncResponse a -> ItemSyncResponse a -> Bool
== :: ItemSyncResponse a -> ItemSyncResponse a -> Bool
$c== :: forall a. Eq a => ItemSyncResponse a -> ItemSyncResponse a -> Bool
Eq, Eq (ItemSyncResponse a)
Eq (ItemSyncResponse a)
-> (ItemSyncResponse a -> ItemSyncResponse a -> Ordering)
-> (ItemSyncResponse a -> ItemSyncResponse a -> Bool)
-> (ItemSyncResponse a -> ItemSyncResponse a -> Bool)
-> (ItemSyncResponse a -> ItemSyncResponse a -> Bool)
-> (ItemSyncResponse a -> ItemSyncResponse a -> Bool)
-> (ItemSyncResponse a -> ItemSyncResponse a -> ItemSyncResponse a)
-> (ItemSyncResponse a -> ItemSyncResponse a -> ItemSyncResponse a)
-> Ord (ItemSyncResponse a)
ItemSyncResponse a -> ItemSyncResponse a -> Bool
ItemSyncResponse a -> ItemSyncResponse a -> Ordering
ItemSyncResponse a -> ItemSyncResponse a -> ItemSyncResponse a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (ItemSyncResponse a)
forall a. Ord a => ItemSyncResponse a -> ItemSyncResponse a -> Bool
forall a.
Ord a =>
ItemSyncResponse a -> ItemSyncResponse a -> Ordering
forall a.
Ord a =>
ItemSyncResponse a -> ItemSyncResponse a -> ItemSyncResponse a
min :: ItemSyncResponse a -> ItemSyncResponse a -> ItemSyncResponse a
$cmin :: forall a.
Ord a =>
ItemSyncResponse a -> ItemSyncResponse a -> ItemSyncResponse a
max :: ItemSyncResponse a -> ItemSyncResponse a -> ItemSyncResponse a
$cmax :: forall a.
Ord a =>
ItemSyncResponse a -> ItemSyncResponse a -> ItemSyncResponse a
>= :: ItemSyncResponse a -> ItemSyncResponse a -> Bool
$c>= :: forall a. Ord a => ItemSyncResponse a -> ItemSyncResponse a -> Bool
> :: ItemSyncResponse a -> ItemSyncResponse a -> Bool
$c> :: forall a. Ord a => ItemSyncResponse a -> ItemSyncResponse a -> Bool
<= :: ItemSyncResponse a -> ItemSyncResponse a -> Bool
$c<= :: forall a. Ord a => ItemSyncResponse a -> ItemSyncResponse a -> Bool
< :: ItemSyncResponse a -> ItemSyncResponse a -> Bool
$c< :: forall a. Ord a => ItemSyncResponse a -> ItemSyncResponse a -> Bool
compare :: ItemSyncResponse a -> ItemSyncResponse a -> Ordering
$ccompare :: forall a.
Ord a =>
ItemSyncResponse a -> ItemSyncResponse a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (ItemSyncResponse a)
Ord, (forall x. ItemSyncResponse a -> Rep (ItemSyncResponse a) x)
-> (forall x. Rep (ItemSyncResponse a) x -> ItemSyncResponse a)
-> Generic (ItemSyncResponse a)
forall x. Rep (ItemSyncResponse a) x -> ItemSyncResponse a
forall x. ItemSyncResponse a -> Rep (ItemSyncResponse a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (ItemSyncResponse a) x -> ItemSyncResponse a
forall a x. ItemSyncResponse a -> Rep (ItemSyncResponse a) x
$cto :: forall a x. Rep (ItemSyncResponse a) x -> ItemSyncResponse a
$cfrom :: forall a x. ItemSyncResponse a -> Rep (ItemSyncResponse a) x
Generic)
  deriving (Value -> Parser [ItemSyncResponse a]
Value -> Parser (ItemSyncResponse a)
(Value -> Parser (ItemSyncResponse a))
-> (Value -> Parser [ItemSyncResponse a])
-> FromJSON (ItemSyncResponse a)
forall a. HasCodec a => Value -> Parser [ItemSyncResponse a]
forall a. HasCodec a => Value -> Parser (ItemSyncResponse a)
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [ItemSyncResponse a]
$cparseJSONList :: forall a. HasCodec a => Value -> Parser [ItemSyncResponse a]
parseJSON :: Value -> Parser (ItemSyncResponse a)
$cparseJSON :: forall a. HasCodec a => Value -> Parser (ItemSyncResponse a)
FromJSON, [ItemSyncResponse a] -> Encoding
[ItemSyncResponse a] -> Value
ItemSyncResponse a -> Encoding
ItemSyncResponse a -> Value
(ItemSyncResponse a -> Value)
-> (ItemSyncResponse a -> Encoding)
-> ([ItemSyncResponse a] -> Value)
-> ([ItemSyncResponse a] -> Encoding)
-> ToJSON (ItemSyncResponse a)
forall a. HasCodec a => [ItemSyncResponse a] -> Encoding
forall a. HasCodec a => [ItemSyncResponse a] -> Value
forall a. HasCodec a => ItemSyncResponse a -> Encoding
forall a. HasCodec a => ItemSyncResponse a -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [ItemSyncResponse a] -> Encoding
$ctoEncodingList :: forall a. HasCodec a => [ItemSyncResponse a] -> Encoding
toJSONList :: [ItemSyncResponse a] -> Value
$ctoJSONList :: forall a. HasCodec a => [ItemSyncResponse a] -> Value
toEncoding :: ItemSyncResponse a -> Encoding
$ctoEncoding :: forall a. HasCodec a => ItemSyncResponse a -> Encoding
toJSON :: ItemSyncResponse a -> Value
$ctoJSON :: forall a. HasCodec a => ItemSyncResponse a -> Value
ToJSON) via (Autodocodec (ItemSyncResponse a))

instance Validity a => Validity (ItemSyncResponse a)

instance NFData a => NFData (ItemSyncResponse a)

instance HasCodec a => HasCodec (ItemSyncResponse a) where
  codec :: JSONCodec (ItemSyncResponse a)
codec =
    Text
-> ObjectCodec (ItemSyncResponse a) (ItemSyncResponse a)
-> JSONCodec (ItemSyncResponse a)
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
object Text
"ItemSyncResponse" (ObjectCodec (ItemSyncResponse a) (ItemSyncResponse a)
 -> JSONCodec (ItemSyncResponse a))
-> ObjectCodec (ItemSyncResponse a) (ItemSyncResponse a)
-> JSONCodec (ItemSyncResponse a)
forall a b. (a -> b) -> a -> b
$
      (Either (Either () ()) (Either (Either () ()) (Either a ()))
 -> ItemSyncResponse a)
-> (ItemSyncResponse a
    -> Either (Either () ()) (Either (Either () ()) (Either a ())))
-> Codec
     Object
     (Either (Either () ()) (Either (Either () ()) (Either a ())))
     (Either (Either () ()) (Either (Either () ()) (Either a ())))
-> ObjectCodec (ItemSyncResponse a) (ItemSyncResponse a)
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec Either (Either () ()) (Either (Either () ()) (Either a ()))
-> ItemSyncResponse a
forall a.
Either (Either () ()) (Either (Either () ()) (Either a ()))
-> ItemSyncResponse a
f ItemSyncResponse a
-> Either (Either () ()) (Either (Either () ()) (Either a ()))
forall a.
ItemSyncResponse a
-> Either (Either () ()) (Either (Either () ()) (Either a ()))
g (Codec
   Object
   (Either (Either () ()) (Either (Either () ()) (Either a ())))
   (Either (Either () ()) (Either (Either () ()) (Either a ())))
 -> ObjectCodec (ItemSyncResponse a) (ItemSyncResponse a))
-> Codec
     Object
     (Either (Either () ()) (Either (Either () ()) (Either a ())))
     (Either (Either () ()) (Either (Either () ()) (Either a ())))
-> ObjectCodec (ItemSyncResponse a) (ItemSyncResponse a)
forall a b. (a -> b) -> a -> b
$
        Codec Object (Either () ()) (Either () ())
-> Codec
     Object
     (Either (Either () ()) (Either a ()))
     (Either (Either () ()) (Either a ()))
-> Codec
     Object
     (Either (Either () ()) (Either (Either () ()) (Either a ())))
     (Either (Either () ()) (Either (Either () ()) (Either a ())))
forall context input1 output1 input2 output2.
Codec context input1 output1
-> Codec context input2 output2
-> Codec context (Either input1 input2) (Either output1 output2)
disjointEitherCodec
          ( Codec Object () ()
-> Codec Object () () -> Codec Object (Either () ()) (Either () ())
forall context input1 output1 input2 output2.
Codec context input1 output1
-> Codec context input2 output2
-> Codec context (Either input1 input2) (Either output1 output2)
disjointEitherCodec
              (Text -> ObjectCodec () (() -> ())
forall b x. Text -> ObjectCodec b (x -> x)
typeField Text
"in-sync-empty" ObjectCodec () (() -> ())
-> Codec Object () () -> Codec Object () ()
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> () -> Codec Object () ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
              (Text -> ObjectCodec () (() -> ())
forall b x. Text -> ObjectCodec b (x -> x)
typeField Text
"in-sync-full" ObjectCodec () (() -> ())
-> Codec Object () () -> Codec Object () ()
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> () -> Codec Object () ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
          )
          ( Codec Object (Either () ()) (Either () ())
-> Codec Object (Either a ()) (Either a ())
-> Codec
     Object
     (Either (Either () ()) (Either a ()))
     (Either (Either () ()) (Either a ()))
forall context input1 output1 input2 output2.
Codec context input1 output1
-> Codec context input2 output2
-> Codec context (Either input1 input2) (Either output1 output2)
disjointEitherCodec
              ( Codec Object () ()
-> Codec Object () () -> Codec Object (Either () ()) (Either () ())
forall context input1 output1 input2 output2.
Codec context input1 output1
-> Codec context input2 output2
-> Codec context (Either input1 input2) (Either output1 output2)
disjointEitherCodec
                  (Text -> ObjectCodec () (() -> ())
forall b x. Text -> ObjectCodec b (x -> x)
typeField Text
"client-added" ObjectCodec () (() -> ())
-> Codec Object () () -> Codec Object () ()
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> () -> Codec Object () ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
                  (Text -> ObjectCodec () (() -> ())
forall b x. Text -> ObjectCodec b (x -> x)
typeField Text
"client-deleted" ObjectCodec () (() -> ())
-> Codec Object () () -> Codec Object () ()
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> () -> Codec Object () ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
              )
              ( Codec Object a a
-> Codec Object () () -> Codec Object (Either a ()) (Either a ())
forall context input1 output1 input2 output2.
Codec context input1 output1
-> Codec context input2 output2
-> Codec context (Either input1 input2) (Either output1 output2)
disjointEitherCodec
                  (Text -> ObjectCodec a (a -> a)
forall b x. Text -> ObjectCodec b (x -> x)
typeField Text
"server-added" ObjectCodec a (a -> a) -> Codec Object a a -> Codec Object a a
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> Text -> Codec Object a a
forall output.
HasCodec output =>
Text -> Text -> ObjectCodec output output
requiredField Text
"value" Text
"the value that was added, server-side")
                  (Text -> ObjectCodec () (() -> ())
forall b x. Text -> ObjectCodec b (x -> x)
typeField Text
"server-deleted" ObjectCodec () (() -> ())
-> Codec Object () () -> Codec Object () ()
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> () -> Codec Object () ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
              )
          )
    where
      f :: Either (Either () ()) (Either (Either () ()) (Either a ()))
-> ItemSyncResponse a
f = \case
        Left (Left ()) -> ItemSyncResponse a
forall a. ItemSyncResponse a
ItemSyncResponseInSyncEmpty
        Left (Right ()) -> ItemSyncResponse a
forall a. ItemSyncResponse a
ItemSyncResponseInSyncFull
        Right (Left (Left ())) -> ItemSyncResponse a
forall a. ItemSyncResponse a
ItemSyncResponseClientAdded
        Right (Left (Right ())) -> ItemSyncResponse a
forall a. ItemSyncResponse a
ItemSyncResponseClientDeleted
        Right (Right (Left a
v)) -> a -> ItemSyncResponse a
forall a. a -> ItemSyncResponse a
ItemSyncResponseServerAdded a
v
        Right (Right (Right ())) -> ItemSyncResponse a
forall a. ItemSyncResponse a
ItemSyncResponseServerDeleted

      g :: ItemSyncResponse a
-> Either (Either () ()) (Either (Either () ()) (Either a ()))
g = \case
        ItemSyncResponse a
ItemSyncResponseInSyncEmpty -> Either () ()
-> Either (Either () ()) (Either (Either () ()) (Either a ()))
forall a b. a -> Either a b
Left (() -> Either () ()
forall a b. a -> Either a b
Left ())
        ItemSyncResponse a
ItemSyncResponseInSyncFull -> Either () ()
-> Either (Either () ()) (Either (Either () ()) (Either a ()))
forall a b. a -> Either a b
Left (() -> Either () ()
forall a b. b -> Either a b
Right ())
        ItemSyncResponse a
ItemSyncResponseClientAdded -> Either (Either () ()) (Either a ())
-> Either (Either () ()) (Either (Either () ()) (Either a ()))
forall a b. b -> Either a b
Right (Either () () -> Either (Either () ()) (Either a ())
forall a b. a -> Either a b
Left (() -> Either () ()
forall a b. a -> Either a b
Left ()))
        ItemSyncResponse a
ItemSyncResponseClientDeleted -> Either (Either () ()) (Either a ())
-> Either (Either () ()) (Either (Either () ()) (Either a ()))
forall a b. b -> Either a b
Right (Either () () -> Either (Either () ()) (Either a ())
forall a b. a -> Either a b
Left (() -> Either () ()
forall a b. b -> Either a b
Right ()))
        ItemSyncResponseServerAdded a
v -> Either (Either () ()) (Either a ())
-> Either (Either () ()) (Either (Either () ()) (Either a ()))
forall a b. b -> Either a b
Right (Either a () -> Either (Either () ()) (Either a ())
forall a b. b -> Either a b
Right (a -> Either a ()
forall a b. a -> Either a b
Left a
v))
        ItemSyncResponse a
ItemSyncResponseServerDeleted -> Either (Either () ()) (Either a ())
-> Either (Either () ()) (Either (Either () ()) (Either a ()))
forall a b. b -> Either a b
Right (Either a () -> Either (Either () ()) (Either a ())
forall a b. b -> Either a b
Right (() -> Either a ()
forall a b. b -> Either a b
Right ()))

      typeField :: Text -> ObjectCodec b (x -> x)
      typeField :: Text -> ObjectCodec b (x -> x)
typeField Text
typeName = x -> x
forall a. a -> a
id (x -> x) -> Codec Object b Text -> ObjectCodec b (x -> x)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ValueCodec Text Text -> ObjectCodec Text Text
forall input output.
Text -> ValueCodec input output -> ObjectCodec input output
requiredFieldWith' Text
"type" (Text -> ValueCodec Text Text
literalTextCodec Text
typeName) ObjectCodec Text Text -> (b -> Text) -> Codec Object b Text
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= Text -> b -> Text
forall a b. a -> b -> a
const Text
typeName

-- | Merge a synchronisation response back into a client-side store.
mergeItemSyncResponse :: ClientItem a -> ItemSyncResponse a -> ClientItem a
mergeItemSyncResponse :: ClientItem a -> ItemSyncResponse a -> ClientItem a
mergeItemSyncResponse ClientItem a
ci ItemSyncResponse a
sr =
  let mismatch :: ClientItem a
mismatch = ClientItem a
ci
   in case ClientItem a
ci of
        ClientItem a
ClientEmpty ->
          case ItemSyncResponse a
sr of
            ItemSyncResponse a
ItemSyncResponseInSyncEmpty -> ClientItem a
forall a. ClientItem a
ClientEmpty
            ItemSyncResponseServerAdded a
s -> a -> ClientItem a
forall a. a -> ClientItem a
ClientSynced a
s
            ItemSyncResponse a
_ -> ClientItem a
mismatch
        ClientAdded a
a ->
          case ItemSyncResponse a
sr of
            ItemSyncResponse a
ItemSyncResponseClientAdded -> a -> ClientItem a
forall a. a -> ClientItem a
ClientSynced a
a
            ItemSyncResponseServerAdded a
s -> a -> ClientItem a
forall a. a -> ClientItem a
ClientSynced a
s
            -- For completeness sake.
            -- This can only happen if two clients make the item at the same time.
            -- In practice, with named items in a collection, this will never happen.
            ItemSyncResponse a
_ -> ClientItem a
mismatch
        ClientSynced a
_ ->
          case ItemSyncResponse a
sr of
            ItemSyncResponse a
ItemSyncResponseInSyncFull -> ClientItem a
ci -- No change
            ItemSyncResponse a
ItemSyncResponseServerDeleted -> ClientItem a
forall a. ClientItem a
ClientEmpty
            ItemSyncResponse a
_ -> ClientItem a
mismatch
        ClientItem a
ClientDeleted ->
          case ItemSyncResponse a
sr of
            ItemSyncResponse a
ItemSyncResponseClientDeleted -> ClientItem a
forall a. ClientItem a
ClientEmpty
            ItemSyncResponse a
_ -> ClientItem a
mismatch

-- | An item in a central store with a value of type @a@
data ServerItem a
  = ServerItemEmpty
  | ServerItemFull !a
  deriving stock (Int -> ServerItem a -> ShowS
[ServerItem a] -> ShowS
ServerItem a -> String
(Int -> ServerItem a -> ShowS)
-> (ServerItem a -> String)
-> ([ServerItem a] -> ShowS)
-> Show (ServerItem a)
forall a. Show a => Int -> ServerItem a -> ShowS
forall a. Show a => [ServerItem a] -> ShowS
forall a. Show a => ServerItem a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ServerItem a] -> ShowS
$cshowList :: forall a. Show a => [ServerItem a] -> ShowS
show :: ServerItem a -> String
$cshow :: forall a. Show a => ServerItem a -> String
showsPrec :: Int -> ServerItem a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> ServerItem a -> ShowS
Show, ServerItem a -> ServerItem a -> Bool
(ServerItem a -> ServerItem a -> Bool)
-> (ServerItem a -> ServerItem a -> Bool) -> Eq (ServerItem a)
forall a. Eq a => ServerItem a -> ServerItem a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ServerItem a -> ServerItem a -> Bool
$c/= :: forall a. Eq a => ServerItem a -> ServerItem a -> Bool
== :: ServerItem a -> ServerItem a -> Bool
$c== :: forall a. Eq a => ServerItem a -> ServerItem a -> Bool
Eq, Eq (ServerItem a)
Eq (ServerItem a)
-> (ServerItem a -> ServerItem a -> Ordering)
-> (ServerItem a -> ServerItem a -> Bool)
-> (ServerItem a -> ServerItem a -> Bool)
-> (ServerItem a -> ServerItem a -> Bool)
-> (ServerItem a -> ServerItem a -> Bool)
-> (ServerItem a -> ServerItem a -> ServerItem a)
-> (ServerItem a -> ServerItem a -> ServerItem a)
-> Ord (ServerItem a)
ServerItem a -> ServerItem a -> Bool
ServerItem a -> ServerItem a -> Ordering
ServerItem a -> ServerItem a -> ServerItem a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (ServerItem a)
forall a. Ord a => ServerItem a -> ServerItem a -> Bool
forall a. Ord a => ServerItem a -> ServerItem a -> Ordering
forall a. Ord a => ServerItem a -> ServerItem a -> ServerItem a
min :: ServerItem a -> ServerItem a -> ServerItem a
$cmin :: forall a. Ord a => ServerItem a -> ServerItem a -> ServerItem a
max :: ServerItem a -> ServerItem a -> ServerItem a
$cmax :: forall a. Ord a => ServerItem a -> ServerItem a -> ServerItem a
>= :: ServerItem a -> ServerItem a -> Bool
$c>= :: forall a. Ord a => ServerItem a -> ServerItem a -> Bool
> :: ServerItem a -> ServerItem a -> Bool
$c> :: forall a. Ord a => ServerItem a -> ServerItem a -> Bool
<= :: ServerItem a -> ServerItem a -> Bool
$c<= :: forall a. Ord a => ServerItem a -> ServerItem a -> Bool
< :: ServerItem a -> ServerItem a -> Bool
$c< :: forall a. Ord a => ServerItem a -> ServerItem a -> Bool
compare :: ServerItem a -> ServerItem a -> Ordering
$ccompare :: forall a. Ord a => ServerItem a -> ServerItem a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (ServerItem a)
Ord, (forall x. ServerItem a -> Rep (ServerItem a) x)
-> (forall x. Rep (ServerItem a) x -> ServerItem a)
-> Generic (ServerItem a)
forall x. Rep (ServerItem a) x -> ServerItem a
forall x. ServerItem a -> Rep (ServerItem a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (ServerItem a) x -> ServerItem a
forall a x. ServerItem a -> Rep (ServerItem a) x
$cto :: forall a x. Rep (ServerItem a) x -> ServerItem a
$cfrom :: forall a x. ServerItem a -> Rep (ServerItem a) x
Generic)
  deriving (Value -> Parser [ServerItem a]
Value -> Parser (ServerItem a)
(Value -> Parser (ServerItem a))
-> (Value -> Parser [ServerItem a]) -> FromJSON (ServerItem a)
forall a. HasCodec a => Value -> Parser [ServerItem a]
forall a. HasCodec a => Value -> Parser (ServerItem a)
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [ServerItem a]
$cparseJSONList :: forall a. HasCodec a => Value -> Parser [ServerItem a]
parseJSON :: Value -> Parser (ServerItem a)
$cparseJSON :: forall a. HasCodec a => Value -> Parser (ServerItem a)
FromJSON, [ServerItem a] -> Encoding
[ServerItem a] -> Value
ServerItem a -> Encoding
ServerItem a -> Value
(ServerItem a -> Value)
-> (ServerItem a -> Encoding)
-> ([ServerItem a] -> Value)
-> ([ServerItem a] -> Encoding)
-> ToJSON (ServerItem a)
forall a. HasCodec a => [ServerItem a] -> Encoding
forall a. HasCodec a => [ServerItem a] -> Value
forall a. HasCodec a => ServerItem a -> Encoding
forall a. HasCodec a => ServerItem a -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [ServerItem a] -> Encoding
$ctoEncodingList :: forall a. HasCodec a => [ServerItem a] -> Encoding
toJSONList :: [ServerItem a] -> Value
$ctoJSONList :: forall a. HasCodec a => [ServerItem a] -> Value
toEncoding :: ServerItem a -> Encoding
$ctoEncoding :: forall a. HasCodec a => ServerItem a -> Encoding
toJSON :: ServerItem a -> Value
$ctoJSON :: forall a. HasCodec a => ServerItem a -> Value
ToJSON) via (Autodocodec (ServerItem a))

instance Validity a => Validity (ServerItem a)

instance NFData a => NFData (ServerItem a)

instance HasCodec a => HasCodec (ServerItem a) where
  codec :: JSONCodec (ServerItem a)
codec =
    Text
-> ObjectCodec (ServerItem a) (ServerItem a)
-> JSONCodec (ServerItem a)
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
object Text
"ServerItem" (ObjectCodec (ServerItem a) (ServerItem a)
 -> JSONCodec (ServerItem a))
-> ObjectCodec (ServerItem a) (ServerItem a)
-> JSONCodec (ServerItem a)
forall a b. (a -> b) -> a -> b
$
      (Either a () -> ServerItem a)
-> (ServerItem a -> Either a ())
-> Codec Object (Either a ()) (Either a ())
-> ObjectCodec (ServerItem a) (ServerItem a)
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec Either a () -> ServerItem a
forall a. Either a () -> ServerItem a
f ServerItem a -> Either a ()
forall a. ServerItem a -> Either a ()
g (Codec Object (Either a ()) (Either a ())
 -> ObjectCodec (ServerItem a) (ServerItem a))
-> Codec Object (Either a ()) (Either a ())
-> ObjectCodec (ServerItem a) (ServerItem a)
forall a b. (a -> b) -> a -> b
$
        Codec Object a a
-> Codec Object () () -> Codec Object (Either a ()) (Either a ())
forall context input1 output1 input2 output2.
Codec context input1 output1
-> Codec context input2 output2
-> Codec context (Either input1 input2) (Either output1 output2)
possiblyJointEitherCodec
          (Text -> Text -> Codec Object a a
forall output.
HasCodec output =>
Text -> Text -> ObjectCodec output output
requiredField Text
"value" Text
"the item on the server side")
          (() -> Codec Object () ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
    where
      f :: Either a () -> ServerItem a
f = \case
        Left a
v -> a -> ServerItem a
forall a. a -> ServerItem a
ServerItemFull a
v
        Right () -> ServerItem a
forall a. ServerItem a
ServerItemEmpty
      g :: ServerItem a -> Either a ()
g = \case
        ServerItemFull a
v -> a -> Either a ()
forall a b. a -> Either a b
Left a
v
        ServerItem a
ServerItemEmpty -> () -> Either a ()
forall a b. b -> Either a b
Right ()

processServerItemSync :: ServerItem a -> ItemSyncRequest a -> (ItemSyncResponse a, ServerItem a)
processServerItemSync :: ServerItem a
-> ItemSyncRequest a -> (ItemSyncResponse a, ServerItem a)
processServerItemSync ServerItem a
si ItemSyncRequest a
sr =
  case ServerItem a
si of
    ServerItem a
ServerItemEmpty ->
      case ItemSyncRequest a
sr of
        ItemSyncRequest a
ItemSyncRequestPoll ->
          -- Both the client and the server think the item is empty, fine.
          (ItemSyncResponse a
forall a. ItemSyncResponse a
ItemSyncResponseInSyncEmpty, ServerItem a
si)
        ItemSyncRequestNew a
a ->
          -- The client has a new item and the server has space for it, add it.
          (ItemSyncResponse a
forall a. ItemSyncResponse a
ItemSyncResponseClientAdded, a -> ServerItem a
forall a. a -> ServerItem a
ServerItemFull a
a)
        ItemSyncRequest a
ItemSyncRequestKnown ->
          -- The client has an item that the server doesn't, so the server must have
          -- deleted it when another client asked to do that.
          -- Leave it deleted.
          (ItemSyncResponse a
forall a. ItemSyncResponse a
ItemSyncResponseServerDeleted, ServerItem a
si)
        ItemSyncRequest a
ItemSyncRequestDeleted ->
          -- The server has deleted an item but the current client hasn't been made aware of that
          -- AND this server also deleted that item in the meantime.
          -- Just leave it deleted.
          (ItemSyncResponse a
forall a. ItemSyncResponse a
ItemSyncResponseClientDeleted, ServerItem a
si)
    ServerItemFull a
s ->
      case ItemSyncRequest a
sr of
        ItemSyncRequest a
ItemSyncRequestPoll ->
          -- The server has an item that the client doesn't, send it to the client.
          (a -> ItemSyncResponse a
forall a. a -> ItemSyncResponse a
ItemSyncResponseServerAdded a
s, ServerItem a
si)
        ItemSyncRequestNew a
_ ->
          -- The client wants to add an item that the server already has.
          -- That means that another client has added that same item in the meantime.
          -- This wouldn't happen if the items were named.
          -- In this case, for completeness sake,
          (a -> ItemSyncResponse a
forall a. a -> ItemSyncResponse a
ItemSyncResponseServerAdded a
s, ServerItem a
si)
        ItemSyncRequest a
ItemSyncRequestKnown -> (ItemSyncResponse a
forall a. ItemSyncResponse a
ItemSyncResponseInSyncFull, ServerItem a
si)
        ItemSyncRequest a
ItemSyncRequestDeleted -> (ItemSyncResponse a
forall a. ItemSyncResponse a
ItemSyncResponseClientDeleted, ServerItem a
forall a. ServerItem a
ServerItemEmpty)