lib/Hcompta/Model/Date.hs

   1 {-# LANGUAGE DeriveDataTypeable #-}
   2 {-# LANGUAGE StandaloneDeriving #-}
   3 {-# LANGUAGE TypeSynonymInstances #-}
   4 {-# OPTIONS_GHC -fno-warn-orphans #-}
   5 module Hcompta.Model.Date where
   6
   7 import           Data.Data
   8 import qualified Data.Fixed
   9 import qualified Data.Time.Calendar    as Time
  10 import qualified Data.Time.Clock       as Time
  11 import qualified Data.Time.Clock.POSIX as Time (posixSecondsToUTCTime)
  12 import qualified Data.Time.Format      as Time ()
  13 import qualified Data.Time.LocalTime   as Time
  14 import           Data.Typeable ()
  15
  16 -- * The 'Date' type
  17
  18 type Date = Time.UTCTime
  19
  20 nil :: Date
  21 nil = Time.posixSecondsToUTCTime 0
  22
  23 gregorian :: Date -> (Integer, Int, Int)
  24 gregorian = Time.toGregorian . Time.utctDay
  25
  26 year :: Date -> Integer
  27 year = (\(x, _, _) -> x) . gregorian
  28
  29 month :: Date -> Int
  30 month = (\(_, x, _) -> x) . gregorian
  31
  32 dom :: Date -> Int
  33 dom = (\(_, _, x) -> x) . gregorian
  34
  35 tod :: Date -> Time.TimeOfDay
  36 tod = Time.timeToTimeOfDay . Time.utctDayTime
  37
  38 hour :: Date -> Int
  39 hour = (\(Time.TimeOfDay x _ _) -> x) . tod
  40
  41 minute :: Date -> Int
  42 minute = (\(Time.TimeOfDay _ x _) -> x) . tod
  43
  44 second :: Date -> Data.Fixed.Pico
  45 second = (\(Time.TimeOfDay _ _ x) -> x) . tod
  46
  47 data Interval
  48  =   Interval_None
  49  |   Interval_Days Int
  50  |   Interval_Weeks Int
  51  |   Interval_Months Int
  52  |   Interval_Quarters Int
  53  |   Interval_Years Int
  54  |   Interval_DayOfMonth Int
  55  |   Interval_DayOfWeek Int
  56  -- Interval_WeekOfYear Int
  57  -- Interval_MonthOfYear Int
  58  -- Interval_QuarterOfYear Int
  59  deriving (Data, Eq, Ord, Read, Show, Typeable)
  60
  61 type Smart
  62  = (String, String, String)
  63
  64 data Span
  65  =   Span (Maybe Time.Day) (Maybe Time.Day)
  66  deriving (Data, Eq, Ord, Read, Show, Typeable)
  67
  68 data Which
  69  =   Which_Primary
  70  |   Which_Secondary
  71  deriving (Eq, Read, Show)
  72
  73 type Year
  74  = Integer
  75