{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Data.Mergeless.Item where
import Control.DeepSeq
import Data.Aeson
import Data.Validity
import Data.Validity.Containers ()
import GHC.Generics (Generic)
{-# ANN module ("HLint: ignore Use lambda-case" :: String) #-}
data ClientItem a
= ClientEmpty
| ClientAdded !a
| ClientSynced !a
| ClientDeleted
deriving (Show, Eq, Ord, Generic)
instance Validity a => Validity (ClientItem a)
instance NFData a => NFData (ClientItem a)
instance FromJSON a => FromJSON (ClientItem a)
instance ToJSON a => ToJSON (ClientItem a)
data ItemSyncRequest a
= ItemSyncRequestPoll
| ItemSyncRequestNew a
| ItemSyncRequestKnown
| ItemSyncRequestDeleted
deriving (Show, Eq, Ord, Generic)
instance Validity a => Validity (ItemSyncRequest a)
instance NFData a => NFData (ItemSyncRequest a)
instance FromJSON a => FromJSON (ItemSyncRequest a)
instance ToJSON a => ToJSON (ItemSyncRequest a)
makeItemSyncRequest :: ClientItem a -> ItemSyncRequest a
makeItemSyncRequest ci =
case ci of
ClientEmpty -> ItemSyncRequestPoll
ClientAdded a -> ItemSyncRequestNew a
ClientSynced _ -> ItemSyncRequestKnown
ClientDeleted -> ItemSyncRequestDeleted
data ItemSyncResponse a
= ItemSyncResponseInSyncEmpty
| ItemSyncResponseInSyncFull
| ItemSyncResponseClientAdded
| ItemSyncResponseClientDeleted
| ItemSyncResponseServerAdded !a
| ItemSyncResponseServerDeleted
deriving (Show, Eq, Ord, Generic)
instance Validity a => Validity (ItemSyncResponse a)
instance NFData a => NFData (ItemSyncResponse a)
instance FromJSON a => FromJSON (ItemSyncResponse a)
instance ToJSON a => ToJSON (ItemSyncResponse a)
mergeItemSyncResponse :: ClientItem a -> ItemSyncResponse a -> ClientItem a
mergeItemSyncResponse ci sr =
let mismatch = ci
in case ci of
ClientEmpty ->
case sr of
ItemSyncResponseInSyncEmpty -> ClientEmpty
ItemSyncResponseServerAdded s -> ClientSynced s
_ -> mismatch
ClientAdded a ->
case sr of
ItemSyncResponseClientAdded -> ClientSynced a
ItemSyncResponseServerAdded s -> ClientSynced s
_ -> mismatch
ClientSynced _ ->
case sr of
ItemSyncResponseInSyncFull -> ci
ItemSyncResponseServerDeleted -> ClientEmpty
_ -> mismatch
ClientDeleted ->
case sr of
ItemSyncResponseClientDeleted -> ClientEmpty
_ -> mismatch
data ServerItem a
= ServerItemEmpty
| ServerItemFull !a
deriving (Show, Eq, Ord, Generic)
instance Validity a => Validity (ServerItem a)
instance NFData a => NFData (ServerItem a)
instance FromJSON a => FromJSON (ServerItem a)
instance ToJSON a => ToJSON (ServerItem a)
processServerItemSync :: ServerItem a -> ItemSyncRequest a -> (ItemSyncResponse a, ServerItem a)
processServerItemSync si sr =
case si of
ServerItemEmpty ->
case sr of
ItemSyncRequestPoll ->
(ItemSyncResponseInSyncEmpty, si)
ItemSyncRequestNew a ->
(ItemSyncResponseClientAdded, ServerItemFull a)
ItemSyncRequestKnown ->
(ItemSyncResponseServerDeleted, si)
ItemSyncRequestDeleted ->
(ItemSyncResponseClientDeleted, si)
ServerItemFull s ->
case sr of
ItemSyncRequestPoll ->
(ItemSyncResponseServerAdded s, si)
ItemSyncRequestNew _ ->
(ItemSyncResponseServerAdded s, si)
ItemSyncRequestKnown -> (ItemSyncResponseInSyncFull, si)
ItemSyncRequestDeleted -> (ItemSyncResponseClientDeleted, ServerItemEmpty)