Weekdays Until
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))) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment