module Data.Carbonara.Time where
import Data.Char (isDigit)
import Data.Time.Calendar (addDays, Day, fromGregorian, toGregorian, toModifiedJulianDay) --time
import Data.Time.Calendar.Easter (gregorianEaster)
import Data.Time.Clock (getCurrentTime, utctDay)
addTradeDays :: Integral i => i -> Day -> Day
addTradeDays n day
| n == 0 = day
| n > 0 = nextTradeDay $ addTradeDays (n - 1) day
| n < 0 = previousTradeDay $ addTradeDays (n + 1) day
-- eg dayToString (fromGregorian 2016 3 14) --> "20160314"
dayToStr :: Day -> String
dayToStr = filter (isDigit) . show
-- diffDays (fromGregorian 1970 1 1) (fromGregorian 1858 11 17) is 40587; 1 day has 86400 seconds
-- compare: unixtimeToDay
dayToUnixtime :: Day -> Integer
dayToUnixtime day = (toModifiedJulianDay day - 40587) * 86400
fg :: Integer -> Int -> Int -> Day
fg = fromGregorian
getDay :: Day -> Int
getDay day = d where (_,_,d) = toGregorian day
getMonth :: Day -> Int
getMonth day = m where (_,m,_) = toGregorian day
getYear :: Day -> Integer
getYear day = y where (y,_,_) = toGregorian day
-- This is the current GMT day
getToday :: IO Day
getToday = utctDay <$> getCurrentTime
getTradeDate :: IO Day
getTradeDate = previousTradeDay <$> getToday
-- Years Day might be Saturady and falls into 31 Dec 2010
-- https://www.opm.gov/policy-data-oversight/snow-dismissal-procedures/federal-holidays/
-- this is actually CME Exchange Holiday, which includes Good Friday, while Federal holiday not
getExchangeHolidays :: Integer -> [Day]
getExchangeHolidays year
| nextYearJan1isSat = thisYearExchangeHolidays ++ [fg year 12 31]
| otherwise = thisYearExchangeHolidays
where nextYearJan1isSat = isSaturday $ fg (year + 1) 1 1
thisYearExchangeHolidays = [holidayNewYears year, holidayMartinLuther year, holidayWashington year,
holidayGoodFriday year, holidayMemorial year, holidayIndependence year, holidayLabor year, holidayColumbus year,
holidayVeterans year, holidayThanksgiving year, holidayChristmas year]
-- New Year's Day is fixed at January 1st, falls to Dec 31 if Saturday
holidayNewYears :: Integer -> Day
holidayNewYears year
| isSaturday jan1 = pred $ jan1
| isSunday jan1 = fromGregorian year 1 2
| otherwise = jan1
where jan1 = fromGregorian year 1 1
-- Martin Luther Day is the third Monday in January
holidayMartinLuther :: Integer -> Day
holidayMartinLuther year = nextMonday (fromGregorian year 1 14)
-- Presidents' Day is the third Monday in February
holidayWashington :: Integer -> Day
holidayWashington year = nextMonday (fromGregorian year 2 14)
-- Good Friday is observed by CME, though it is not a US Federal Holiday
holidayGoodFriday :: Integer -> Day
holidayGoodFriday year = lastFriday $ gregorianEaster year
-- Memorial Day is the last Monday in May
holidayMemorial :: Integer -> Day
holidayMemorial year = lastMonday (fromGregorian year 6 1)
-- Independence Day is fixed at July 4th
holidayIndependence :: Integer -> Day
holidayIndependence year
| isSaturday july4 = fromGregorian year 7 3
| isSunday july4 = fromGregorian year 7 5
| otherwise = july4
where july4 = fromGregorian year 7 4
-- Labor Day is the first Monday in September
holidayLabor :: Integer -> Day
holidayLabor year = nextMonday (fromGregorian year 8 31)
-- Columbus Day is the second Monday in October
holidayColumbus :: Integer -> Day
holidayColumbus year = nextMonday (fromGregorian year 10 7)
-- Veterans Day is fixed at November 11th
holidayVeterans :: Integer -> Day
holidayVeterans year
| isSaturday nov11 = fromGregorian year 11 10
| isSunday nov11 = fromGregorian year 11 12
| otherwise = nov11
where nov11 = fromGregorian year 11 11
-- Thanksgiving Day is the fourth Thursday in November
holidayThanksgiving :: Integer -> Day
holidayThanksgiving year = nextThursday (fromGregorian year 11 21)
-- Christmas Day is fixed at December 25th
holidayChristmas :: Integer -> Day
holidayChristmas year
| isSaturday dec25 = fromGregorian year 12 24
| isSunday dec25 = fromGregorian year 12 26
| otherwise = dec25
where dec25 = fromGregorian year 12 25
isWednesday,isThursday,isFriday,isSaturday,isSunday,isMonday,isTuesday :: Day -> Bool
[isWednesday,isThursday,isFriday,isSaturday,isSunday,isMonday,isTuesday] = [isDay i | i <- [0 .. 6]]
where isDay :: Integer -> Day -> Bool
isDay i day = toModifiedJulianDay day `mod` 7 == i
-- Years Day might be Saturady and falls into 31 Dec 2010
isExchangeHoliday :: Day -> Bool
isExchangeHoliday day = day `elem` (getExchangeHolidays $ getYear day)
isTradeDay :: Day -> Bool
isTradeDay day = not (isSunday day || isSaturday day || isExchangeHoliday day)
isWeekday :: Day -> Bool
isWeekday day = not (isSaturday day || isSunday day)
lastTuesday,lastMonday,lastSunday,lastSaturday,lastFriday,lastThursday,lastWednesday :: Day -> Day
[lastTuesday,lastMonday,lastSunday,lastSaturday,lastFriday,lastThursday,lastWednesday] = [lastDay i | i <- [0 .. 6]]
where lastDay :: Integer -> Day -> Day
lastDay i day = addDays ((negate $ (toModifiedJulianDay day + i) `mod` 7) - 1) day
nextWednesday,nextTuesday,nextMonday,nextSunday,nextSaturday,nextFriday,nextThursday :: Day -> Day
[nextWednesday,nextTuesday,nextMonday,nextSunday,nextSaturday,nextFriday,nextThursday] = [nextDay i | i <- [0 .. 6]]
where nextDay :: Integer -> Day -> Day
nextDay i day = addDays (7 - (toModifiedJulianDay day + i) `mod` 7) day
nextTradeDay :: Day -> Day
nextTradeDay day
| isTradeDay tomorrow = tomorrow
| otherwise = nextTradeDay tomorrow
where tomorrow = succ day
previousTradeDay :: Day -> Day
previousTradeDay day
| isTradeDay yesterday = yesterday
| otherwise = previousTradeDay yesterday
where yesterday = pred day
-- 1 day has 86400 seconds
unixtimeToDay :: Integer -> Day
unixtimeToDay i = addDays (i `div` 86400) (fromGregorian 1970 1 1)