{-# OPTIONS_GHC -fno-warn-orphans #-}
module Hcompta.Date.Interval where

-- import qualified Data.Fixed -- NOTE: not useful before base >=4.7
import qualified Data.List
import           Data.Maybe (Maybe(..), fromJust)
import qualified Data.Time.Calendar    as Time
import qualified Data.Time.Clock       as Time
import qualified Data.Time.Format      as Time ()
import qualified Data.Time.LocalTime   as Time
import           Prelude ( ($)
                         , Integral(..)
                         , Num(..)
                         )

import           Hcompta.Date hiding (year, month, dom, hour, minute, second)
import qualified Hcompta.Date as Date
import           Hcompta.Lib.Interval (Interval)
import qualified Hcompta.Lib.Interval as Interval


-- *  Gregorian

year :: Year -> Interval Date
year y =
	let ly = Time.addGregorianYearsClip (y - 1970) (day nil) in
	let hy = Time.addGregorianYearsClip 1 ly in
	fromJust $ (Interval.<=..<)
	 nil{Time.utctDay=ly}
	 nil{Time.utctDay=hy}

month :: Year -> Month -> Interval Date
month y m =
	let ly = Time.addGregorianYearsClip (y - 1970) (day nil) in
	let lm = Time.addGregorianMonthsClip (toInteger m - 1) ly in
	let hm = Time.addGregorianMonthsClip 1 lm in
	fromJust $ (Interval.<=..<)
	 nil{Time.utctDay=lm}
	 nil{Time.utctDay=hm}

dom :: Year -> Month -> DoM -> Interval Date
dom y m d =
	let ly = Time.addGregorianYearsClip (y - 1970) (day nil) in
	let lm = Time.addGregorianMonthsClip (toInteger m - 1) ly in
	let ld = Time.addDays (toInteger d - 1) lm in
	let hd = Time.addDays 1 ld in
	fromJust $ (Interval.<=..<)
	 nil{Time.utctDay=ld}
	 nil{Time.utctDay=hd}

hour :: Year -> Month -> DoM -> Hour -> Interval Date
hour y m d h =
	let ly = Time.addGregorianYearsClip (y - 1970) (day nil) in
	let lm = Time.addGregorianMonthsClip (toInteger m - 1) ly in
	let ld = nil{Time.utctDay=Time.addDays (toInteger d - 1) lm} in
	let lh = Time.addUTCTime (fromInteger $ toInteger (h * 3600)) ld in
	let hh = Time.addUTCTime 3600 lh in
	fromJust $ (Interval.<=..<) lh hh

minute :: Year -> Month -> DoM -> Hour -> Minute -> Interval Date
minute y m d h n =
	let ly = Time.addGregorianYearsClip (y - 1970) (day nil) in
	let lm = Time.addGregorianMonthsClip (toInteger m - 1) ly in
	let ld = nil{Time.utctDay=Time.addDays (toInteger d - 1) lm} in
	let lh = Time.addUTCTime (fromInteger $ toInteger (h * 3600)) ld in
	let ln = Time.addUTCTime (fromInteger $ toInteger (n * 60)) lh in
	let hn = Time.addUTCTime 60 ln in
	fromJust $ (Interval.<=..<) ln hn

{- NOTE: Data.Fixed.MkFixed requires base >=4.7
second :: Year -> Month -> DoM -> Hour -> Minute -> Second -> Interval Date
second y m d h n (Data.Fixed.MkFixed s) =
	let ly = Time.addGregorianYearsClip (y - 1970) (day nil) in
	let lm = Time.addGregorianMonthsClip (toInteger m - 1) ly in
	let ld = nil{Time.utctDay=Time.addDays (toInteger d - 1) lm} in
	let lh = Time.addUTCTime (fromInteger $ toInteger (h * 3600)) ld in
	let ln = Time.addUTCTime (fromInteger $ toInteger (n * 60)) lh in
	let ls = Time.addUTCTime (fromInteger $ s) ln in
	let hs = Time.addUTCTime 1 ls in
	fromJust $ (Interval.<=..<) ls hs
-}

-- * Slice

slice :: (Date -> Interval Date) -> Interval Date -> [Interval Date]
slice slicer i =
	Data.List.unfoldr
	 (\last_slice -> case Interval.intersection i last_slice of
		 Nothing -> Nothing
		 Just n  -> Just (n, slicer (Interval.limit $ Interval.high last_slice))
		) $
	slicer (Interval.limit $ Interval.low i)

year_slice :: Date -> Interval Date
year_slice d =
	let (y, _, _) = Date.gregorian d in
	year y

month_slice :: Date -> Interval Date
month_slice d =
	let (y, m, _) = Date.gregorian d in
	month y m

dom_slice :: Date -> Interval Date
dom_slice d =
	let (y, m, o) = Date.gregorian d in
	dom y m o

hour_slice :: Date -> Interval Date
hour_slice d =
	let (y, m, o) = Date.gregorian d in
	let Time.TimeOfDay h _ _ = tod d in
	hour y m o h

minute_slice :: Date -> Interval Date
minute_slice d =
	let (y, m, o) = Date.gregorian d in
	let Time.TimeOfDay h n _ = tod d in
	minute y m o h n

{-
second_slice :: Date -> Interval Date
second_slice d =
	let (y, m, o) = Date.gregorian d in
	let Time.TimeOfDay h n s = tod d in
	second y m o h n s
-}