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

-- | A way to synchronise an item with safe merge conflicts.
--
-- The item is "zero or one" value.
-- One could say that @Item a = Maybe a@ but there are so such types here.
-- This methaphor just serves as explanation
--
--
-- The setup is as follows:
--
-- * A central server is set up to synchronise with
-- * Each client synchronises with the central server, but never with eachother
--
--
-- = A client should operate as follows:
--
-- The clients starts with an 'initialClientItem'.
--
-- * The client produces a 'ItemSyncRequest' with 'makeItemSyncRequest'.
-- * The client sends that request to the central server and gets a 'ItemSyncResponse'.
-- * The client then updates its local store with 'mergeItemSyncResponseRaw' or 'mergeItemSyncResponseIgnoreProblems'.
--
--
-- = The central server should operate as follows:
--
-- The server starts with an 'initialServerItem'.
--
-- * The server accepts a 'ItemSyncRequest'.
-- * The server performs operations according to the functionality of 'processServerItemSync'.
-- * The server respons with a 'ItemSyncResponse'.
--
--
--
-- WARNING:
-- This whole approach can break down if a server resets its server times
-- or if a client syncs with two different servers using the same server times.
module Data.Mergeful.Item
  ( initialClientItem,
    initialItemSyncRequest,
    makeItemSyncRequest,
    mergeItemSyncResponseFromServer,
    mergeItemSyncResponseFromClient,
    mergeItemSyncResponseUsingCRDT,
    mergeItemSyncResponseUsingStrategy,
    mergeFromServer,
    mergeFromServerStrategy,
    mergeFromClient,
    mergeFromClientStrategy,
    mergeUsingCRDT,
    mergeUsingCRDTStrategy,
    ItemMergeStrategy (..),
    ChangeConflictResolution (..),
    ClientDeletedConflictResolution (..),
    ServerDeletedConflictResolution (..),
    mergeUsingStrategy,
    mergeItemSyncResponseRaw,
    ItemMergeResult (..),

    -- * Server side
    initialServerItem,
    processServerItemSync,

    -- * Types, for reference
    ClientItem (..),
    ItemSyncRequest (..),
    ItemSyncResponse (..),
    ServerItem (..),
  )
where

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

data ClientItem a
  = -- | There is no item on the client side
    ClientEmpty
  | -- | There is is an item but the server is not aware of it yet.
    ClientAdded !a
  | -- | There is is an item and it has been synced with the server.
    ClientItemSynced !(Timed a)
  | -- | There is is an item and it has been synced with the server, but it has since been modified.
    ClientItemSyncedButChanged !(Timed a)
  | -- | There was an item, and it has been deleted locally, but the server has not been made aware of this.
    ClientDeleted !ServerTime
  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, (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 (Timed a) (Either (Timed a) ServerTime))
 -> ClientItem a)
-> (ClientItem a
    -> Either
         (Either () a) (Either (Timed a) (Either (Timed a) ServerTime)))
-> Codec
     Object
     (Either
        (Either () a) (Either (Timed a) (Either (Timed a) ServerTime)))
     (Either
        (Either () a) (Either (Timed a) (Either (Timed a) ServerTime)))
-> 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 (Timed a) (Either (Timed a) ServerTime))
-> ClientItem a
forall a.
Either
  (Either () a) (Either (Timed a) (Either (Timed a) ServerTime))
-> ClientItem a
f ClientItem a
-> Either
     (Either () a) (Either (Timed a) (Either (Timed a) ServerTime))
forall b.
ClientItem b
-> Either
     (Either () b) (Either (Timed b) (Either (Timed b) ServerTime))
g (Codec
   Object
   (Either
      (Either () a) (Either (Timed a) (Either (Timed a) ServerTime)))
   (Either
      (Either () a) (Either (Timed a) (Either (Timed a) ServerTime)))
 -> ObjectCodec (ClientItem a) (ClientItem a))
-> Codec
     Object
     (Either
        (Either () a) (Either (Timed a) (Either (Timed a) ServerTime)))
     (Either
        (Either () a) (Either (Timed a) (Either (Timed a) ServerTime)))
-> ObjectCodec (ClientItem a) (ClientItem a)
forall a b. (a -> b) -> a -> b
$
        Codec Object (Either () a) (Either () a)
-> Codec
     Object
     (Either (Timed a) (Either (Timed a) ServerTime))
     (Either (Timed a) (Either (Timed a) ServerTime))
-> Codec
     Object
     (Either
        (Either () a) (Either (Timed a) (Either (Timed a) ServerTime)))
     (Either
        (Either () a) (Either (Timed a) (Either (Timed a) ServerTime)))
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 a. Text -> ObjectCodec b (a -> a)
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 a. Text -> ObjectCodec b (a -> a)
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 (Timed a) (Timed a)
-> Codec
     Object (Either (Timed a) ServerTime) (Either (Timed a) ServerTime)
-> Codec
     Object
     (Either (Timed a) (Either (Timed a) ServerTime))
     (Either (Timed a) (Either (Timed a) ServerTime))
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 (Timed a) (Timed a -> Timed a)
forall b a. Text -> ObjectCodec b (a -> a)
typeField Text
"synced" ObjectCodec (Timed a) (Timed a -> Timed a)
-> Codec Object (Timed a) (Timed a)
-> Codec Object (Timed a) (Timed a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Codec Object (Timed a) (Timed a)
forall a. HasCodec a => JSONObjectCodec (Timed a)
timedObjectCodec)
              ( Codec Object (Timed a) (Timed a)
-> Codec Object ServerTime ServerTime
-> Codec
     Object (Either (Timed a) ServerTime) (Either (Timed a) ServerTime)
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 (Timed a) (Timed a -> Timed a)
forall b a. Text -> ObjectCodec b (a -> a)
typeField Text
"changed" ObjectCodec (Timed a) (Timed a -> Timed a)
-> Codec Object (Timed a) (Timed a)
-> Codec Object (Timed a) (Timed a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Codec Object (Timed a) (Timed a)
forall a. HasCodec a => JSONObjectCodec (Timed a)
timedObjectCodec)
                  (Text -> ObjectCodec ServerTime (ServerTime -> ServerTime)
forall b a. Text -> ObjectCodec b (a -> a)
typeField Text
"deleted" ObjectCodec ServerTime (ServerTime -> ServerTime)
-> Codec Object ServerTime ServerTime
-> Codec Object ServerTime ServerTime
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> Text -> Codec Object ServerTime ServerTime
forall output.
HasCodec output =>
Text -> Text -> ObjectCodec output output
requiredField Text
"time" Text
"last time the server confirmed a change, from the client's perspective")
              )
          )
    where
      f :: Either
  (Either () a) (Either (Timed a) (Either (Timed a) ServerTime))
-> 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 Timed a
tv) -> Timed a -> ClientItem a
forall a. Timed a -> ClientItem a
ClientItemSynced Timed a
tv
        Right (Right (Left Timed a
tv)) -> Timed a -> ClientItem a
forall a. Timed a -> ClientItem a
ClientItemSyncedButChanged Timed a
tv
        Right (Right (Right ServerTime
st)) -> ServerTime -> ClientItem a
forall a. ServerTime -> ClientItem a
ClientDeleted ServerTime
st
      g :: ClientItem b
-> Either
     (Either () b) (Either (Timed b) (Either (Timed b) ServerTime))
g = \case
        ClientItem b
ClientEmpty -> Either () b
-> Either
     (Either () b) (Either (Timed b) (Either (Timed b) ServerTime))
forall a b. a -> Either a b
Left (() -> Either () b
forall a b. a -> Either a b
Left ())
        ClientAdded b
v -> Either () b
-> Either
     (Either () b) (Either (Timed b) (Either (Timed b) ServerTime))
forall a b. a -> Either a b
Left (b -> Either () b
forall a b. b -> Either a b
Right b
v)
        ClientItemSynced Timed b
tv -> Either (Timed b) (Either (Timed b) ServerTime)
-> Either
     (Either () b) (Either (Timed b) (Either (Timed b) ServerTime))
forall a b. b -> Either a b
Right (Timed b -> Either (Timed b) (Either (Timed b) ServerTime)
forall a b. a -> Either a b
Left Timed b
tv)
        ClientItemSyncedButChanged Timed b
tv -> Either (Timed b) (Either (Timed b) ServerTime)
-> Either
     (Either () b) (Either (Timed b) (Either (Timed b) ServerTime))
forall a b. b -> Either a b
Right (Either (Timed b) ServerTime
-> Either (Timed b) (Either (Timed b) ServerTime)
forall a b. b -> Either a b
Right (Timed b -> Either (Timed b) ServerTime
forall a b. a -> Either a b
Left Timed b
tv))
        ClientDeleted ServerTime
st -> Either (Timed b) (Either (Timed b) ServerTime)
-> Either
     (Either () b) (Either (Timed b) (Either (Timed b) ServerTime))
forall a b. b -> Either a b
Right (Either (Timed b) ServerTime
-> Either (Timed b) (Either (Timed b) ServerTime)
forall a b. b -> Either a b
Right (ServerTime -> Either (Timed b) ServerTime
forall a b. b -> Either a b
Right ServerTime
st))

      typeField :: Text -> ObjectCodec b (a -> a)
      typeField :: Text -> ObjectCodec b (a -> a)
typeField Text
typeName = a -> a
forall a. a -> a
id (a -> a) -> Codec Object b Text -> ObjectCodec b (a -> a)
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 client item to start with.
--
-- It contains no value.
initialClientItem :: ClientItem a
initialClientItem :: ClientItem a
initialClientItem = ClientItem a
forall a. ClientItem a
ClientEmpty

