{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-- |This module defines types for many useful time periods, as well as
-- mechanisms for converting between them.
module Data.Time.Units(
         TimeUnit(..)
       , Attosecond
       , Femtosecond
       , Picosecond
       , Nanosecond
       , Microsecond
       , Millisecond
       , Second
       , Minute
       , Hour
       , Day
       , Week
       , Fortnight
       , addTime
       , subTime
       , convertUnit
       , getCPUTimeWithUnit
       )
 where

import Data.Ix(Ix)
import Data.Data(Data)
import Data.List(isPrefixOf)
import Data.Typeable(Typeable)
import System.CPUTime

-- |A generic class that describes all the units of time. We use microseconds
-- here because that tends to be what GHC (at least) tends to use as its 
-- system-level minimum tick size.
class TimeUnit a where
  -- |Converts the given unit of time into microseconds, flooring the value
  -- if it comes to a fractional number of microseconds. (In other words:
  -- be careful, you may lose precision!)
  toMicroseconds   :: a -> Integer
  -- |Converts the given number of microseconds into the unit of time, flooring
  -- the value if it comes to a fraction number of the given unit. (In other
  -- words: be careful, you may lose precision!)
  fromMicroseconds :: Integer -> a

-- |Add two times together to get a useful third time unit. As per usual,
-- you'll want to make sure that you are careful regarding precision. This
-- function goes through microseconds as an intermediary form.
addTime :: (TimeUnit a, TimeUnit b, TimeUnit c) => a -> b -> c
addTime x y = fromMicroseconds (toMicroseconds x + toMicroseconds y)

-- |Subtract the second time from the first, to get a useful third time unit.
-- As per usual, you'll want to make sure that you are careful regarding
-- precision. This function goes through microseconds as an intermediary form.
subTime :: (TimeUnit a, TimeUnit b, TimeUnit c) => a -> b -> c
subTime x y = fromMicroseconds (toMicroseconds x - toMicroseconds y)

-- |Convert one time unit to another. Note that if you move from a smaller
-- time unit to a larger one, or between two time units smaller than a
-- microsecond, you will lose precision.
convertUnit :: (TimeUnit a, TimeUnit b) => a -> b
convertUnit = fromMicroseconds . toMicroseconds

-- |Get the current CPU time in your favorite units. This is probably not
-- very useful in itself, but is likely useful for comparison purposes ...
getCPUTimeWithUnit :: TimeUnit a => IO a
getCPUTimeWithUnit =
  (fromMicroseconds . toMicroseconds . Picosecond) `fmap` getCPUTime

--

newtype Attosecond  = Attosecond  Integer
 deriving (Enum,Eq,Integral,Data,Num,Ord,Real,Ix,Typeable)

instance TimeUnit Attosecond where
  toMicroseconds (Attosecond x) = x `div` (10 ^ 12)
  fromMicroseconds x            = Attosecond (x * (10 ^ 12))
instance Show Attosecond where
  show (Attosecond x) = show x ++ "as"
instance Read Attosecond where
  readsPrec = readUnit Attosecond "as"

readUnit :: (Integer -> a) -> String ->
            Int -> String ->
            [(a, String)]
readUnit builder unitstr prec str = processItems builder (readsPrec prec str)
 where
  processItems :: (Integer -> a) -> [(Integer,String)] -> [(a,String)]
  processItems builder  [] = []
  processItems builder ((a,s):rest)
    | unitstr `isPrefixOf` s =
           (builder a, drop (length unitstr) s) : (processItems builder rest)
        | otherwise              =
           processItems builder rest

--

newtype Femtosecond = Femtosecond Integer
 deriving (Enum,Eq,Integral,Data,Num,Ord,Real,Ix,Typeable)

instance TimeUnit Femtosecond where
  toMicroseconds (Femtosecond x) = x `div` (10 ^ 9)
  fromMicroseconds x             = Femtosecond (x * (10 ^ 9))
instance Show Femtosecond where
  show (Femtosecond x) = show x ++ "fs"
instance Read Femtosecond where
  readsPrec = readUnit Femtosecond "fs"

--

newtype Picosecond  = Picosecond  Integer
 deriving (Enum,Eq,Integral,Data,Num,Ord,Real,Ix,Typeable)

instance TimeUnit Picosecond where
  toMicroseconds (Picosecond x) = x `div` (10 ^ 6)
  fromMicroseconds x            = Picosecond (x * (10 ^ 6))
instance Show Picosecond where
  show (Picosecond x) = show x ++ "ps"
instance Read Picosecond where
  readsPrec = readUnit Picosecond "ps"

--

newtype Nanosecond  = Nanosecond  Integer
 deriving (Enum,Eq,Integral,Data,Num,Ord,Real,Ix,Typeable)

instance TimeUnit Nanosecond where
  toMicroseconds (Nanosecond x) = x `div` (10 ^ 3)
  fromMicroseconds x            = Nanosecond (x * (10 ^ 3))
instance Show Nanosecond where
  show (Nanosecond x) = show x ++ "ns"
instance Read Nanosecond where
  readsPrec = readUnit Nanosecond "ns"

--

newtype Microsecond = Microsecond Integer
 deriving (Enum,Eq,Integral,Data,Num,Ord,Real,Ix,Typeable)

instance TimeUnit Microsecond where
  toMicroseconds (Microsecond x) = x
  fromMicroseconds x             = Microsecond x
instance Show Microsecond where
  show (Microsecond x) = show x ++ "µs"
instance Read Microsecond where
  readsPrec = readUnit Microsecond "µs"

--

newtype Millisecond  = Millisecond  Integer
 deriving (Enum,Eq,Integral,Data,Num,Ord,Real,Ix,Typeable)

instance TimeUnit Millisecond where
  toMicroseconds (Millisecond x) = x * (10 ^ 3)
  fromMicroseconds x             = Millisecond (x `div` (10 ^ 3))
instance Show Millisecond where
  show (Millisecond x) = show x ++ "ms"
instance Read Millisecond where
  readsPrec = readUnit Millisecond "ms"

--

newtype Second      = Second      Integer
 deriving (Enum,Eq,Integral,Data,Num,Ord,Real,Ix,Typeable)

instance TimeUnit Second where
  toMicroseconds (Second x) = x * (10 ^ 6)
  fromMicroseconds x        = Second (x `div` (10 ^ 6))
instance Show Second where
  show (Second x) = show x ++ "s"
instance Read Second where
  readsPrec = readUnit Second "s"

--

newtype Minute      = Minute      Integer
 deriving (Enum,Eq,Integral,Data,Num,Ord,Real,Ix,Typeable)

instance TimeUnit Minute where
  toMicroseconds (Minute x) = x * (toMicroseconds $ Second 60)
  fromMicroseconds x        = Minute (x `div` (toMicroseconds $ Second 60))
instance Show Minute where
  show (Minute x) = show x ++ "m"
instance Read Minute where
  readsPrec = readUnit Minute "m"

--

newtype Hour        = Hour        Integer
 deriving (Enum,Eq,Integral,Data,Num,Ord,Real,Ix,Typeable)

instance TimeUnit Hour where
  toMicroseconds (Hour x) = x * (toMicroseconds $ Minute 60)
  fromMicroseconds x      = Hour (x `div` (toMicroseconds $ Minute 60))
instance Show Hour where
  show (Hour x) = show x ++ "h"
instance Read Hour where
  readsPrec = readUnit Hour "h"

--

newtype Day         = Day         Integer
 deriving (Enum,Eq,Integral,Data,Num,Ord,Real,Ix,Typeable)

instance TimeUnit Day where
  toMicroseconds (Day x) = x * (toMicroseconds $ Hour 24)
  fromMicroseconds x     = Day (x `div` (toMicroseconds $ Hour 24))
instance Show Day where
  show (Day x) = show x ++ "d"
instance Read Day where
  readsPrec = readUnit Day "d"

--

newtype Week        = Week        Integer
 deriving (Enum,Eq,Integral,Data,Num,Ord,Real,Ix,Typeable)

instance TimeUnit Week where
  toMicroseconds (Week x) = x * (toMicroseconds $ Day 7)
  fromMicroseconds x      = Week (x `div` (toMicroseconds $ Day 7))
instance Show Week where
  show (Week x) = show x ++ "w"
instance Read Week where
  readsPrec = readUnit Week "w"

--

newtype Fortnight   = Fortnight   Integer
 deriving (Enum,Eq,Integral,Data,Num,Ord,Real,Ix,Typeable)

instance TimeUnit Fortnight where
  toMicroseconds (Fortnight x) = x * (toMicroseconds $ Week 2)
  fromMicroseconds x           = Fortnight (x `div` (toMicroseconds $ Week 2))
instance Show Fortnight where
  show (Fortnight x) = show x ++ "fn"
instance Read Fortnight where
  readsPrec = readUnit Fortnight "fn"