time-hourglass-0.3.0: src/Time/Epoch.hs

{-# LANGUAGE DeriveDataTypeable         #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE NumericUnderscores         #-}

{- |
Module      : Time.Epoch
License     : BSD-style
Copyright   : (c) 2014 Vincent Hanquez <vincent@snarc.org>
Stability   : experimental
Portability : unknown

Types, type classes and functions related to epochs.
-}

module Time.Epoch
  ( -- * Elapsed time from epochs
    ElapsedSince (..)
  , ElapsedSinceP (..)
    -- * Epoch
  , Epoch (..)
    -- * Commonly-encountered epochs
  , UnixEpoch (..)
  , WindowsEpoch (..)
  , MJDEpoch (..)
  ) where

import           Control.DeepSeq ( NFData (..) )
import           Data.Data ( Data )
import           Data.Ratio ( (%) )
import           Time.Time ( Time (..), Timeable (..) )
import           Time.Types
                   ( Elapsed (..), ElapsedP (..), NanoSeconds (..)
                   , Seconds (..)
                   )

-- | A type representing the number of non-leap seconds that have elapsed since
-- the specified epoch.
newtype ElapsedSince epoch = ElapsedSince Seconds
  deriving (Data, Eq, NFData, Num, Ord, Read, Show)

-- | A type representing the number of non-leap seconds and nanoseconds that
-- have elapsed since the specified epoch. The \'P\' is short for \'precise\'.
data ElapsedSinceP epoch = ElapsedSinceP
  {-# UNPACK #-} !(ElapsedSince epoch)
  {-# UNPACK #-} !NanoSeconds
  deriving (Data, Eq, Ord, Read, Show)

instance NFData (ElapsedSinceP e) where
  rnf e = e `seq` ()

instance Num (ElapsedSinceP e) where
  (ElapsedSinceP e1 ns1) + (ElapsedSinceP e2 ns2) =
    ElapsedSinceP (e1 + e2) (ns1 + ns2)

  (ElapsedSinceP e1 ns1) - (ElapsedSinceP e2 ns2) =
    ElapsedSinceP (e1 - e2) (ns1 - ns2)

  (ElapsedSinceP e1 ns1) * (ElapsedSinceP e2 ns2) =
    ElapsedSinceP (e1 * e2) (ns1 * ns2)

  negate (ElapsedSinceP e ns) = ElapsedSinceP (negate e) ns

  abs (ElapsedSinceP e ns) = ElapsedSinceP (abs e) ns

  signum (ElapsedSinceP e ns) = ElapsedSinceP (signum e) ns

  fromInteger i = ElapsedSinceP (ElapsedSince (fromIntegral i)) 0

instance Real (ElapsedSinceP e) where
  toRational (ElapsedSinceP (ElapsedSince (Seconds s)) (NanoSeconds 0)) =
    fromIntegral s

  toRational (ElapsedSinceP (ElapsedSince (Seconds s)) (NanoSeconds ns)) =
    fromIntegral s + (fromIntegral ns % 1_000_000_000)

-- | A type class promising epoch-related functionality. (Epochs, in this
-- context, are fixed points in time.)
class Epoch epoch where
  -- | The name of the epoch.
  epochName :: epoch -> String

  -- | The epoch relative to the Unix epoch (1970-01-01 00:00:00 UTC), in
  -- non-leap seconds. A negative number means the epoch is before the Unix
  -- epoch.
  epochDiffToUnix :: epoch -> Seconds

-- | A type representing the Unix epoch (the point in time represented by
-- 1970-01-01 00:00:00 UTC).
data UnixEpoch = UnixEpoch
  deriving (Eq, Show)

instance Epoch UnixEpoch where
  epochName _ = "unix"
  epochDiffToUnix _ = 0

-- | A type representing the
-- [Windows epoch](https://learn.microsoft.com/en-us/windows/win32/sysinfo/file-times),
-- (the point in time represented by 1601-01-01 00:00:00 UTC).
data WindowsEpoch = WindowsEpoch
  deriving (Eq, Show)

instance Epoch WindowsEpoch where
  epochName _ = "windows"
  epochDiffToUnix _ = -11_644_473_600

-- | A type representing the Modified Julian Date (MJD) epoch (the point in time
-- represented by 1858-11-17 00:00:00 UTC).
data MJDEpoch = MJDEpoch
  deriving (Eq, Show)

instance Epoch MJDEpoch where
  epochName _ = "Modified Julian Date"
  epochDiffToUnix _ = -3_506_716_800

instance Epoch epoch => Timeable (ElapsedSince epoch) where
  timeGetElapsedP es = ElapsedP (Elapsed e) 0
   where
    ElapsedSince e = convertEpoch es :: ElapsedSince UnixEpoch

  timeGetElapsed   es = Elapsed e
   where
    ElapsedSince e = convertEpoch es :: ElapsedSince UnixEpoch

  timeGetNanoSeconds _ = 0

instance Epoch epoch => Time (ElapsedSince epoch) where
  timeFromElapsedP (ElapsedP (Elapsed e) _) =
    convertEpoch (ElapsedSince e :: ElapsedSince UnixEpoch)

instance Epoch epoch => Timeable (ElapsedSinceP epoch) where
  timeGetElapsedP es = ElapsedP (Elapsed e) ns
   where
    ElapsedSinceP (ElapsedSince e) ns =
      convertEpochP es :: ElapsedSinceP UnixEpoch

  timeGetNanoSeconds (ElapsedSinceP _ ns) = ns

instance Epoch epoch => Time (ElapsedSinceP epoch) where
  timeFromElapsedP (ElapsedP (Elapsed e) ns) =
    convertEpochP (ElapsedSinceP (ElapsedSince e) ns :: ElapsedSinceP UnixEpoch)

-- | For the given pair of epochs, convert a t'ElapsedSince' value for the first
-- epoch to the corresponding value for the second epoch.
convertEpochWith ::
     (Epoch e1, Epoch e2)
  => (e1, e2)
  -> ElapsedSince e1
  -> ElapsedSince e2
convertEpochWith (e1, e2) (ElapsedSince s1) = ElapsedSince (s1 + diff)
 where
  diff = d1 - d2
  d1 = epochDiffToUnix e1
  d2 = epochDiffToUnix e2

-- | Convert the given t'ElapsedSince' value to another t'ElapsedSince' value.
-- This will not compile unless the compiler can infer the types of the epochs.
convertEpoch :: (Epoch e1, Epoch e2) => ElapsedSince e1 -> ElapsedSince e2
convertEpoch = convertEpochWith (undefined, undefined)

-- | For the given pair of epochs, convert a t'ElapsedSinceP' value for the
-- first epoch to the corresponding value for the second epoch.
convertEpochPWith ::
     (Epoch e1, Epoch e2)
  => (e1, e2)
  -> ElapsedSinceP e1
  -> ElapsedSinceP e2
convertEpochPWith es (ElapsedSinceP e1 n1) =
  ElapsedSinceP (convertEpochWith es e1) n1

-- | Convert the given t'ElapsedSinceP' value to another t'ElapsedSinceP' value.
-- This will not compile unless the compiler can infer the types of the epochs.
convertEpochP :: (Epoch e1, Epoch e2) => ElapsedSinceP e1 -> ElapsedSinceP e2
convertEpochP = convertEpochPWith (undefined, undefined)