Weekdays Until

weekdays-until.hs

module Main where

import Data.Time
import Data.Time.Clock
import Data.Time.Format
import Data.Time.Calendar
import Data.Maybe
import System.Environment
import Text.ParserCombinators.ReadP
import Data.Char
import Control.Monad

defaultEnd :: Day
defaultEnd = fromGregorian 2018 03 30

dayParser :: ReadP Day
dayParser = do
  year <- read <$> count 4 (satisfy isDigit)
  void (char '-')
  month <- read <$> count 2 (satisfy isDigit)
  void (char '-')
  day <- read <$> count 2 (satisfy isDigit)
  return (fromGregorian year month day)

parseDate :: String -> Maybe Day
parseDate = fmap fst . listToMaybe . readP_to_S dayParser

weekdays :: [String]
weekdays =
  [ "Monday"
  , "Tuesday"
  , "Wednesday"
  , "Thursday"
  , "Friday"
  ]

isWeekday :: Day -> Bool
isWeekday = (`elem` weekdays) . formatTime defaultTimeLocale "%A"

daysFrom :: Day -> [Day]
daysFrom start = [start ..]

weekdaysFrom :: Day -> [Day]
weekdaysFrom = filter isWeekday . daysFrom

main :: IO ()
main = do
  end <- fromMaybe defaultEnd . (parseDate <=< listToMaybe) <$> getArgs
  today <- localDay . utcToLocalTime (minutesToTimeZone (60 * 10)) <$> getCurrentTime
  print (length (takeWhile (<= end) (weekdaysFrom today)))