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)