1{-# LANGUAGE GeneralizedNewtypeDeriving #-}
2{-# LANGUAGE DeriveDataTypeable #-}
3-- |
4-- Module      : Data.Hourglass.Epoch
5-- License     : BSD-style
6-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
7-- Stability   : experimental
8-- Portability : unknown
9--
10-- Epoch tracking
11--
12module Data.Hourglass.Epoch
13    (
14    -- * computer time tracking with various epoch
15      ElapsedSince(..)
16    , ElapsedSinceP(..)
17    -- * Epoch
18    , Epoch(..)
19    -- ** standard and usual epochs
20    , UnixEpoch(..)
21    , WindowsEpoch(..)
22    ) where
23
24import Data.Data
25import Control.DeepSeq
26import Data.Hourglass.Types
27import Data.Hourglass.Time
28
29-- | A number of seconds elapsed since an epoch.
30newtype ElapsedSince epoch = ElapsedSince Seconds
31    deriving (Show,Read,Eq,Ord,Num,Data,Typeable,NFData)
32
33-- | A number of seconds and nanoseconds elapsed since an epoch.
34data ElapsedSinceP epoch = ElapsedSinceP {-# UNPACK #-} !(ElapsedSince epoch)
35                                         {-# UNPACK #-} !NanoSeconds
36    deriving (Show,Read,Eq,Ord,Data,Typeable)
37
38instance NFData (ElapsedSinceP e) where rnf e = e `seq` ()
39
40instance Num (ElapsedSinceP e) where
41    (ElapsedSinceP e1 ns1) + (ElapsedSinceP e2 ns2) = ElapsedSinceP (e1+e2) (ns1+ns2)
42    (ElapsedSinceP e1 ns1) - (ElapsedSinceP e2 ns2) = ElapsedSinceP (e1-e2) (ns1-ns2)
43    (ElapsedSinceP e1 ns1) * (ElapsedSinceP e2 ns2) = ElapsedSinceP (e1*e2) (ns1*ns2)
44    negate (ElapsedSinceP e ns) = ElapsedSinceP (negate e) ns
45    abs (ElapsedSinceP e ns)    = ElapsedSinceP (abs e) ns
46    signum (ElapsedSinceP e ns) = ElapsedSinceP (signum e) ns
47    fromInteger i          = ElapsedSinceP (ElapsedSince (fromIntegral i)) 0
48
49-- FIXME instance Real (ElapsedSinceP e)
50
51-- | epoch related.
52--
53-- We use the well known Unix epoch as the
54-- reference timezone for doing conversion between epochs.
55--
56-- Each methods of this typeclass should not use the actual value,
57-- but only get the information needed from the type itself.
58class Epoch epoch where
59    -- | The name of this epoch
60    epochName :: epoch -> String
61
62    -- | number of seconds of difference with 1st January 1970.
63    --
64    -- a negative number means that this epoch start before
65    -- the unix epoch.
66    epochDiffToUnix :: epoch -> Seconds
67
68-- | Unix Epoch, starting 1st January 1970
69data UnixEpoch = UnixEpoch
70    deriving (Show,Eq)
71
72instance Epoch UnixEpoch where
73    epochName _ = "unix"
74    epochDiffToUnix _ = 0
75
76-- | Windows Epoch, starting 1st January 1601
77data WindowsEpoch = WindowsEpoch
78    deriving (Show,Eq)
79
80instance Epoch WindowsEpoch where
81    epochName _ = "windows"
82    epochDiffToUnix _ = -11644473600
83
84instance Epoch epoch => Timeable (ElapsedSince epoch) where
85    timeGetElapsedP es = ElapsedP (Elapsed e) 0
86      where ElapsedSince e = convertEpoch es :: ElapsedSince UnixEpoch
87    timeGetElapsed   es = Elapsed e
88      where ElapsedSince e = convertEpoch es :: ElapsedSince UnixEpoch
89    timeGetNanoSeconds _ = 0
90
91instance Epoch epoch => Time (ElapsedSince epoch) where
92    timeFromElapsedP (ElapsedP (Elapsed e) _) =
93        convertEpoch (ElapsedSince e :: ElapsedSince UnixEpoch)
94
95instance Epoch epoch => Timeable (ElapsedSinceP epoch) where
96    timeGetElapsedP es = ElapsedP (Elapsed e) ns
97      where ElapsedSinceP (ElapsedSince e) ns = convertEpochP es :: ElapsedSinceP UnixEpoch
98    timeGetNanoSeconds (ElapsedSinceP _ ns) = ns
99instance Epoch epoch => Time (ElapsedSinceP epoch) where
100    timeFromElapsedP (ElapsedP (Elapsed e) ns) = convertEpochP (ElapsedSinceP (ElapsedSince e) ns :: ElapsedSinceP UnixEpoch)
101
102-- | Convert Elapsed seconds to another epoch with explicit epochs specified
103convertEpochWith :: (Epoch e1, Epoch e2) => (e1,e2) -> ElapsedSince e1 -> ElapsedSince e2
104convertEpochWith (e1,e2) (ElapsedSince s1) = ElapsedSince (s1 + diff)
105  where diff = d1 - d2
106        d1 = epochDiffToUnix e1
107        d2 = epochDiffToUnix e2
108
109-- | Convert Elapsed seconds to another epoch.
110--
111-- the actual epochs need to be known somehow by the context, otherwise this function
112-- will yield a compilation errors as the epoch are not chosen.
113--
114-- If you want to force specific epoch conversion, use convertEpochWith
115convertEpoch :: (Epoch e1, Epoch e2) => ElapsedSince e1 -> ElapsedSince e2
116convertEpoch = convertEpochWith (undefined, undefined)
117
118-- | Convert Precise Elapsed seconds to another epoch with explicit epochs specified
119convertEpochPWith :: (Epoch e1, Epoch e2) => (e1,e2) -> ElapsedSinceP e1 -> ElapsedSinceP e2
120convertEpochPWith es (ElapsedSinceP e1 n1) = ElapsedSinceP (convertEpochWith es e1) n1
121
122-- | Convert Elapsed seconds to another epoch.
123--
124-- the actual epochs need to be known somehow by the context, otherwise this function
125-- will yield a compilation errors as the epoch are not chosen.
126--
127-- If you want to force specific epoch conversion, use convertEpochWith
128convertEpochP :: (Epoch e1, Epoch e2) => ElapsedSinceP e1 -> ElapsedSinceP e2
129convertEpochP = convertEpochPWith (undefined, undefined)
130