1 module Hcompta.Date where
3 import Control.Monad (Monad(..))
4 import qualified Data.Fixed
5 import Data.Function (($), (.), id)
7 import Data.Maybe (Maybe(..))
8 import qualified Data.Time.Calendar as Time
9 import qualified Data.Time.Clock as Time
10 import qualified Data.Time.Clock.POSIX as Time (posixSecondsToUTCTime)
11 import qualified Data.Time.Format as Time ()
12 import qualified Data.Time.LocalTime as Time
13 import Prelude (Integer, Num(..))
27 date_gregorian :: d -> (Date_Year d, Date_Month d, Date_DoM d)
28 date_year :: d -> Date_Year d
29 date_month :: d -> Date_Month d
30 date_dom :: d -> Date_DoM d
31 date_tod :: d -> (Date_Hour d, Date_Minute d, Date_Second d)
32 date_hour :: d -> Date_Hour d
33 date_minute :: d -> Date_Minute d
34 date_second :: d -> Date_Second d
35 date_utc :: d -> Time.UTCTime
45 date_year = (\(x, _, _) -> x) . date_gregorian
46 date_month = (\(_, x, _) -> x) . date_gregorian
47 date_dom = (\(_, _, x) -> x) . date_gregorian
48 date_hour = (\(x, _, _) -> x) . date_tod
49 date_minute = (\(_, x, _) -> x) . date_tod
50 date_second = (\(_, _, x) -> x) . date_tod
52 instance Date Time.UTCTime where
53 type Date_Year Time.UTCTime = Integer
54 type Date_Month Time.UTCTime = Int
55 type Date_DoM Time.UTCTime = Int
56 type Date_Hour Time.UTCTime = Int
57 type Date_Minute Time.UTCTime = Int
58 type Date_Second Time.UTCTime = Data.Fixed.Pico
59 date_epoch = Time.posixSecondsToUTCTime 0
60 date_now = Time.getCurrentTime
61 date_gregorian = Time.toGregorian . Time.utctDay
63 case Time.timeToTimeOfDay $ Time.utctDayTime d of
64 Time.TimeOfDay h m s -> (h, m, s)
65 -- date_day = Time.utctDay
67 date_from y m d h mn s = do
68 gday <- Time.fromGregorianValid y m d
69 hod <- Time.makeTimeOfDayValid h mn s
72 Time.timeOfDayToTime hod
74 date_next_year_start :: Time.UTCTime -> Time.UTCTime
75 date_next_year_start d =
76 date_epoch{ Time.utctDay =
77 Time.addGregorianYearsClip
78 (date_year d + 1 - 1970)
82 date_bench :: IO a -> IO (a, Time.NominalDiffTime)
87 return (r, Time.diffUTCTime t1 t0)