data ServerItem a
  = -- | There is no item on the server side
    ServerEmpty
  | -- | There is an item on the server side, and it was last synced at the given 'ServerTime'.
    ServerFull !(Timed 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, (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 (Timed a) () -> ServerItem a)
-> (ServerItem a -> Either (Timed a) ())
-> Codec Object (Either (Timed a) ()) (Either (Timed 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 (Timed a) () -> ServerItem a
forall a. Either (Timed a) () -> ServerItem a
f ServerItem a -> Either (Timed a) ()
forall a. ServerItem a -> Either (Timed a) ()
g (Codec Object (Either (Timed a) ()) (Either (Timed a) ())
 -> ObjectCodec (ServerItem a) (ServerItem a))
-> Codec Object (Either (Timed a) ()) (Either (Timed a) ())
-> ObjectCodec (ServerItem a) (ServerItem a)
forall a b. (a -> b) -> a -> b
$ Codec Object (Timed a) (Timed a)
-> Codec Object () ()
-> Codec Object (Either (Timed a) ()) (Either (Timed a) ())
forall context input1 output1 input2 output2.
Codec context input1 output1
-> Codec context input2 output2
-> Codec context (Either input1 input2) (Either output1 output2)
possiblyJointEitherCodec Codec Object (Timed a) (Timed a)
forall a. HasCodec a => JSONObjectCodec (Timed a)
timedObjectCodec (() -> Codec Object () ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
    where
      f :: Either (Timed a) () -> ServerItem a
f = \case
        Left Timed a
tv -> Timed a -> ServerItem a
forall a. Timed a -> ServerItem a
ServerFull Timed a
tv
        Right () -> ServerItem a
forall a. ServerItem a
ServerEmpty
      g :: ServerItem a -> Either (Timed a) ()
g = \case
        ServerFull Timed a
tv -> Timed a -> Either (Timed a) ()
forall a b. a -> Either a b
Left Timed a
tv
        ServerItem a
ServerEmpty -> () -> Either (Timed a) ()
forall a b. b -> Either a b
Right ()

-- | A server item to start with.
--
-- It contains no value.
initialServerItem :: ServerItem a
initialServerItem :: ServerItem a
initialServerItem = ServerItem a
forall a. ServerItem a
ServerEmpty

data ItemSyncRequest a
  = -- | There is no item locally
    ItemSyncRequestPoll
  | -- | There is an item locally that has not been synced to the server yet.
    ItemSyncRequestNew !a
  | -- | There is an item locally that was synced at the given 'ServerTime'
    ItemSyncRequestKnown !ServerTime
  | -- | There is an item locally that was synced at the given 'ServerTime'
    -- but it has been changed since then.
    ItemSyncRequestKnownButChanged !(Timed a)
  | -- | There was an item locally that has been deleted but the
    -- deletion wasn't synced to the server yet.
    ItemSyncRequestDeletedLocally !ServerTime
  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, (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 ServerTime (Either (Timed a) ServerTime))
 -> ItemSyncRequest a)
-> (ItemSyncRequest a
    -> Either
         (Either () a) (Either ServerTime (Either (Timed a) ServerTime)))
-> Codec
     Object
     (Either
        (Either () a) (Either ServerTime (Either (Timed a) ServerTime)))
     (Either
        (Either () a) (Either ServerTime (Either (Timed a) ServerTime)))
-> 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 ServerTime (Either (Timed a) ServerTime))
-> ItemSyncRequest a
forall a.
Either
  (Either () a) (Either ServerTime (Either (Timed a) ServerTime))
-> ItemSyncRequest a
f ItemSyncRequest a
-> Either
     (Either () a) (Either ServerTime (Either (Timed a) ServerTime))
forall b.
ItemSyncRequest b
-> Either
     (Either () b) (Either ServerTime (Either (Timed b) ServerTime))
g (Codec
   Object
   (Either
      (Either () a) (Either ServerTime (Either (Timed a) ServerTime)))
   (Either
      (Either () a) (Either ServerTime (Either (Timed a) ServerTime)))
 -> ObjectCodec (ItemSyncRequest a) (ItemSyncRequest a))
-> Codec
     Object
     (Either
        (Either () a) (Either ServerTime (Either (Timed a) ServerTime)))
     (Either
        (Either () a) (Either ServerTime (Either (Timed a) ServerTime)))
-> ObjectCodec (ItemSyncRequest a) (ItemSyncRequest a)
forall a b. (a -> b) -> a -> b
$
        Codec Object (Either () a) (Either () a)
-> Codec
     Object
     (Either ServerTime (Either (Timed a) ServerTime))
     (Either ServerTime (Either (Timed a) ServerTime))
-> Codec
     Object
     (Either
        (Either () a) (Either ServerTime (Either (Timed a) ServerTime)))
     (Either
        (Either () a) (Either ServerTime (Either (Timed a) ServerTime)))
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 a. Text -> ObjectCodec b (a -> a)
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 a. Text -> ObjectCodec b (a -> a)
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 ServerTime ServerTime
-> Codec
     Object (Either (Timed a) ServerTime) (Either (Timed a) ServerTime)
-> Codec
     Object
     (Either ServerTime (Either (Timed a) ServerTime))
     (Either ServerTime (Either (Timed a) ServerTime))
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 ServerTime (ServerTime -> ServerTime)
forall b a. Text -> ObjectCodec b (a -> a)
typeField Text
"synced" ObjectCodec ServerTime (ServerTime -> ServerTime)
-> Codec Object ServerTime ServerTime
-> Codec Object ServerTime ServerTime
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> Text -> Codec Object ServerTime ServerTime
forall output.
HasCodec output =>
Text -> Text -> ObjectCodec output output
requiredField Text
"time" Text
"last time the server confirmed a change, from the client's perspective")
              ( Codec Object (Timed a) (Timed a)
-> Codec Object ServerTime ServerTime
-> Codec
     Object (Either (Timed a) ServerTime) (Either (Timed a) ServerTime)
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 (Timed a) (Timed a -> Timed a)
forall b a. Text -> ObjectCodec b (a -> a)
typeField Text
"changed" ObjectCodec (Timed a) (Timed a -> Timed a)
-> Codec Object (Timed a) (Timed a)
-> Codec Object (Timed a) (Timed a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Codec Object (Timed a) (Timed a)
forall a. HasCodec a => JSONObjectCodec (Timed a)
timedObjectCodec)
                  (Text -> ObjectCodec ServerTime (ServerTime -> ServerTime)
forall b a. Text -> ObjectCodec b (a -> a)
typeField Text
"deleted" ObjectCodec ServerTime (ServerTime -> ServerTime)
-> Codec Object ServerTime ServerTime
-> Codec Object ServerTime ServerTime
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> Text -> Codec Object ServerTime ServerTime
forall output.
HasCodec output =>
Text -> Text -> ObjectCodec output output
requiredField Text
"time" Text
"last time the server confirmed a change, from the client's perspective")
              )
          )
    where
      f :: Either
  (Either () a) (Either ServerTime (Either (Timed a) ServerTime))
-> 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 ServerTime
tv) -> ServerTime -> ItemSyncRequest a
forall a. ServerTime -> ItemSyncRequest a
ItemSyncRequestKnown ServerTime
tv
        Right (Right (Left Timed a
tv)) -> Timed a -> ItemSyncRequest a
forall a. Timed a -> ItemSyncRequest a
ItemSyncRequestKnownButChanged Timed a
tv
        Right (Right (Right ServerTime
st)) -> ServerTime -> ItemSyncRequest a
forall a. ServerTime -> ItemSyncRequest a
ItemSyncRequestDeletedLocally ServerTime
st
      g :: ItemSyncRequest b
-> Either
     (Either () b) (Either ServerTime (Either (Timed b) ServerTime))
g = \case
        ItemSyncRequest b
ItemSyncRequestPoll -> Either () b
-> Either
     (Either () b) (Either ServerTime (Either (Timed b) ServerTime))
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 ServerTime (Either (Timed b) ServerTime))
forall a b. a -> Either a b
Left (b -> Either () b
forall a b. b -> Either a b
Right b
v)
        ItemSyncRequestKnown ServerTime
tv -> Either ServerTime (Either (Timed b) ServerTime)
-> Either
     (Either () b) (Either ServerTime (Either (Timed b) ServerTime))
forall a b. b -> Either a b
Right (ServerTime -> Either ServerTime (Either (Timed b) ServerTime)
forall a b. a -> Either a b
Left ServerTime
tv)
        ItemSyncRequestKnownButChanged Timed b
tv -> Either ServerTime (Either (Timed b) ServerTime)
-> Either
     (Either () b) (Either ServerTime (Either (Timed b) ServerTime))
forall a b. b -> Either a b
Right (Either (Timed b) ServerTime
-> Either ServerTime (Either (Timed b) ServerTime)
forall a b. b -> Either a b
Right (Timed b -> Either (Timed b) ServerTime
forall a b. a -> Either a b
Left Timed b
tv))
        ItemSyncRequestDeletedLocally ServerTime
st -> Either ServerTime (Either (Timed b) ServerTime)
-> Either
     (Either () b) (Either ServerTime (Either (Timed b) ServerTime))
forall a b. b -> Either a b
Right (Either (Timed b) ServerTime
-> Either ServerTime (Either (Timed b) ServerTime)
forall a b. b -> Either a b
Right (ServerTime -> Either (Timed b) ServerTime
forall a b. b -> Either a b
Right ServerTime
st))

      typeField :: Text -> ObjectCodec b (a -> a)
      typeField :: Text -> ObjectCodec b (a -> a)
typeField Text
typeName = a -> a
forall a. a -> a
id (a -> a) -> Codec Object b Text -> ObjectCodec b (a -> a)
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

-- | An intial 'ItemSyncRequest' to start with.
--
-- It just asks the server to send over whatever it knows.
initialItemSyncRequest :: ItemSyncRequest a
initialItemSyncRequest :: ItemSyncRequest a
initialItemSyncRequest = ItemSyncRequest a
forall a. ItemSyncRequest a
ItemSyncRequestPoll

data ItemSyncResponse a
  = -- | The client and server are fully in sync, and both empty
    --
    -- Nothing needs to be done at the client side.
    ItemSyncResponseInSyncEmpty
  | -- | The client and server are fully in sync.
    --
    -- Nothing needs to be done at the client side.
    ItemSyncResponseInSyncFull
  | -- | The client added an item and server has succesfully been made aware of that.
    --
    -- The client needs to update its server time
    ItemSyncResponseClientAdded !ServerTime
  | -- | The client changed an item and server has succesfully been made aware of that.
    --
    -- The client needs to update its server time
    ItemSyncResponseClientChanged !ServerTime
  | -- | The client deleted an item and server has succesfully been made aware of that.
    --
    -- The client can delete it from its deleted items
    ItemSyncResponseClientDeleted
  | -- | This item has been added on the server side
    --
    -- The client should add it too.
    ItemSyncResponseServerAdded !(Timed a)
  | -- | This item has been modified on the server side.
    --
    -- The client should modify it too.
    ItemSyncResponseServerChanged !(Timed a)
  | -- | The item was deleted on the server side
    --
    -- The client should delete it too.
    ItemSyncResponseServerDeleted
  | -- | The item at the server side
    -- | A conflict occurred.
    --
    -- The server has an item but the client does not.
    -- The server kept its part, the client can either take whatever the server gave them
    -- or deal with the conflict somehow, and then try to re-sync.
    ItemSyncResponseConflict !(Timed a)
  | -- | The item at the server side
    -- | A conflict occurred.
    --
    -- The client has a (modified) item but the server does not have any item.
    -- The server left its item deleted, the client can either delete its item too
    -- or deal with the conflict somehow, and then try to re-sync.
    ItemSyncResponseConflictClientDeleted !(Timed a)
  | ItemSyncResponseConflictServerDeleted
  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, (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 ServerTime ServerTime))
   (Either
      (Either (Either () (Timed a)) (Either (Timed a) ()))
      (Either (Either (Timed a) (Timed a)) ()))
 -> ItemSyncResponse a)
