diff --git a/System/Time/Calendar.hs b/System/Time/Calendar.hs index cb1862be7955a4bd6c847f859c1e4b300b7140c6..552f2158292c140e8e374443e57e9a8914432693 100644 --- a/System/Time/Calendar.hs +++ b/System/Time/Calendar.hs @@ -1,3 +1,5 @@ +{-# OPTIONS -Wall -Werror #-} + module System.Time.Calendar ( -- time zones @@ -57,7 +59,7 @@ show2 i = let _ -> s showFraction :: Integer -> Integer -> String -showFraction d 0 = "" +showFraction _ 0 = "" showFraction d i = (chr (fromInteger (48 + (div i d)))):showFraction (div d 10) (mod i d) showpicodecimal :: Integer -> String @@ -138,7 +140,7 @@ localToUTCTimeOfDay :: TimeZone -> TimeOfDay -> (Integer,TimeOfDay) localToUTCTimeOfDay (MkTimeZone tz) = utcToLocalTimeOfDay (MkTimeZone (negate tz)) -- note: this is also in System.Time.Clock. -posixDaySeconds :: (Num a) => a +posixDaySeconds :: Rational posixDaySeconds = 86400 posixDay :: DiffTime @@ -174,7 +176,7 @@ calendarToUTC tz (CalendarTime cday tod) = UTCTime (day + i) (timeOfDayToTime to -- | get a TimeOfDay given the fraction of a day since midnight dayFractionToTimeOfDay :: Rational -> TimeOfDay -dayFractionToTimeOfDay df = timeToTimeOfDay (siSecondsToTime (round (df * posixDaySeconds))) +dayFractionToTimeOfDay df = timeToTimeOfDay (siSecondsToTime (round (df * posixDaySeconds) :: Integer)) -- | 1st arg is observation meridian in degrees, positive is East ut1ToCalendar :: Rational -> ModJulianDate -> CalendarTime diff --git a/System/Time/Clock.hs b/System/Time/Clock.hs index bfc7379d1c718a1fd9523b9c6232be52f98d2fd8..63540d64a8f41df4d999cb7f953a8698446cbe30 100644 --- a/System/Time/Clock.hs +++ b/System/Time/Clock.hs @@ -1,4 +1,4 @@ -{-# OPTIONS -ffi -fglasgow-exts #-} +{-# OPTIONS -ffi -Wall -Werror #-} module System.Time.Clock ( @@ -30,16 +30,42 @@ secondPicoseconds :: (Num a) => a secondPicoseconds = 1000000000000 -- | a length of time -newtype DiffTime = MkDiffTime Integer deriving (Eq,Ord,Num,Enum,Real,Integral) +newtype DiffTime = MkDiffTime Integer deriving (Eq,Ord,Enum) instance Show DiffTime where show (MkDiffTime t) = (show t) ++ "ps" +-- necessary because H98 doesn't have "cunning newtype" derivation +instance Num DiffTime where + (MkDiffTime a) + (MkDiffTime b) = MkDiffTime (a + b) + (MkDiffTime a) - (MkDiffTime b) = MkDiffTime (a - b) + (MkDiffTime a) * (MkDiffTime b) = MkDiffTime (a * b) + negate (MkDiffTime a) = MkDiffTime (negate a) + abs (MkDiffTime a) = MkDiffTime (abs a) + signum (MkDiffTime a) = MkDiffTime (signum a) + fromInteger i = MkDiffTime (fromInteger i) + +-- necessary because H98 doesn't have "cunning newtype" derivation +instance Real DiffTime where + toRational (MkDiffTime a) = toRational a + +-- necessary because H98 doesn't have "cunning newtype" derivation +instance Integral DiffTime where + quot (MkDiffTime a) (MkDiffTime b) = MkDiffTime (quot a b) + rem (MkDiffTime a) (MkDiffTime b) = MkDiffTime (rem a b) + div (MkDiffTime a) (MkDiffTime b) = MkDiffTime (div a b) + mod (MkDiffTime a) (MkDiffTime b) = MkDiffTime (mod a b) + quotRem (MkDiffTime a) (MkDiffTime b) = (MkDiffTime p,MkDiffTime q) where + (p,q) = quotRem a b + divMod (MkDiffTime a) (MkDiffTime b) = (MkDiffTime p,MkDiffTime q) where + (p,q) = divMod a b + toInteger (MkDiffTime a) = toInteger a + siSecond :: DiffTime siSecond = secondPicoseconds timeToSISeconds :: (Fractional a) => DiffTime -> a -timeToSISeconds t = fromRational ((toRational t) / (toRational secondPicoseconds)); +timeToSISeconds t = fromRational ((toRational t) / secondPicoseconds); siSecondsToTime :: (Real a) => a -> DiffTime siSecondsToTime t = fromInteger (round ((toRational t) * secondPicoseconds)) @@ -53,13 +79,39 @@ data UTCTime = UTCTime { } -- | a length of time for UTC, ignoring leap-seconds -newtype UTCDiffTime = MkUTCDiffTime Integer deriving (Eq,Ord,Num,Enum,Real,Integral) +newtype UTCDiffTime = MkUTCDiffTime Integer deriving (Eq,Ord,Enum) instance Show UTCDiffTime where show (MkUTCDiffTime t) = (show t) ++ "ps" +-- necessary because H98 doesn't have "cunning newtype" derivation +instance Num UTCDiffTime where + (MkUTCDiffTime a) + (MkUTCDiffTime b) = MkUTCDiffTime (a + b) + (MkUTCDiffTime a) - (MkUTCDiffTime b) = MkUTCDiffTime (a - b) + (MkUTCDiffTime a) * (MkUTCDiffTime b) = MkUTCDiffTime (a * b) + negate (MkUTCDiffTime a) = MkUTCDiffTime (negate a) + abs (MkUTCDiffTime a) = MkUTCDiffTime (abs a) + signum (MkUTCDiffTime a) = MkUTCDiffTime (signum a) + fromInteger i = MkUTCDiffTime (fromInteger i) + +-- necessary because H98 doesn't have "cunning newtype" derivation +instance Real UTCDiffTime where + toRational (MkUTCDiffTime a) = toRational a + +-- necessary because H98 doesn't have "cunning newtype" derivation +instance Integral UTCDiffTime where + quot (MkUTCDiffTime a) (MkUTCDiffTime b) = MkUTCDiffTime (quot a b) + rem (MkUTCDiffTime a) (MkUTCDiffTime b) = MkUTCDiffTime (rem a b) + div (MkUTCDiffTime a) (MkUTCDiffTime b) = MkUTCDiffTime (div a b) + mod (MkUTCDiffTime a) (MkUTCDiffTime b) = MkUTCDiffTime (mod a b) + quotRem (MkUTCDiffTime a) (MkUTCDiffTime b) = (MkUTCDiffTime p,MkUTCDiffTime q) where + (p,q) = quotRem a b + divMod (MkUTCDiffTime a) (MkUTCDiffTime b) = (MkUTCDiffTime p,MkUTCDiffTime q) where + (p,q) = divMod a b + toInteger (MkUTCDiffTime a) = toInteger a + utcTimeToUTCSeconds :: (Fractional a) => UTCDiffTime -> a -utcTimeToUTCSeconds t = fromRational ((toRational t) / (toRational secondPicoseconds)) +utcTimeToUTCSeconds t = fromRational ((toRational t) / secondPicoseconds) utcSecondsToUTCTime :: (Real a) => a -> UTCDiffTime utcSecondsToUTCTime t = fromInteger (round ((toRational t) * secondPicoseconds)) diff --git a/System/Time/TAI.hs b/System/Time/TAI.hs index 501f8179a364b3d6eccd347c009914b124685404..0b85db8580e80469e3959aa89d76e1e1d96aa971 100644 --- a/System/Time/TAI.hs +++ b/System/Time/TAI.hs @@ -1,3 +1,5 @@ +{-# OPTIONS -Wall -Werror #-} + -- | most people won't need this module module System.Time.TAI ( @@ -33,4 +35,4 @@ utcToTAITime table (UTCTime day dtime) = MkAbsoluteTime ((siSecondsToTime (day * 86400 + (table day))) + dtime) taiToUTCTime :: LeapSecondTable -> AbsoluteTime -> UTCTime -taiToUTCTime table (MkAbsoluteTime t) = undefined +taiToUTCTime table (MkAbsoluteTime t) = undefined table t