Time.hs

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)