-> (ItemSyncResponse a
    -> Either
         (Either (Either () ()) (Either ServerTime ServerTime))
         (Either
            (Either (Either () (Timed a)) (Either (Timed a) ()))
            (Either (Either (Timed a) (Timed a)) ())))
-> Codec
     Object
     (Either
        (Either (Either () ()) (Either ServerTime ServerTime))
        (Either
           (Either (Either () (Timed a)) (Either (Timed a) ()))
           (Either (Either (Timed a) (Timed a)) ())))
     (Either
        (Either (Either () ()) (Either ServerTime ServerTime))
        (Either
           (Either (Either () (Timed a)) (Either (Timed a) ()))
           (Either (Either (Timed a) (Timed 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 ServerTime ServerTime))
  (Either
     (Either (Either () (Timed a)) (Either (Timed a) ()))
     (Either (Either (Timed a) (Timed a)) ()))
-> ItemSyncResponse a
forall a.
Either
  (Either (Either () ()) (Either ServerTime ServerTime))
  (Either
     (Either (Either () (Timed a)) (Either (Timed a) ()))
     (Either (Either (Timed a) (Timed a)) ()))
-> ItemSyncResponse a
f ItemSyncResponse a
-> Either
     (Either (Either () ()) (Either ServerTime ServerTime))
     (Either
        (Either (Either () (Timed a)) (Either (Timed a) ()))
        (Either (Either (Timed a) (Timed a)) ()))
forall a.
ItemSyncResponse a
-> Either
     (Either (Either () ()) (Either ServerTime ServerTime))
     (Either
        (Either (Either () (Timed a)) (Either (Timed a) ()))
        (Either (Either (Timed a) (Timed a)) ()))
g (Codec
   Object
   (Either
      (Either (Either () ()) (Either ServerTime ServerTime))
      (Either
         (Either (Either () (Timed a)) (Either (Timed a) ()))
         (Either (Either (Timed a) (Timed a)) ())))
   (Either
      (Either (Either () ()) (Either ServerTime ServerTime))
      (Either
         (Either (Either () (Timed a)) (Either (Timed a) ()))
         (Either (Either (Timed a) (Timed a)) ())))
 -> ObjectCodec (ItemSyncResponse a) (ItemSyncResponse a))
-> Codec
     Object
     (Either
        (Either (Either () ()) (Either ServerTime ServerTime))
        (Either
           (Either (Either () (Timed a)) (Either (Timed a) ()))
           (Either (Either (Timed a) (Timed a)) ())))
     (Either
        (Either (Either () ()) (Either ServerTime ServerTime))
        (Either
           (Either (Either () (Timed a)) (Either (Timed a) ()))
           (Either (Either (Timed a) (Timed a)) ())))
-> ObjectCodec (ItemSyncResponse a) (ItemSyncResponse a)
forall a b. (a -> b) -> a -> b
$
        Codec
  Object
  (Either (Either () ()) (Either ServerTime ServerTime))
  (Either (Either () ()) (Either ServerTime ServerTime))
-> Codec
     Object
     (Either
        (Either (Either () (Timed a)) (Either (Timed a) ()))
        (Either (Either (Timed a) (Timed a)) ()))
     (Either
        (Either (Either () (Timed a)) (Either (Timed a) ()))
        (Either (Either (Timed a) (Timed a)) ()))
-> Codec
     Object
     (Either
        (Either (Either () ()) (Either ServerTime ServerTime))
        (Either
           (Either (Either () (Timed a)) (Either (Timed a) ()))
           (Either (Either (Timed a) (Timed a)) ())))
     (Either
        (Either (Either () ()) (Either ServerTime ServerTime))
        (Either
           (Either (Either () (Timed a)) (Either (Timed a) ()))
           (Either (Either (Timed a) (Timed 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 (Either () ()) (Either () ())
-> Codec
     Object
     (Either ServerTime ServerTime)
     (Either ServerTime ServerTime)
-> Codec
     Object
     (Either (Either () ()) (Either ServerTime ServerTime))
     (Either (Either () ()) (Either ServerTime ServerTime))
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 a. Text -> ObjectCodec b (a -> a)
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 a. Text -> ObjectCodec b (a -> a)
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 ServerTime ServerTime
-> Codec Object ServerTime ServerTime
-> Codec
     Object
     (Either ServerTime ServerTime)
     (Either ServerTime ServerTime)
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 ServerTime (ServerTime -> ServerTime)
forall b a. Text -> ObjectCodec b (a -> a)
typeField Text
"client-added" ObjectCodec ServerTime (ServerTime -> ServerTime)
-> Codec Object ServerTime ServerTime
-> Codec Object ServerTime ServerTime
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> Text -> Codec Object ServerTime ServerTime
forall output.
HasCodec output =>
Text -> Text -> ObjectCodec output output
requiredField Text
"time" Text
"server's confirmation of the addition")
                  (Text -> ObjectCodec ServerTime (ServerTime -> ServerTime)
forall b a. Text -> ObjectCodec b (a -> a)
typeField Text
"client-changed" ObjectCodec ServerTime (ServerTime -> ServerTime)
-> Codec Object ServerTime ServerTime
-> Codec Object ServerTime ServerTime
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> Text -> Codec Object ServerTime ServerTime
forall output.
HasCodec output =>
Text -> Text -> ObjectCodec output output
requiredField Text
"time" Text
"server's confirmation of the addition")
              )
          )
          ( Codec
  Object
  (Either (Either () (Timed a)) (Either (Timed a) ()))
  (Either (Either () (Timed a)) (Either (Timed a) ()))
-> Codec
     Object
     (Either (Either (Timed a) (Timed a)) ())
     (Either (Either (Timed a) (Timed a)) ())
-> Codec
     Object
     (Either
        (Either (Either () (Timed a)) (Either (Timed a) ()))
        (Either (Either (Timed a) (Timed a)) ()))
     (Either
        (Either (Either () (Timed a)) (Either (Timed a) ()))
        (Either (Either (Timed a) (Timed 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 (Either () (Timed a)) (Either () (Timed a))
-> Codec Object (Either (Timed a) ()) (Either (Timed a) ())
-> Codec
     Object
     (Either (Either () (Timed a)) (Either (Timed a) ()))
     (Either (Either () (Timed a)) (Either (Timed 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 (Timed a) (Timed a)
-> Codec Object (Either () (Timed a)) (Either () (Timed 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 a. Text -> ObjectCodec b (a -> a)
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 ())
                      (Text -> ObjectCodec (Timed a) (Timed a -> Timed a)
forall b a. Text -> ObjectCodec b (a -> a)
typeField Text
"server-added" ObjectCodec (Timed a) (Timed a -> Timed a)
-> Codec Object (Timed a) (Timed a)
-> Codec Object (Timed a) (Timed a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Codec Object (Timed a) (Timed a)
forall a. HasCodec a => JSONObjectCodec (Timed a)
timedObjectCodec)
                  )
                  ( Codec Object (Timed a) (Timed a)
-> Codec Object () ()
-> Codec Object (Either (Timed a) ()) (Either (Timed 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 (Timed a) (Timed a -> Timed a)
forall b a. Text -> ObjectCodec b (a -> a)
typeField Text
"server-changed" ObjectCodec (Timed a) (Timed a -> Timed a)
-> Codec Object (Timed a) (Timed a)
-> Codec Object (Timed a) (Timed a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Codec Object (Timed a) (Timed a)
forall a. HasCodec a => JSONObjectCodec (Timed a)
timedObjectCodec)
                      (Text -> ObjectCodec () (() -> ())
forall b a. Text -> ObjectCodec b (a -> a)
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 ())
                  )
              )
              ( Codec
  Object (Either (Timed a) (Timed a)) (Either (Timed a) (Timed a))
-> Codec Object () ()
-> Codec
     Object
     (Either (Either (Timed a) (Timed a)) ())
     (Either (Either (Timed a) (Timed 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 (Timed a) (Timed a)
-> Codec Object (Timed a) (Timed a)
-> Codec
     Object (Either (Timed a) (Timed a)) (Either (Timed a) (Timed 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 (Timed a) (Timed a -> Timed a)
forall b a. Text -> ObjectCodec b (a -> a)
typeField Text
"conflict" ObjectCodec (Timed a) (Timed a -> Timed a)
-> Codec Object (Timed a) (Timed a)
-> Codec Object (Timed a) (Timed a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Codec Object (Timed a) (Timed a)
forall a. HasCodec a => JSONObjectCodec (Timed a)
timedObjectCodec)
                      (Text -> ObjectCodec (Timed a) (Timed a -> Timed a)
forall b a. Text -> ObjectCodec b (a -> a)
typeField Text
"conflict-client-deleted" ObjectCodec (Timed a) (Timed a -> Timed a)
-> Codec Object (Timed a) (Timed a)
-> Codec Object (Timed a) (Timed a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Codec Object (Timed a) (Timed a)
forall a. HasCodec a => JSONObjectCodec (Timed a)
timedObjectCodec)
                  )
                  (Text -> ObjectCodec () (() -> ())
forall b a. Text -> ObjectCodec b (a -> a)
typeField Text
"conflict-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 ServerTime ServerTime))
  (Either
     (Either (Either () (Timed a)) (Either (Timed a) ()))
     (Either (Either (Timed a) (Timed a)) ()))
-> ItemSyncResponse a
f = \case
        Left (Left (Left ())) -> ItemSyncResponse a
forall a. ItemSyncResponse a
ItemSyncResponseInSyncEmpty
        Left (Left (Right ())) -> ItemSyncResponse a
forall a. ItemSyncResponse a
ItemSyncResponseInSyncFull
        Left (Right (Left ServerTime
st)) -> ServerTime -> ItemSyncResponse a
forall a. ServerTime -> ItemSyncResponse a
ItemSyncResponseClientAdded ServerTime
st
        Left (Right (Right ServerTime
st)) -> ServerTime -> ItemSyncResponse a
forall a. ServerTime -> ItemSyncResponse a
ItemSyncResponseClientChanged ServerTime
st
        Right (Left (Left (Left ()))) -> ItemSyncResponse a
forall a. ItemSyncResponse a
ItemSyncResponseClientDeleted
        Right (Left (Left (Right Timed a
tv))) -> Timed a -> ItemSyncResponse a
forall a. Timed a -> ItemSyncResponse a
ItemSyncResponseServerAdded Timed a
tv
        Right (Left (Right (Left Timed a
tv))) -> Timed a -> ItemSyncResponse a
forall a. Timed a -> ItemSyncResponse a
ItemSyncResponseServerChanged Timed a
tv
        Right (Left (Right (Right ()))) -> ItemSyncResponse a
forall a. ItemSyncResponse a
ItemSyncResponseServerDeleted
        Right (Right (Left (Left Timed a
tv))) -> Timed a -> ItemSyncResponse a
forall a. Timed a -> ItemSyncResponse a
ItemSyncResponseConflict Timed a
tv
        Right (Right (Left (Right Timed a
tv))) -> Timed a -> ItemSyncResponse a
forall a. Timed a -> ItemSyncResponse a
ItemSyncResponseConflictClientDeleted Timed a
tv
        Right (Right (Right ())) -> ItemSyncResponse a
forall a. ItemSyncResponse a
ItemSyncResponseConflictServerDeleted
      g :: ItemSyncResponse a
-> Either
     (Either (Either () ()) (Either ServerTime ServerTime))
     (Either
        (Either (Either () (Timed a)) (Either (Timed a) ()))
        (Either (Either (Timed a) (Timed a)) ()))
g = \case
        ItemSyncResponse a
ItemSyncResponseInSyncEmpty -> Either (Either () ()) (Either ServerTime ServerTime)
-> Either
     (Either (Either () ()) (Either ServerTime ServerTime))
     (Either
        (Either (Either () (Timed a)) (Either (Timed a) ()))
        (Either (Either (Timed a) (Timed a)) ()))
forall a b. a -> Either a b
Left (Either () ()
-> Either (Either () ()) (Either ServerTime ServerTime)
forall a b. a -> Either a b
Left (() -> Either () ()
forall a b. a -> Either a b
Left ()))
        ItemSyncResponse a
ItemSyncResponseInSyncFull -> Either (Either () ()) (Either ServerTime ServerTime)
-> Either
     (Either (Either () ()) (Either ServerTime ServerTime))
     (Either
        (Either (Either () (Timed a)) (Either (Timed a) ()))
        (Either (Either (Timed a) (Timed a)) ()))
forall a b. a -> Either a b
Left (Either () ()
-> Either (Either () ()) (Either ServerTime ServerTime)
forall a b. a -> Either a b
Left (() -> Either () ()
forall a b. b -> Either a b
Right ()))
        ItemSyncResponseClientAdded ServerTime
st -> Either (Either () ()) (Either ServerTime ServerTime)
-> Either
     (Either (Either () ()) (Either ServerTime ServerTime))
     (Either
        (Either (Either () (Timed a)) (Either (Timed a) ()))
        (Either (Either (Timed a) (Timed a)) ()))
forall a b. a -> Either a b
Left (Either ServerTime ServerTime
-> Either (Either () ()) (Either ServerTime ServerTime)
forall a b. b -> Either a b
Right (ServerTime -> Either ServerTime ServerTime
forall a b. a -> Either a b
Left ServerTime
st))
        ItemSyncResponseClientChanged ServerTime
st -> Either (Either () ()) (Either ServerTime ServerTime)
-> Either
     (Either (Either () ()) (Either ServerTime ServerTime))
     (Either
        (Either (Either () (Timed a)) (Either (Timed a) ()))
        (Either (Either (Timed a) (Timed a)) ()))
forall a b. a -> Either a b
Left (Either ServerTime ServerTime
-> Either (Either () ()) (Either ServerTime ServerTime)
forall a b. b -> Either a b
Right (ServerTime -> Either ServerTime ServerTime
forall a b. b -> Either a b
Right ServerTime
st))
        ItemSyncResponse a
ItemSyncResponseClientDeleted -> Either
  (Either (Either () (Timed a)) (Either (Timed a) ()))
  (Either (Either (Timed a) (Timed a)) ())
-> Either
     (Either (Either () ()) (Either ServerTime ServerTime))
     (Either
        (Either (Either () (Timed a)) (Either (Timed a) ()))
        (Either (Either (Timed a) (Timed a)) ()))
forall a b. b -> Either a b
Right (Either (Either () (Timed a)) (Either (Timed a) ())
-> Either
     (Either (Either () (Timed a)) (Either (Timed a) ()))
     (Either (Either (Timed a) (Timed a)) ())
forall a b. a -> Either a b
Left (Either () (Timed a)
-> Either (Either () (Timed a)) (Either (Timed a) ())
forall a b. a -> Either a b
Left (() -> Either () (Timed a)
forall a b. a -> Either a b
Left ())))
        ItemSyncResponseServerAdded Timed a
tv -> Either
  (Either (Either () (Timed a)) (Either (Timed a) ()))
  (Either (Either (Timed a) (Timed a)) ())
-> Either
     (Either (Either () ()) (Either ServerTime ServerTime))
     (Either
        (Either (Either () (Timed a)) (Either (Timed a) ()))
        (Either (Either (Timed a) (Timed a)) ()))
forall a b. b -> Either a b
Right (Either (Either () (Timed a)) (Either (Timed a) ())
-> Either
     (Either (Either () (Timed a)) (Either (Timed a) ()))
     (Either (Either (Timed a) (Timed a)) ())
forall a b. a -> Either a b
Left (Either () (Timed a)
-> Either (Either () (Timed a)) (Either (Timed a) ())
forall a b. a -> Either a b
Left (Timed a -> Either () (Timed a)
forall a b. b -> Either a b
Right Timed a
tv)))
        ItemSyncResponseServerChanged Timed a
tv -> Either
  (Either (Either () (Timed a)) (Either (Timed a) ()))
  (Either (Either (Timed a) (Timed a)) ())
-> Either
     (Either (Either () ()) (Either ServerTime ServerTime))
     (Either
        (Either (Either () (Timed a)) (Either (Timed a) ()))
        (Either (Either (Timed a) (Timed a)) ()))
forall a b. b -> Either a b
Right (Either (Either () (Timed a)) (Either (Timed a) ())
-> Either
     (Either (Either () (Timed a)) (Either (Timed a) ()))
     (Either (Either (Timed a) (Timed a)) ())
forall a b. a -> Either a b
Left (Either (Timed a) ()
-> Either (Either () (Timed a)) (Either (Timed a) ())
forall a b. b -> Either a b
Right (Timed a -> Either (Timed a) ()
forall a b. a -> Either a b
Left Timed a
tv)))
        ItemSyncResponse a
ItemSyncResponseServerDeleted -> Either
  (Either (Either () (Timed a)) (Either (Timed a) ()))
  (Either (Either (Timed a) (Timed a)) ())
-> Either
     (Either (Either () ()) (Either ServerTime ServerTime))
     (Either
        (Either (Either () (Timed a)) (Either (Timed a) ()))
        (Either (Either (Timed a) (Timed a)) ()))
forall a b. b -> Either a b
Right (Either (Either () (Timed a)) (Either (Timed a) ())
-> Either
     (Either (Either () (Timed a)) (Either (Timed a) ()))
     (Either (Either (Timed a) (Timed a)) ())
forall a b. a -> Either a b
Left (Either (Timed a) ()
-> Either (Either () (Timed a)) (Either (Timed a) ())
forall a b. b -> Either a b
Right (() -> Either (Timed a) ()
forall a b. b -> Either a b
Right ())))
        ItemSyncResponseConflict Timed a
tv -> Either
  (Either (Either () (Timed a)) (Either (Timed a) ()))
  (Either (Either (Timed a) (Timed a)) ())
-> Either
     (Either (Either () ()) (Either ServerTime ServerTime))
     (Either
        (Either (Either () (Timed a)) (Either (Timed a) ()))
        (Either (Either (Timed a) (Timed a)) ()))
forall a b. b -> Either a b
Right (Either (Either (Timed a) (Timed a)) ()
-> Either
     (Either (Either () (Timed a)) (Either (Timed a) ()))
     (Either (Either (Timed a) (Timed a)) ())
forall a b. b -> Either a b
Right (Either (Timed a) (Timed a)
-> Either (Either (Timed a) (Timed a)) ()
forall a b. a -> Either a b
Left (Timed a -> Either (Timed a) (Timed a)
forall a b. a -> Either a b
Left Timed a
tv)))
        ItemSyncResponseConflictClientDeleted Timed a
tv -> Either
  (Either (Either () (Timed a)) (Either (Timed a) ()))
  (Either (Either (Timed a) (Timed a)) ())
-> Either
     (Either (Either () ()) (Either ServerTime ServerTime))
     (Either
        (Either (Either () (Timed a)) (Either (Timed a) ()))
        (Either (Either (Timed a) (Timed a)) ()))
forall a b. b -> Either a b
Right (Either (Either (Timed a) (Timed a)) ()
-> Either
     (Either (Either () (Timed a)) (Either (Timed a) ()))
     (Either (Either (Timed a) (Timed a)) ())
forall a b. b -> Either a b
Right (Either (Timed a) (Timed a)
-> Either (Either (Timed a) (Timed a)) ()
forall a b. a -> Either a b
Left (Timed a -> Either (Timed a) (Timed a)
forall a b. b -> Either a b
Right Timed a
tv)))
        ItemSyncResponse a
ItemSyncResponseConflictServerDeleted -> Either
  (Either (Either () (Timed a)) (Either (Timed a) ()))
  (Either (Either (Timed a) (Timed a)) ())
-> Either
     (Either (Either () ()) (Either ServerTime ServerTime))
     (Either
        (Either (Either () (Timed a)) (Either (Timed a) ()))
        (Either (Either (Timed a) (Timed a)) ()))
forall a b. b -> Either a b
Right (Either (Either (Timed a) (Timed a)) ()
-> Either
     (Either (Either () (Timed a)) (Either (Timed a) ()))
     (Either (Either (Timed a) (Timed a)) ())
forall a b. b -> Either a b
Right (() -> Either (Either (Timed a) (Timed a)) ()
forall a b. b -> Either a b
Right ()))

      typeField :: Text -> ObjectCodec b (a -> a)
      typeField :: Text -> ObjectCodec b (a -> a)
typeField Text
typeName = a -> a
forall a. a -> a
id (a -> a) -> Codec Object b Text -> ObjectCodec b (a -> a)
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

-- | Produce an 'ItemSyncRequest' from a 'ClientItem'.
--
-- Send this to the server for synchronisation.
makeItemSyncRequest :: ClientItem a -> ItemSyncRequest a
makeItemSyncRequest :: ClientItem a -> ItemSyncRequest a
makeItemSyncRequest ClientItem a
cs =
  case ClientItem a
cs of
    ClientItem a
ClientEmpty -> ItemSyncRequest a
forall a. ItemSyncRequest a
ItemSyncRequestPoll
    ClientAdded a
i -> a -> ItemSyncRequest a
forall a. a -> ItemSyncRequest a
ItemSyncRequestNew a
i
    ClientItemSynced Timed a
t -> ServerTime -> ItemSyncRequest a
forall a. ServerTime -> ItemSyncRequest a
ItemSyncRequestKnown (Timed a -> ServerTime
forall a. Timed a -> ServerTime
timedTime Timed a
t)
    ClientItemSyncedButChanged Timed a
t -> Timed a -> ItemSyncRequest a
forall a. Timed a -> ItemSyncRequest a
ItemSyncRequestKnownButChanged Timed a
t
    ClientDeleted ServerTime
st -> ServerTime -> ItemSyncRequest a
forall a. ServerTime -> ItemSyncRequest a
ItemSyncRequestDeletedLocally ServerTime
st

data ItemMergeResult a
  = -- | The merger went succesfully, no conflicts or desyncs
    MergeSuccess !(ClientItem a)
  | -- | The item at the server side
    -- | There was a merge conflict. The client had deleted the item while the server had modified it.
    MergeConflict !a !(Timed a)
  | -- | The item at the server side
    -- | There was a merge conflict. The server had deleted the item while the client had modified it.
    MergeConflictClientDeleted !(Timed a)
  | -- | The item at the client side
    -- | The server responded with a response that did not make sense given the client's request.
    MergeConflictServerDeleted !a
  | MergeMismatch
  deriving (Int -> ItemMergeResult a -> ShowS
[ItemMergeResult a] -> ShowS
ItemMergeResult a -> String
(Int -> ItemMergeResult a -> ShowS)
-> (ItemMergeResult a -> String)
-> ([ItemMergeResult a] -> ShowS)
-> Show (ItemMergeResult a)
forall a. Show a => Int -> ItemMergeResult a -> ShowS
forall a. Show a => [ItemMergeResult a] -> ShowS
forall a. Show a => ItemMergeResult a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ItemMergeResult a] -> ShowS
$cshowList :: forall a. Show a => [ItemMergeResult a] -> ShowS
show :: ItemMergeResult a -> String
$cshow :: forall a. Show a => ItemMergeResult a -> String
showsPrec :: Int -> ItemMergeResult a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> ItemMergeResult a -> ShowS
Show, ItemMergeResult a -> ItemMergeResult a -> Bool
(ItemMergeResult a -> ItemMergeResult a -> Bool)
-> (ItemMergeResult a -> ItemMergeResult a -> Bool)
-> Eq (ItemMergeResult a)
forall a. Eq a => ItemMergeResult a -> ItemMergeResult a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ItemMergeResult a -> ItemMergeResult a -> Bool
$c/= :: forall a. Eq a => ItemMergeResult a -> ItemMergeResult a -> Bool
== :: ItemMergeResult a -> ItemMergeResult a -> Bool
$c== :: forall a. Eq a => ItemMergeResult a -> ItemMergeResult a -> Bool
Eq, (forall x. ItemMergeResult a -> Rep (ItemMergeResult a) x)
-> (forall x. Rep (ItemMergeResult a) x -> ItemMergeResult a)
-> Generic (ItemMergeResult a)
forall x. Rep (ItemMergeResult a) x -> ItemMergeResult a
forall x. ItemMergeResult a -> Rep (ItemMergeResult a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (ItemMergeResult a) x -> ItemMergeResult a
forall a x. ItemMergeResult a -> Rep (ItemMergeResult a) x
$cto :: forall a x. Rep (ItemMergeResult a) x -> ItemMergeResult a
$cfrom :: forall a x. ItemMergeResult a -> Rep (ItemMergeResult a) x
Generic)

instance Validity a => Validity (ItemMergeResult a)

instance NFData a => NFData (ItemMergeResult a)

-- | Merge an 'ItemSyncResponse' into the current 'ClientItem'.
--
-- This function will not make any decisions about what to do with
-- conflicts or mismatches between the request and the response.
-- It only produces a 'ItemMergeResult' so you can decide what to do with it.
mergeItemSyncResponseRaw :: ClientItem a -> ItemSyncResponse a -> ItemMergeResult a
mergeItemSyncResponseRaw :: ClientItem a -> ItemSyncResponse a -> ItemMergeResult a
mergeItemSyncResponseRaw ClientItem a
cs ItemSyncResponse a
sr =
  case ClientItem a
cs of
    ClientItem a
ClientEmpty ->
      case ItemSyncResponse a
sr of
        ItemSyncResponse a
ItemSyncResponseInSyncEmpty -> ClientItem a -> ItemMergeResult a
forall a. ClientItem a -> ItemMergeResult a
MergeSuccess ClientItem a
cs
        ItemSyncResponseServerAdded Timed a
t -> ClientItem a -> ItemMergeResult a
forall a. ClientItem a -> ItemMergeResult a
MergeSuccess (ClientItem a -> ItemMergeResult a)
-> ClientItem a -> ItemMergeResult a
forall a b. (a -> b) -> a -> b
$ Timed a -> ClientItem a
forall a. Timed a -> ClientItem a
ClientItemSynced Timed a
t
        ItemSyncResponse a
_ -> ItemMergeResult a
forall a. ItemMergeResult a
MergeMismatch
    ClientAdded a
ci ->
      case ItemSyncResponse a
sr of
        ItemSyncResponseClientAdded ServerTime
st ->
          ClientItem a -> ItemMergeResult a
forall a. ClientItem a -> ItemMergeResult a
MergeSuccess (ClientItem a -> ItemMergeResult a)
-> ClientItem a -> ItemMergeResult a
forall a b. (a -> b) -> a -> b
$ Timed a -> ClientItem a
forall a. Timed a -> ClientItem a
ClientItemSynced (Timed a -> ClientItem a) -> Timed a -> ClientItem a
forall a b. (a -> b) -> a -> b
$ Timed :: forall a. a -> ServerTime -> Timed a
Timed {timedValue :: a
timedValue = a
ci, timedTime :: ServerTime
timedTime = ServerTime
st}
        ItemSyncResponseConflict Timed a
si -> a -> Timed a -> ItemMergeResult a
forall a. a -> Timed a -> ItemMergeResult a
MergeConflict a
ci Timed a
si
        ItemSyncResponse a
_ -> ItemMergeResult a
forall a. ItemMergeResult a
MergeMismatch
    ClientItemSynced Timed a
t ->
      case ItemSyncResponse a
sr of
        ItemSyncResponse a
ItemSyncResponseInSyncFull -> ClientItem a -> ItemMergeResult a
forall a. ClientItem a -> ItemMergeResult a
MergeSuccess (ClientItem a -> ItemMergeResult a)
-> ClientItem a -> ItemMergeResult a
forall a b. (a -> b) -> a -> b
$ Timed a -> ClientItem a
forall a. Timed a -> ClientItem a
ClientItemSynced Timed a
t
        ItemSyncResponseServerChanged Timed a
st -> ClientItem a -> ItemMergeResult a
forall a. ClientItem a -> ItemMergeResult a
MergeSuccess (ClientItem a -> ItemMergeResult a)
-> ClientItem a -> ItemMergeResult a
forall a b. (a -> b) -> a -> b
$ Timed a -> ClientItem a
forall a. Timed a -> ClientItem a
ClientItemSynced Timed a
st
        ItemSyncResponse a
ItemSyncResponseServerDeleted -> ClientItem a -> ItemMergeResult a
forall a. ClientItem a -> ItemMergeResult a
MergeSuccess ClientItem a
forall a. ClientItem a
ClientEmpty
        ItemSyncResponse a
_ -> ItemMergeResult a
forall a. ItemMergeResult a
MergeMismatch
    ClientItemSyncedButChanged Timed a
ct ->
      case ItemSyncResponse a
sr of
        ItemSyncResponseClientChanged ServerTime
st -> ClientItem a -> ItemMergeResult a
forall a. ClientItem a -> ItemMergeResult a
MergeSuccess (ClientItem a -> ItemMergeResult a)
-> ClientItem a -> ItemMergeResult a
forall a b. (a -> b) -> a -> b
$ Timed a -> ClientItem a
forall a. Timed a -> ClientItem a
ClientItemSynced (Timed a -> ClientItem a) -> Timed a -> ClientItem a
forall a b. (a -> b) -> a -> b
$ Timed a
ct {timedTime :: ServerTime
timedTime = ServerTime
st}
        ItemSyncResponseConflict Timed a
si -> a -> Timed a -> ItemMergeResult a
forall a. a -> Timed a -> ItemMergeResult a
MergeConflict (Timed a -> a
forall a. Timed a -> a
timedValue Timed a
ct) Timed a
si
        ItemSyncResponse a
ItemSyncResponseConflictServerDeleted -> a -> ItemMergeResult a
forall a. a -> ItemMergeResult a
MergeConflictServerDeleted (Timed a -> a
forall a. Timed a -> a
timedValue Timed a
ct)
        ItemSyncResponse a
_ -> ItemMergeResult a
forall a. ItemMergeResult a
MergeMismatch
    ClientDeleted ServerTime
_ ->
      case ItemSyncResponse a
sr of
        ItemSyncResponse a
ItemSyncResponseClientDeleted -> ClientItem a -> ItemMergeResult a
forall a. ClientItem a -> ItemMergeResult a
MergeSuccess ClientItem a
forall a. ClientItem a
ClientEmpty
        ItemSyncResponseConflictClientDeleted Timed a
si -> Timed a -> ItemMergeResult a
forall a. Timed a -> ItemMergeResult a
MergeConflictClientDeleted Timed a
si
        ItemSyncResponse a
_ -> ItemMergeResult a
forall a. ItemMergeResult a
MergeMismatch

mergeItemSyncResponseUsingStrategy :: ItemMergeStrategy a -> ClientItem a -> ItemSyncResponse a -> ClientItem a
mergeItemSyncResponseUsingStrategy :: ItemMergeStrategy a
-> ClientItem a -> ItemSyncResponse a -> ClientItem a
mergeItemSyncResponseUsingStrategy ItemMergeStrategy a
strat ClientItem a
ci ItemSyncResponse a
sr = ItemMergeStrategy a
-> ClientItem a -> ItemMergeResult a -> ClientItem a
forall a.
ItemMergeStrategy a
-> ClientItem a -> ItemMergeResult a -> ClientItem a
mergeUsingStrategy ItemMergeStrategy a
strat ClientItem a
ci (ItemMergeResult a -> ClientItem a)
-> ItemMergeResult a -> ClientItem a
forall a b. (a -> b) -> a -> b
$ ClientItem a -> ItemSyncResponse a -> ItemMergeResult a
forall a. ClientItem a -> ItemSyncResponse a -> ItemMergeResult a
mergeItemSyncResponseRaw ClientItem a
ci ItemSyncResponse a
sr

mergeItemSyncResponseFromServer :: ClientItem a -> ItemSyncResponse a -> ClientItem a
mergeItemSyncResponseFromServer :: ClientItem a -> ItemSyncResponse a -> ClientItem a
mergeItemSyncResponseFromServer = ItemMergeStrategy a
-> ClientItem a -> ItemSyncResponse a -> ClientItem a
forall a.
ItemMergeStrategy a
-> ClientItem a -> ItemSyncResponse a -> ClientItem a
mergeItemSyncResponseUsingStrategy ItemMergeStrategy a
forall a. ItemMergeStrategy a
mergeFromServerStrategy

mergeItemSyncResponseFromClient :: ClientItem a -> ItemSyncResponse a -> ClientItem a
mergeItemSyncResponseFromClient :: ClientItem a -> ItemSyncResponse a -> ClientItem a
mergeItemSyncResponseFromClient = ItemMergeStrategy a
-> ClientItem a -> ItemSyncResponse a -> ClientItem a
forall a.
ItemMergeStrategy a
-> ClientItem a -> ItemSyncResponse a -> ClientItem a
mergeItemSyncResponseUsingStrategy ItemMergeStrategy a
forall a. ItemMergeStrategy a
mergeFromClientStrategy

mergeItemSyncResponseUsingCRDT :: (a -> a -> a) -> ClientItem a -> ItemSyncResponse a -> ClientItem a
mergeItemSyncResponseUsingCRDT :: (a -> a -> a) -> ClientItem a -> ItemSyncResponse a -> ClientItem a
mergeItemSyncResponseUsingCRDT = ItemMergeStrategy a
-> ClientItem a -> ItemSyncResponse a -> ClientItem a
forall a.
ItemMergeStrategy a
-> ClientItem a -> ItemSyncResponse a -> ClientItem a
mergeItemSyncResponseUsingStrategy (ItemMergeStrategy a
 -> ClientItem a -> ItemSyncResponse a -> ClientItem a)
-> ((a -> a -> a) -> ItemMergeStrategy a)
-> (a -> a -> a)
-> ClientItem a
-> ItemSyncResponse a
-> ClientItem a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> a -> a) -> ItemMergeStrategy a
forall a. (a -> a -> a) -> ItemMergeStrategy a
mergeUsingCRDTStrategy

-- | A strategy to merge conflicts for item synchronisation
data ItemMergeStrategy a = ItemMergeStrategy
  { -- | How to merge modification conflicts
    --
    -- The first argument is the client item and the second argument is the server item.
    ItemMergeStrategy a -> a -> a -> ChangeConflictResolution a
itemMergeStrategyMergeChangeConflict :: !(a -> a -> ChangeConflictResolution a),
    -- | How to merge conflicts where the client deleted an item that the server modified
    ItemMergeStrategy a -> a -> ClientDeletedConflictResolution
itemMergeStrategyMergeClientDeletedConflict :: !(a -> ClientDeletedConflictResolution),
    -- | How to merge conflicts where the server deleted an item that the client modified
    ItemMergeStrategy a -> a -> ServerDeletedConflictResolution
itemMergeStrategyMergeServerDeletedConflict :: !(a -> ServerDeletedConflictResolution)
  }
  deriving ((forall x. ItemMergeStrategy a -> Rep (ItemMergeStrategy a) x)
-> (forall x. Rep (ItemMergeStrategy a) x -> ItemMergeStrategy a)
-> Generic (ItemMergeStrategy a)
forall x. Rep (ItemMergeStrategy a) x -> ItemMergeStrategy a
forall x. ItemMergeStrategy a -> Rep (ItemMergeStrategy a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (ItemMergeStrategy a) x -> ItemMergeStrategy a
forall a x. ItemMergeStrategy a -> Rep (ItemMergeStrategy a) x
$cto :: forall a x. Rep (ItemMergeStrategy a) x -> ItemMergeStrategy a
$cfrom :: forall a x. ItemMergeStrategy a -> Rep (ItemMergeStrategy a) x
Generic)

data ChangeConflictResolution a
  = KeepLocal
  | TakeRemote
  | Merged a
  deriving (Int -> ChangeConflictResolution a -> ShowS
[ChangeConflictResolution a] -> ShowS
ChangeConflictResolution a -> String
(Int -> ChangeConflictResolution a -> ShowS)
-> (ChangeConflictResolution a -> String)
-> ([ChangeConflictResolution a] -> ShowS)
-> Show (ChangeConflictResolution a)
forall a. Show a => Int -> ChangeConflictResolution a -> ShowS
forall a. Show a => [ChangeConflictResolution a] -> ShowS
forall a. Show a => ChangeConflictResolution a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChangeConflictResolution a] -> ShowS
$cshowList :: forall a. Show a => [ChangeConflictResolution a] -> ShowS
show :: ChangeConflictResolution a -> String
$cshow :: forall a. Show a => ChangeConflictResolution a -> String
showsPrec :: Int -> ChangeConflictResolution a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> ChangeConflictResolution a -> ShowS
Show, ChangeConflictResolution a -> ChangeConflictResolution a -> Bool
(ChangeConflictResolution a -> ChangeConflictResolution a -> Bool)
-> (ChangeConflictResolution a
    -> ChangeConflictResolution a -> Bool)
-> Eq (ChangeConflictResolution a)
forall a.
Eq a =>
ChangeConflictResolution a -> ChangeConflictResolution a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChangeConflictResolution a -> ChangeConflictResolution a -> Bool
$c/= :: forall a.
Eq a =>
ChangeConflictResolution a -> ChangeConflictResolution a -> Bool
== :: ChangeConflictResolution a -> ChangeConflictResolution a -> Bool
$c== :: forall a.
Eq a =>
ChangeConflictResolution a -> ChangeConflictResolution a -> Bool
Eq, (forall x.
 ChangeConflictResolution a -> Rep (ChangeConflictResolution a) x)
-> (forall x.
    Rep (ChangeConflictResolution a) x -> ChangeConflictResolution a)
-> Generic (ChangeConflictResolution a)
forall x.
Rep (ChangeConflictResolution a) x -> ChangeConflictResolution a
forall x.
ChangeConflictResolution a -> Rep (ChangeConflictResolution a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x.
Rep (ChangeConflictResolution a) x -> ChangeConflictResolution a
forall a x.
ChangeConflictResolution a -> Rep (ChangeConflictResolution a) x
$cto :: forall a x.
Rep (ChangeConflictResolution a) x -> ChangeConflictResolution a
$cfrom :: forall a x.
ChangeConflictResolution a -> Rep (ChangeConflictResolution a) x
Generic)

data ClientDeletedConflictResolution
  = TakeRemoteChange
  | StayDeleted
  deriving (Int -> ClientDeletedConflictResolution -> ShowS
[ClientDeletedConflictResolution] -> ShowS
ClientDeletedConflictResolution -> String
(Int -> ClientDeletedConflictResolution -> ShowS)
-> (ClientDeletedConflictResolution -> String)
-> ([ClientDeletedConflictResolution] -> ShowS)
-> Show ClientDeletedConflictResolution
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ClientDeletedConflictResolution] -> ShowS
$cshowList :: [ClientDeletedConflictResolution] -> ShowS
show :: ClientDeletedConflictResolution -> String
$cshow :: ClientDeletedConflictResolution -> String
showsPrec :: Int -> ClientDeletedConflictResolution -> ShowS
$cshowsPrec :: Int -> ClientDeletedConflictResolution -> ShowS
Show, ClientDeletedConflictResolution
-> ClientDeletedConflictResolution -> Bool
(ClientDeletedConflictResolution
 -> ClientDeletedConflictResolution -> Bool)
-> (ClientDeletedConflictResolution
    -> ClientDeletedConflictResolution -> Bool)
-> Eq ClientDeletedConflictResolution
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ClientDeletedConflictResolution
-> ClientDeletedConflictResolution -> Bool
$c/= :: ClientDeletedConflictResolution
-> ClientDeletedConflictResolution -> Bool
== :: ClientDeletedConflictResolution
-> ClientDeletedConflictResolution -> Bool
$c== :: ClientDeletedConflictResolution
-> ClientDeletedConflictResolution -> Bool
Eq, (forall x.
 ClientDeletedConflictResolution
 -> Rep ClientDeletedConflictResolution x)
-> (forall x.
    Rep ClientDeletedConflictResolution x
    -> ClientDeletedConflictResolution)
-> Generic ClientDeletedConflictResolution
forall x.
Rep ClientDeletedConflictResolution x
-> ClientDeletedConflictResolution
forall x.
ClientDeletedConflictResolution
-> Rep ClientDeletedConflictResolution x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ClientDeletedConflictResolution x
-> ClientDeletedConflictResolution
$cfrom :: forall x.
ClientDeletedConflictResolution
-> Rep ClientDeletedConflictResolution x
Generic)

data ServerDeletedConflictResolution
  = KeepLocalChange
  | Delete
  deriving (Int -> ServerDeletedConflictResolution -> ShowS
[ServerDeletedConflictResolution] -> ShowS
ServerDeletedConflictResolution -> String
(Int -> ServerDeletedConflictResolution -> ShowS)
-> (ServerDeletedConflictResolution -> String)
-> ([ServerDeletedConflictResolution] -> ShowS)
-> Show ServerDeletedConflictResolution
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ServerDeletedConflictResolution] -> ShowS
$cshowList :: [ServerDeletedConflictResolution] -> ShowS
show :: ServerDeletedConflictResolution -> String
$cshow :: ServerDeletedConflictResolution -> String
showsPrec :: Int -> ServerDeletedConflictResolution -> ShowS
$cshowsPrec :: Int -> ServerDeletedConflictResolution -> ShowS
Show, ServerDeletedConflictResolution
-> ServerDeletedConflictResolution -> Bool
(ServerDeletedConflictResolution
 -> ServerDeletedConflictResolution -> Bool)
-> (ServerDeletedConflictResolution
    -> ServerDeletedConflictResolution -> Bool)
-> Eq ServerDeletedConflictResolution
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ServerDeletedConflictResolution
-> ServerDeletedConflictResolution -> Bool
$c/= :: ServerDeletedConflictResolution
-> ServerDeletedConflictResolution -> Bool
== :: ServerDeletedConflictResolution
-> ServerDeletedConflictResolution -> Bool
$c== :: ServerDeletedConflictResolution
-> ServerDeletedConflictResolution -> Bool
Eq, (forall x.
 ServerDeletedConflictResolution
 -> Rep ServerDeletedConflictResolution x)
-> (forall x.
    Rep ServerDeletedConflictResolution x
    -> ServerDeletedConflictResolution)
-> Generic ServerDeletedConflictResolution
forall x.
Rep ServerDeletedConflictResolution x
-> ServerDeletedConflictResolution
forall x.
ServerDeletedConflictResolution
-> Rep ServerDeletedConflictResolution x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ServerDeletedConflictResolution x
-> ServerDeletedConflictResolution
$cfrom :: forall x.
ServerDeletedConflictResolution
-> Rep ServerDeletedConflictResolution x
Generic)

-- | Resolve an 'ItemMergeResult' using a given merge strategy.
--
-- This function ignores 'MergeMismatch' and will just return the original 'ClientItem' in that case.
--
-- In order for clients to converge on the same item correctly, this function must be:
--
-- * Associative
-- * Idempotent
-- * The same on all clients
mergeUsingStrategy :: ItemMergeStrategy a -> ClientItem a -> ItemMergeResult a -> ClientItem a
mergeUsingStrategy :: ItemMergeStrategy a
-> ClientItem a -> ItemMergeResult a -> ClientItem a
mergeUsingStrategy ItemMergeStrategy {a -> ServerDeletedConflictResolution
a -> ClientDeletedConflictResolution
a -> a -> ChangeConflictResolution a
itemMergeStrategyMergeServerDeletedConflict :: a -> ServerDeletedConflictResolution
itemMergeStrategyMergeClientDeletedConflict :: a -> ClientDeletedConflictResolution
itemMergeStrategyMergeChangeConflict :: a -> a -> ChangeConflictResolution a
itemMergeStrategyMergeServerDeletedConflict :: forall a.
ItemMergeStrategy a -> a -> ServerDeletedConflictResolution
itemMergeStrategyMergeClientDeletedConflict :: forall a.
ItemMergeStrategy a -> a -> ClientDeletedConflictResolution
itemMergeStrategyMergeChangeConflict :: forall a.
ItemMergeStrategy a -> a -> a -> ChangeConflictResolution a
..} ClientItem a
ci ItemMergeResult a
mr =
  case ItemMergeResult a
mr of
    MergeSuccess ClientItem a
ci' -> ClientItem a
ci'
    MergeConflict a
a1 Timed a
ri -> (a -> a -> ChangeConflictResolution a)
-> ClientItem a -> a -> Timed a -> ClientItem a
forall a.
(a -> a -> ChangeConflictResolution a)
-> ClientItem a -> a -> Timed a -> ClientItem a
mergeChangeConflict a -> a -> ChangeConflictResolution a
itemMergeStrategyMergeChangeConflict ClientItem a
ci a
a1 Timed a
ri
    MergeConflictClientDeleted Timed a
ri -> (a -> ClientDeletedConflictResolution)
-> ClientItem a -> Timed a -> ClientItem a
forall a.
(a -> ClientDeletedConflictResolution)
-> ClientItem a -> Timed a -> ClientItem a
mergeClientDeletedConflict a -> ClientDeletedConflictResolution
itemMergeStrategyMergeClientDeletedConflict ClientItem a
ci Timed a
ri
    MergeConflictServerDeleted a
ca -> (a -> ServerDeletedConflictResolution)
-> ClientItem a -> a -> ClientItem a
forall a.
(a -> ServerDeletedConflictResolution)
-> ClientItem a -> a -> ClientItem a
mergeServerDeletedConflict a -> ServerDeletedConflictResolution
itemMergeStrategyMergeServerDeletedConflict ClientItem a
ci a
ca
    ItemMergeResult a
MergeMismatch -> ClientItem a
ci

mergeChangeConflict :: (a -> a -> ChangeConflictResolution a) -> ClientItem a -> a -> Timed a -> ClientItem a
mergeChangeConflict :: (a -> a -> ChangeConflictResolution a)
-> ClientItem a -> a -> Timed a -> ClientItem a
mergeChangeConflict a -> a -> ChangeConflictResolution a
func ClientItem a
ci a
a1 ri :: Timed a
ri@(Timed a
a2 ServerTime
st) = case a -> a -> ChangeConflictResolution a
func a
a1 a
a2 of
  ChangeConflictResolution a
KeepLocal -> ClientItem a
ci
  ChangeConflictResolution a
TakeRemote -> Timed a -> ClientItem a
forall a. Timed a -> ClientItem a
ClientItemSynced Timed a
ri
  Merged a
ma -> Timed a -> ClientItem a
forall a. Timed a -> ClientItem a
ClientItemSynced (Timed a -> ClientItem a) -> Timed a -> ClientItem a
forall a b. (a -> b) -> a -> b
$ a -> ServerTime -> Timed a
forall a. a -> ServerTime -> Timed a
Timed a
ma ServerTime
st

mergeClientDeletedConflict :: (a -> ClientDeletedConflictResolution) -> ClientItem a -> Timed a -> ClientItem a
mergeClientDeletedConflict :: (a -> ClientDeletedConflictResolution)
-> ClientItem a -> Timed a -> ClientItem a
mergeClientDeletedConflict a -> ClientDeletedConflictResolution
func ClientItem a
ci ri :: Timed a
ri@(Timed a
sa ServerTime
_) = case a -> ClientDeletedConflictResolution
func a
sa of
  ClientDeletedConflictResolution
TakeRemoteChange -> Timed a -> ClientItem a
forall a. Timed a -> ClientItem a
ClientItemSynced Timed a
ri
  ClientDeletedConflictResolution
StayDeleted -> ClientItem a
ci -- We can't just use 'ClientEmpty' here because otherwise the 'mergeUsingStrategy' wouldn't be idempotent anymore.

mergeServerDeletedConflict :: (a -> ServerDeletedConflictResolution) -> ClientItem a -> a -> ClientItem a
mergeServerDeletedConflict :: (a -> ServerDeletedConflictResolution)
-> ClientItem a -> a -> ClientItem a
mergeServerDeletedConflict a -> ServerDeletedConflictResolution
func ClientItem a
ci a
ca = case a -> ServerDeletedConflictResolution
func a
ca of
  ServerDeletedConflictResolution
KeepLocalChange -> ClientItem a
ci -- We can't just use 'ClientAdded ca' here because otherwise the 'mergeUsingStrategy' wouldn't be idempotent anymore.
  ServerDeletedConflictResolution
Delete -> ClientItem a
forall a. ClientItem a
ClientEmpty

-- | Resolve an 'ItemMergeResult' by taking whatever the server gave the client.
--
-- Pro: Clients will converge on the same value.
--
-- __Con: Conflicting updates will be lost.__
mergeFromServer :: ClientItem a -> ItemMergeResult a -> ClientItem a
mergeFromServer :: ClientItem a -> ItemMergeResult a -> ClientItem a
mergeFromServer =
  ItemMergeStrategy a
-> ClientItem a -> ItemMergeResult a -> ClientItem a
forall a.
ItemMergeStrategy a
-> ClientItem a -> ItemMergeResult a -> ClientItem a
mergeUsingStrategy ItemMergeStrategy a
forall a. ItemMergeStrategy a
mergeFromServerStrategy

-- | A merge strategy that takes whatever the server gave the client.
--
-- Pro: Clients will converge on the same value.
--
-- __Con: Conflicting updates will be lost.__
mergeFromServerStrategy :: ItemMergeStrategy a
mergeFromServerStrategy :: ItemMergeStrategy a
mergeFromServerStrategy =
  ItemMergeStrategy :: forall a.
(a -> a -> ChangeConflictResolution a)
-> (a -> ClientDeletedConflictResolution)
-> (a -> ServerDeletedConflictResolution)
-> ItemMergeStrategy a
ItemMergeStrategy
    { itemMergeStrategyMergeChangeConflict :: a -> a -> ChangeConflictResolution a
itemMergeStrategyMergeChangeConflict = \a
_ a
_ -> ChangeConflictResolution a
forall a. ChangeConflictResolution a
TakeRemote,
      itemMergeStrategyMergeClientDeletedConflict :: a -> ClientDeletedConflictResolution
itemMergeStrategyMergeClientDeletedConflict = \a
_ -> ClientDeletedConflictResolution
TakeRemoteChange,
      itemMergeStrategyMergeServerDeletedConflict :: a -> ServerDeletedConflictResolution
itemMergeStrategyMergeServerDeletedConflict = \a
_ -> ServerDeletedConflictResolution
Delete
    }

-- | Resolve an 'ItemMergeResult' by keeping whatever the client had.
--
-- Pro: does not lose data
--
-- __Con: Clients will diverge when a conflict occurs__
mergeFromClient :: ClientItem a -> ItemMergeResult a -> ClientItem a
mergeFromClient :: ClientItem a -> ItemMergeResult a -> ClientItem a
mergeFromClient = ItemMergeStrategy a
-> ClientItem a -> ItemMergeResult a -> ClientItem a
forall a.
ItemMergeStrategy a
-> ClientItem a -> ItemMergeResult a -> ClientItem a
mergeUsingStrategy ItemMergeStrategy a
forall a. ItemMergeStrategy a
mergeFromClientStrategy

-- | A merge strategy that keeps whatever the client had.
--
-- Pro: does not lose data
--
-- __Con: Clients will diverge when a conflict occurs__
mergeFromClientStrategy :: ItemMergeStrategy a
mergeFromClientStrategy :: ItemMergeStrategy a
mergeFromClientStrategy =
  ItemMergeStrategy :: forall a.
(a -> a -> ChangeConflictResolution a)
-> (a -> ClientDeletedConflictResolution)
-> (a -> ServerDeletedConflictResolution)
-> ItemMergeStrategy a
ItemMergeStrategy
    { itemMergeStrategyMergeChangeConflict :: a -> a -> ChangeConflictResolution a
itemMergeStrategyMergeChangeConflict = \a
_ a
_ -> ChangeConflictResolution a
forall a. ChangeConflictResolution a
KeepLocal,
      itemMergeStrategyMergeClientDeletedConflict :: a -> ClientDeletedConflictResolution
itemMergeStrategyMergeClientDeletedConflict = \a
_ -> ClientDeletedConflictResolution
StayDeleted,
      itemMergeStrategyMergeServerDeletedConflict :: a -> ServerDeletedConflictResolution
itemMergeStrategyMergeServerDeletedConflict = \a
_ -> ServerDeletedConflictResolution
KeepLocalChange
    }

mergeUsingCRDT :: (a -> a -> a) -> ClientItem a -> ItemMergeResult a -> ClientItem a
mergeUsingCRDT :: (a -> a -> a) -> ClientItem a -> ItemMergeResult a -> ClientItem a
mergeUsingCRDT = ItemMergeStrategy a
-> ClientItem a -> ItemMergeResult a -> ClientItem a
forall a.
ItemMergeStrategy a
-> ClientItem a -> ItemMergeResult a -> ClientItem a
mergeUsingStrategy (ItemMergeStrategy a
 -> ClientItem a -> ItemMergeResult a -> ClientItem a)
-> ((a -> a -> a) -> ItemMergeStrategy a)
-> (a -> a -> a)
-> ClientItem a
-> ItemMergeResult a
-> ClientItem a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> a -> a) -> ItemMergeStrategy a
forall a. (a -> a -> a) -> ItemMergeStrategy a
mergeUsingCRDTStrategy

-- | A merge strategy that uses a CRDT merging function to merge items.
--
-- In case of other-than-change conflicts, this will be the same as the 'mergeFromServerStrategy' strategy.
-- If this is not what you want, create your own 'ItemMergeStrategy' manually.
mergeUsingCRDTStrategy :: (a -> a -> a) -> ItemMergeStrategy a
mergeUsingCRDTStrategy :: (a -> a -> a) -> ItemMergeStrategy a
mergeUsingCRDTStrategy a -> a -> a
merge =
  ItemMergeStrategy a
forall a. ItemMergeStrategy a
mergeFromServerStrategy
    { itemMergeStrategyMergeChangeConflict :: a -> a -> ChangeConflictResolution a
itemMergeStrategyMergeChangeConflict = \a
a1 a
a2 -> a -> ChangeConflictResolution a
forall a. a -> ChangeConflictResolution a
Merged (a -> a -> a
merge a
a1 a
a2)
    }

-- | Serve an 'ItemSyncRequest' using the current 'ServerItem', producing an 'ItemSyncResponse' and a new 'ServerItem'.
processServerItemSync :: ServerItem a -> ItemSyncRequest a -> (ItemSyncResponse a, ServerItem a)
processServerItemSync :: ServerItem a
-> ItemSyncRequest a -> (ItemSyncResponse a, ServerItem a)
processServerItemSync ServerItem a
store ItemSyncRequest a
sr =
  case ServerItem a
store of
    ServerItem a
ServerEmpty ->
      let t :: ServerTime
t = ServerTime
initialServerTime
       in case ItemSyncRequest a
sr of
            ItemSyncRequest a
ItemSyncRequestPoll -> (ItemSyncResponse a
forall a. ItemSyncResponse a
ItemSyncResponseInSyncEmpty, ServerItem a
store)
            ItemSyncRequestNew a
ci ->
              (ServerTime -> ItemSyncResponse a
forall a. ServerTime -> ItemSyncResponse a
ItemSyncResponseClientAdded ServerTime
t, Timed a -> ServerItem a
forall a. Timed a -> ServerItem a
ServerFull (Timed a -> ServerItem a) -> Timed a -> ServerItem a
forall a b. (a -> b) -> a -> b
$ Timed :: forall a. a -> ServerTime -> Timed a
Timed {timedValue :: a
timedValue = a
ci, timedTime :: ServerTime
timedTime = ServerTime
t})
            ItemSyncRequestKnown ServerTime
_ ->
              -- This indicates that the server synced with another client and was told to
              -- delete its item.
              --
              -- Given that the client indicates that it did not change anything locally,
              -- the server will just instruct the client to delete its item too.
              -- No conflict here.
              (ItemSyncResponse a
forall a. ItemSyncResponse a
ItemSyncResponseServerDeleted, ServerItem a
store)
            ItemSyncRequestKnownButChanged Timed a
_ ->
              -- This indicates that the server synced with another client and was told to
              -- delete its item.
              --
              -- Given that the client indicates that it *did* change its item locally,
              -- there is a conflict.
              (ItemSyncResponse a
forall a. ItemSyncResponse a
ItemSyncResponseConflictServerDeleted, ServerItem a
store)
            ItemSyncRequestDeletedLocally ServerTime
_ ->
              -- This means that the server synced with another client,
              -- was instructed to delete its item by that client,
              -- and is now being told to delete its item again.
              --
              -- That's fine, it will just remain deleted.
              -- No conflict here
              (ItemSyncResponse a
forall a. ItemSyncResponse a
ItemSyncResponseClientDeleted, ServerItem a
store)
    ServerFull t :: Timed a
t@(Timed a
si ServerTime
st) ->
      let st' :: ServerTime
st' = ServerTime -> ServerTime
incrementServerTime ServerTime
st
       in case ItemSyncRequest a
sr of
            ItemSyncRequest a
ItemSyncRequestPoll ->
              -- The client is empty but the server is not.
              -- This means that the server has synced with another client before,
              -- so we can just send the item to the client.
              (Timed a -> ItemSyncResponse a
forall a. Timed a -> ItemSyncResponse a
ItemSyncResponseServerAdded (Timed :: forall a. a -> ServerTime -> Timed a
Timed {timedValue :: a
timedValue = a
si, timedTime :: ServerTime
timedTime = ServerTime
st}), ServerItem a
store)
            ItemSyncRequestNew a
_ ->
              -- The client has a newly added item, so it thought it was empty before that,
              -- but the server has already synced with another client before.
              -- This indicates a conflict.
              -- The server is always right, so the item at the server will remain unmodified.
              -- The client will receive the conflict.
              (Timed a -> ItemSyncResponse a
forall a. Timed a -> ItemSyncResponse a
ItemSyncResponseConflict Timed a
t, ServerItem a
store)
            ItemSyncRequestKnown ServerTime
ct ->
              if ServerTime
ct ServerTime -> ServerTime -> Bool
forall a. Ord a => a -> a -> Bool
>= ServerTime
st
                then -- The client time is equal to the server time.
                -- The client indicates that the item was not modified at their side.
                -- This means that the items are in sync.
                -- (Unless the server somehow modified the item but not its server time,
                -- which would beconsidered a bug.)
                  (ItemSyncResponse a
forall a. ItemSyncResponse a
ItemSyncResponseInSyncFull, ServerItem a
store)
                else -- The client time is less than the server time
                -- That means that the server has synced with another client in the meantime.
                -- Since the client indicates that the item was not modified at their side,
                -- we can just send it back to the client to have them update their version.
                -- No conflict here.

                  ( Timed a -> ItemSyncResponse a
forall a. Timed a -> ItemSyncResponse a
ItemSyncResponseServerChanged (Timed :: forall a. a -> ServerTime -> Timed a
Timed {timedValue :: a
timedValue = a
si, timedTime :: ServerTime
timedTime = ServerTime
st}),
                    ServerItem a
store
                  )
            ItemSyncRequestKnownButChanged Timed {timedValue :: forall a. Timed a -> a
timedValue = a
ci, timedTime :: forall a. Timed a -> ServerTime
timedTime = ServerTime
ct} ->
              if ServerTime
ct ServerTime -> ServerTime -> Bool
forall a. Ord a => a -> a -> Bool
>= ServerTime
st
                then -- The client time is equal to the server time.
                -- The client indicates that the item *was* modified at their side.
                -- This means that the server needs to be updated.

                  ( ServerTime -> ItemSyncResponse a
forall a. ServerTime -> ItemSyncResponse a
ItemSyncResponseClientChanged ServerTime
st',
                    Timed a -> ServerItem a
forall a. Timed a -> ServerItem a
ServerFull (Timed :: forall a. a -> ServerTime -> Timed a
Timed {timedValue :: a
timedValue = a
ci, timedTime :: ServerTime
timedTime = ServerTime
st'})
                  )
                else -- The client time is less than the server time
                -- That means that the server has synced with another client in the meantime.
                -- Since the client indicates that the item *was* modified at their side,
                -- there is a conflict.
                  (Timed a -> ItemSyncResponse a
forall a. Timed a -> ItemSyncResponse a
ItemSyncResponseConflict Timed a
t, ServerItem a
store)
            ItemSyncRequestDeletedLocally ServerTime
ct ->
              if ServerTime
ct ServerTime -> ServerTime -> Bool
forall a. Ord a => a -> a -> Bool
>= ServerTime
st
                then -- The client time is equal to the server time.
                -- The client indicates that the item was deleted on their side.
                -- This means that the server item needs to be deleted as well.
                  (ItemSyncResponse a
forall a. ItemSyncResponse a
ItemSyncResponseClientDeleted, ServerItem a
forall a. ServerItem a
ServerEmpty)
                else -- The client time is less than the server time
                -- That means that the server has synced with another client in the meantime.
                -- Since the client indicates that the item was deleted at their side,
                -- there is a conflict.
                  (Timed a -> ItemSyncResponse a
forall a. Timed a -> ItemSyncResponse a
ItemSyncResponseConflictClientDeleted Timed a
t, ServerItem a
store)