{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE OverloadedStrings #-}

-- | Dealing with server times.
--
-- __If you are importing this module, you are probably doing something wrong.__
module Data.Mergeful.Timed
  ( ServerTime (..),
    initialServerTime,
    incrementServerTime,
    Timed (..),
    timedObjectCodec,
  )
where

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

-- | A "time", as "measured" by the server.
--
-- This is closer to a version number than an actual timestamp, but that
-- distinction should not matter for your usage of this library.
--
-- In any case, a client should not be changing this value.
--
-- We use a 'Word64' instead of a natural.
-- This will go wrong after 2^64 versions, but since that
-- will not happen in practice, we will not worry about it.
-- You would have to sync millions of modifications every second
-- until long after the sun consumes the earth for this to be a problem.
newtype ServerTime = ServerTime
  { ServerTime -> Word64
unServerTime :: Word64
  }
  deriving stock (Int -> ServerTime -> ShowS
[ServerTime] -> ShowS
ServerTime -> String
(Int -> ServerTime -> ShowS)
-> (ServerTime -> String)
-> ([ServerTime] -> ShowS)
-> Show ServerTime
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ServerTime] -> ShowS
$cshowList :: [ServerTime] -> ShowS
show :: ServerTime -> String
$cshow :: ServerTime -> String
showsPrec :: Int -> ServerTime -> ShowS
$cshowsPrec :: Int -> ServerTime -> ShowS
Show, ServerTime -> ServerTime -> Bool
(ServerTime -> ServerTime -> Bool)
-> (ServerTime -> ServerTime -> Bool) -> Eq ServerTime
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ServerTime -> ServerTime -> Bool
$c/= :: ServerTime -> ServerTime -> Bool
== :: ServerTime -> ServerTime -> Bool
$c== :: ServerTime -> ServerTime -> Bool
Eq, Eq ServerTime
Eq ServerTime
-> (ServerTime -> ServerTime -> Ordering)
-> (ServerTime -> ServerTime -> Bool)
-> (ServerTime -> ServerTime -> Bool)
-> (ServerTime -> ServerTime -> Bool)
-> (ServerTime -> ServerTime -> Bool)
-> (ServerTime -> ServerTime -> ServerTime)
-> (ServerTime -> ServerTime -> ServerTime)
-> Ord ServerTime
ServerTime -> ServerTime -> Bool
ServerTime -> ServerTime -> Ordering
ServerTime -> ServerTime -> ServerTime
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ServerTime -> ServerTime -> ServerTime
$cmin :: ServerTime -> ServerTime -> ServerTime
max :: ServerTime -> ServerTime -> ServerTime
$cmax :: ServerTime -> ServerTime -> ServerTime
>= :: ServerTime -> ServerTime -> Bool
$c>= :: ServerTime -> ServerTime -> Bool
> :: ServerTime -> ServerTime -> Bool
$c> :: ServerTime -> ServerTime -> Bool
<= :: ServerTime -> ServerTime -> Bool
$c<= :: ServerTime -> ServerTime -> Bool
< :: ServerTime -> ServerTime -> Bool
$c< :: ServerTime -> ServerTime -> Bool
compare :: ServerTime -> ServerTime -> Ordering
$ccompare :: ServerTime -> ServerTime -> Ordering
$cp1Ord :: Eq ServerTime
Ord, (forall x. ServerTime -> Rep ServerTime x)
-> (forall x. Rep ServerTime x -> ServerTime) -> Generic ServerTime
forall x. Rep ServerTime x -> ServerTime
forall x. ServerTime -> Rep ServerTime x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ServerTime x -> ServerTime
$cfrom :: forall x. ServerTime -> Rep ServerTime x
Generic)
  deriving (Value -> Parser [ServerTime]
Value -> Parser ServerTime
(Value -> Parser ServerTime)
-> (Value -> Parser [ServerTime]) -> FromJSON ServerTime
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [ServerTime]
$cparseJSONList :: Value -> Parser [ServerTime]
parseJSON :: Value -> Parser ServerTime
$cparseJSON :: Value -> Parser ServerTime
FromJSON, [ServerTime] -> Encoding
[ServerTime] -> Value
ServerTime -> Encoding
ServerTime -> Value
(ServerTime -> Value)
-> (ServerTime -> Encoding)
-> ([ServerTime] -> Value)
-> ([ServerTime] -> Encoding)
-> ToJSON ServerTime
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [ServerTime] -> Encoding
$ctoEncodingList :: [ServerTime] -> Encoding
toJSONList :: [ServerTime] -> Value
$ctoJSONList :: [ServerTime] -> Value
toEncoding :: ServerTime -> Encoding
$ctoEncoding :: ServerTime -> Encoding
toJSON :: ServerTime -> Value
$ctoJSON :: ServerTime -> Value
ToJSON) via (Autodocodec ServerTime)

instance Validity ServerTime

instance NFData ServerTime

instance HasCodec ServerTime where
  codec :: JSONCodec ServerTime
codec = (Word64 -> ServerTime)
-> (ServerTime -> Word64)
-> Codec Value Word64 Word64
-> JSONCodec ServerTime
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec Word64 -> ServerTime
ServerTime ServerTime -> Word64
unServerTime Codec Value Word64 Word64
forall value. HasCodec value => JSONCodec value
codec JSONCodec ServerTime -> Text -> JSONCodec ServerTime
forall input output.
ValueCodec input output -> Text -> ValueCodec input output
<?> Text
"Server time"

