-----------------------------------------------------------------------------
-- |
-- Module      :  ForSyDe.Atom.MoC.TimeStamp
-- Copyright   :  (c) George Ungureanu, KTH/ICT/ESY 2016
-- License     :  BSD-style (see the file LICENSE)
-- 
-- Maintainer  :  ugeorge@kth.se
-- Stability   :  experimental
-- Portability :  portable
--
-- This module implements a timestamp data type, based on
-- "Data.Time.Clock". 
-----------------------------------------------------------------------------

module ForSyDe.Atom.MoC.TimeStamp where

import Data.Time.Clock ( DiffTime
                       , secondsToDiffTime
                       , picosecondsToDiffTime
                       )

-- | Alias for the type representing discrete time. It is inherently
-- quantizable, the quantum being a picosecond ( \(10^{-12}\)
-- seconds), thus it can be considered order-isomorphic with a set of
-- integers, i.e. between any two timestamps there is a finite number
-- of timestamps. Moreover, a timestamp can be easily translated into
-- a rational number representing fractions of a second, so the
-- conversion between timestamps (discrete time) and rationals
-- (analog/continuous time) is straightforward.
--
-- This type is used in the explicit tags of the
-- 'ForSyDe.Atom.MoC.DE.DE' MoC (and subsequently the discrete event
-- evaluation engine for simulating the 'ForSyDe.Atom.MoC.CT.CT' MoC).
type TimeStamp = DiffTime

-- | Specifies a timestamp in terms of picoseconds.
picosec  :: Integer -> TimeStamp
picosec :: Integer -> TimeStamp
picosec  = Integer -> TimeStamp
picosecondsToDiffTime

-- | Specifies a timestamp in terms of nanoseconds.
nanosec  :: Integer -> TimeStamp
nanosec :: Integer -> TimeStamp
nanosec  = Integer -> TimeStamp
picosecondsToDiffTime (Integer -> TimeStamp)
-> (Integer -> Integer) -> Integer -> TimeStamp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
*1000)

-- | Specifies a timestamp in terms of microseconds.
microsec :: Integer -> TimeStamp
microsec :: Integer -> TimeStamp
microsec = Integer -> TimeStamp
picosecondsToDiffTime (Integer -> TimeStamp)
-> (Integer -> Integer) -> Integer -> TimeStamp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
*1000000)

-- | Specifies a timestamp in terms of miliseconds.
milisec  :: Integer -> TimeStamp
milisec :: Integer -> TimeStamp
milisec  = Integer -> TimeStamp
picosecondsToDiffTime (Integer -> TimeStamp)
-> (Integer -> Integer) -> Integer -> TimeStamp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
*1000000000)

-- | Specifies a timestamp in terms of seconds.
sec      :: Integer -> TimeStamp
sec :: Integer -> TimeStamp
sec      = Integer -> TimeStamp
secondsToDiffTime

-- | Specifies a timestamp in terms of minutes.
minutes  :: Integer -> TimeStamp
minutes :: Integer -> TimeStamp
minutes  = Integer -> TimeStamp
secondsToDiffTime (Integer -> TimeStamp)
-> (Integer -> Integer) -> Integer -> TimeStamp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
*60) 

-- | Specifies a timestamp in terms of hours.
hours    :: Integer -> TimeStamp
hours :: Integer -> TimeStamp
hours    = Integer -> TimeStamp
secondsToDiffTime (Integer -> TimeStamp)
-> (Integer -> Integer) -> Integer -> TimeStamp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
*3600)

-- | Converts a timestamp to a rational number, used for describing
-- continuous time.
toTime   :: TimeStamp -> Rational
toTime :: TimeStamp -> Rational
toTime   = TimeStamp -> Rational
forall a. Real a => a -> Rational
toRational

-- | 'TimeStamp' representation of the number π. Converted from
-- the "Prelude" equivalent, which is 'Floating'.
pi :: TimeStamp 
pi :: TimeStamp
pi  = Double -> TimeStamp
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
forall a. Floating a => a
Prelude.pi


-- | reads @[n]s@ as a fraction of a second, where @[n]@ is a floating
-- point number.
instance Read DiffTime where
  readsPrec :: Int -> ReadS TimeStamp
readsPrec p :: Int
p x :: String
x = [ (Double -> TimeStamp
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
tstamp,String
r)
                  | (tstamp :: Double
tstamp,r :: String
r) <- String -> [(Double, String)]
readNum String
x ] 
    where readNum ::[Char] -> [(Double, String)]
          readNum :: String -> [(Double, String)]
readNum = String -> [(Double, String)]
forall a. Read a => ReadS a
reads (String -> [(Double, String)])
-> (String -> String) -> String -> [(Double, String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/='s')