{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Hcompta.Date where

import qualified Data.Fixed
import qualified Data.Time.Calendar    as Time
import qualified Data.Time.Clock       as Time
import qualified Data.Time.Clock.POSIX as Time (posixSecondsToUTCTime)
import qualified Data.Time.Format      as Time ()
import qualified Data.Time.LocalTime   as Time

-- import qualified Hcompta.Lib.Interval.Sieve as Interval.Sieve

-- * Type 'Date'

type Date   = Time.UTCTime
type Year   = Integer
type Month  = Int
type Day    = Time.Day
type DoM    = Int
type Hour   = Int
type Minute = Int
type Second = Data.Fixed.Pico

nil :: Date
nil = Time.posixSecondsToUTCTime 0

now :: IO Date
now = Time.getCurrentTime

date :: Year -> Month -> DoM -> Hour -> Minute -> Second -> Maybe Date
date y m d h mn s = do
	gday <- Time.fromGregorianValid y m d
	hod <- Time.makeTimeOfDayValid h mn s
	return $
		Time.UTCTime gday $
			Time.timeOfDayToTime hod

-- ** Components

gregorian :: Date -> (Year, Month, DoM)
gregorian = Time.toGregorian . Time.utctDay

year :: Date -> Year
year = (\(x, _, _) -> x) . gregorian

month :: Date -> Month
month = (\(_, x, _) -> x) . gregorian

day :: Date -> Day
day = Time.utctDay

dom :: Date -> DoM
dom = (\(_, _, x) -> x) . gregorian

tod :: Date -> Time.TimeOfDay
tod = Time.timeToTimeOfDay . Time.utctDayTime

hour :: Date -> Hour
hour = (\(Time.TimeOfDay x _ _) -> x) . tod

minute :: Date -> Minute
minute = (\(Time.TimeOfDay _ x _) -> x) . tod

second :: Date -> Second
second = (\(Time.TimeOfDay _ _ x) -> x) . tod

next_year_start :: Date -> Date
next_year_start d =
	nil{ Time.utctDay =
		Time.addGregorianYearsClip
		 (year d + 1 - 1970)
		 (Time.utctDay d)
	 }

utc :: Date -> Time.UTCTime
utc = id

{-
data Interval
 =   Interval_None
 |   Interval_Days Int
 |   Interval_Weeks Int
 |   Interval_Months Int
 |   Interval_Quarters Int
 |   Interval_Years Int
 |   Interval_DayOfMonth Int
 |   Interval_DayOfWeek Int
 -- Interval_WeekOfYear Int
 -- Interval_MonthOfYear Int
 -- Interval_QuarterOfYear Int
 deriving (Data, Eq, Ord, Read, Show, Typeable)


type Smart
 = (String, String, String)
data Which
 =   Which_Primary
 |   Which_Secondary
 deriving (Eq, Read, Show)
-}