-- | A server time to start with.
initialServerTime :: ServerTime
initialServerTime :: ServerTime
initialServerTime = Word64 -> ServerTime
ServerTime Word64
0

-- | Increment a server time.
incrementServerTime :: ServerTime -> ServerTime
incrementServerTime :: ServerTime -> ServerTime
incrementServerTime (ServerTime Word64
w) = Word64 -> ServerTime
ServerTime (Word64 -> Word64
forall a. Enum a => a -> a
succ Word64
w)

-- | A value along with a server time.
data Timed a = Timed
  { Timed a -> a
timedValue :: !a,
    Timed a -> ServerTime
timedTime :: !ServerTime
  }
  deriving stock (Int -> Timed a -> ShowS
[Timed a] -> ShowS
Timed a -> String
(Int -> Timed a -> ShowS)
-> (Timed a -> String) -> ([Timed a] -> ShowS) -> Show (Timed a)
forall a. Show a => Int -> Timed a -> ShowS
forall a. Show a => [Timed a] -> ShowS
forall a. Show a => Timed a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Timed a] -> ShowS
$cshowList :: forall a. Show a => [Timed a] -> ShowS
show :: Timed a -> String
$cshow :: forall a. Show a => Timed a -> String
showsPrec :: Int -> Timed a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Timed a -> ShowS
Show, Timed a -> Timed a -> Bool
(Timed a -> Timed a -> Bool)
-> (Timed a -> Timed a -> Bool) -> Eq (Timed a)
forall a. Eq a => Timed a -> Timed a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Timed a -> Timed a -> Bool
$c/= :: forall a. Eq a => Timed a -> Timed a -> Bool
== :: Timed a -> Timed a -> Bool
$c== :: forall a. Eq a => Timed a -> Timed a -> Bool
Eq, (forall x. Timed a -> Rep (Timed a) x)
-> (forall x. Rep (Timed a) x -> Timed a) -> Generic (Timed a)
forall x. Rep (Timed a) x -> Timed a
forall x. Timed a -> Rep (Timed a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Timed a) x -> Timed a
forall a x. Timed a -> Rep (Timed a) x
$cto :: forall a x. Rep (Timed a) x -> Timed a
$cfrom :: forall a x. Timed a -> Rep (Timed a) x
Generic)
  deriving (Value -> Parser [Timed a]
Value -> Parser (Timed a)
(Value -> Parser (Timed a))
-> (Value -> Parser [Timed a]) -> FromJSON (Timed a)
forall a. HasCodec a => Value -> Parser [Timed a]
forall a. HasCodec a => Value -> Parser (Timed a)
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Timed a]
$cparseJSONList :: forall a. HasCodec a => Value -> Parser [Timed a]
parseJSON :: Value -> Parser (Timed a)
$cparseJSON :: forall a. HasCodec a => Value -> Parser (Timed a)
FromJSON, [Timed a] -> Encoding
[Timed a] -> Value
Timed a -> Encoding
Timed a -> Value
(Timed a -> Value)
-> (Timed a -> Encoding)
-> ([Timed a] -> Value)
-> ([Timed a] -> Encoding)
-> ToJSON (Timed a)
forall a. HasCodec a => [Timed a] -> Encoding
forall a. HasCodec a => [Timed a] -> Value
forall a. HasCodec a => Timed a -> Encoding
forall a. HasCodec a => Timed a -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Timed a] -> Encoding
$ctoEncodingList :: forall a. HasCodec a => [Timed a] -> Encoding
toJSONList :: [Timed a] -> Value
$ctoJSONList :: forall a. HasCodec a => [Timed a] -> Value
toEncoding :: Timed a -> Encoding
$ctoEncoding :: forall a. HasCodec a => Timed a -> Encoding
toJSON :: Timed a -> Value
$ctoJSON :: forall a. HasCodec a => Timed a -> Value
ToJSON) via (Autodocodec (Timed a))

instance Validity a => Validity (Timed a)

instance NFData a => NFData (Timed a)

instance HasCodec a => HasCodec (Timed a) where
  codec :: JSONCodec (Timed a)
codec = Text -> ObjectCodec (Timed a) (Timed a) -> JSONCodec (Timed a)
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
object Text
"Timed" ObjectCodec (Timed a) (Timed a)
forall a. HasCodec a => JSONObjectCodec (Timed a)
timedObjectCodec

timedObjectCodec :: HasCodec a => JSONObjectCodec (Timed a)
timedObjectCodec :: JSONObjectCodec (Timed a)
timedObjectCodec =
  a -> ServerTime -> Timed a
forall a. a -> ServerTime -> Timed a
Timed
    (a -> ServerTime -> Timed a)
-> Codec Object (Timed a) a
-> Codec Object (Timed a) (ServerTime -> Timed a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Text -> ObjectCodec a a
forall output.
HasCodec output =>
Text -> Text -> ObjectCodec output output
requiredField Text
"value" Text
"timed value" ObjectCodec a a -> (Timed a -> a) -> Codec Object (Timed a) a
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= Timed a -> a
forall a. Timed a -> a
timedValue
    Codec Object (Timed a) (ServerTime -> Timed a)
-> Codec Object (Timed a) ServerTime -> JSONObjectCodec (Timed a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> Text -> ObjectCodec ServerTime ServerTime
forall output.
HasCodec output =>
Text -> Text -> ObjectCodec output output
requiredField Text
"time" Text
"timed time" ObjectCodec ServerTime ServerTime
-> (Timed a -> ServerTime) -> Codec Object (Timed a) ServerTime
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= Timed a -> ServerTime
forall a. Timed a -> ServerTime
timedTime