Timed.hs

{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}

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

import Control.DeepSeq
import Data.Aeson as JSON
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
      { unServerTime :: Word64
      }
  deriving (Show, Eq, Ord, Generic, ToJSON, FromJSON)

instance Validity ServerTime

instance NFData ServerTime

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

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

-- | A value along with a server time.
data Timed a
  = Timed
      { timedValue :: !a,
        timedTime :: !ServerTime
      }
  deriving (Show, Eq, Generic)

instance Validity a => Validity (Timed a)

instance NFData a => NFData (Timed a)

instance FromJSON a => FromJSON (Timed a) where
  parseJSON = withObject "Timed" $ \o -> Timed <$> o .: "value" <*> o .: "time"

instance ToJSON a => ToJSON (Timed a) where
  toJSON Timed {..} = object ["value" .= timedValue, "time" .= timedTime]