Skip to content

Instantly share code, notes, and snippets.

@chexxor
Created April 18, 2019 14:16
Show Gist options
  • Save chexxor/6c876529e7bfb89dec5b0e608aac0b70 to your computer and use it in GitHub Desktop.
Save chexxor/6c876529e7bfb89dec5b0e608aac0b70 to your computer and use it in GitHub Desktop.
Haskell Exercism at Haskell Meetup
module Meetup (Weekday(..), Schedule(..), meetupDay) where
import Data.Time.Calendar --(Day, dayOfWeek, fromGregorian, gregorianMonthLength)
--import qualified Data.Time.Calendar as Cal
import Data.List
data Weekday = Monday
| Tuesday
| Wednesday
| Thursday
| Friday
| Saturday
| Sunday
deriving (Eq)
data Schedule = First
| Second
| Third
| Fourth
| Last
| Teenth
monthCalendar :: Integer -> Int -> [ (Int, Weekday) ]
monthCalendar year month = zip [1 .. numDays] [(firstDayOfMonth year month) ..]
where
numDays = gregorianMonthLength year month
monthCalendar' :: Integer -> Int -> [ Weekday ]
monthCalendar' year month = take numDays [ (firstDayOfMonth year month) .. ]
where
numDays = gregorianMonthLength year month
dateMatches :: Integer -> Int -> Weekday -> [Int]
dateMatches year month dayOfWeek = findIndices (==dayOfWeek) (monthCalendar' year month)
dayOfWeek :: Day -> Weekday
dayOfWeek (ModifiedJulianDay d) = toEnum $ fromInteger $ d + 3
instance Enum Weekday where
toEnum i =
case mod i 7 of
0 -> Sunday
1 -> Monday
2 -> Tuesday
3 -> Wednesday
4 -> Thursday
5 -> Friday
_ -> Saturday
fromEnum Monday = 1
fromEnum Tuesday = 2
fromEnum Wednesday = 3
fromEnum Thursday = 4
fromEnum Friday = 5
fromEnum Saturday = 6
fromEnum Sunday = 7
enumFromTo wd1 wd2
| wd1 == wd2 = [wd1]
enumFromTo wd1 wd2 = wd1 : enumFromTo (succ wd1) wd2
enumFromThenTo wd1 wd2 wd3
| wd2 == wd3 = [wd1, wd2]
enumFromThenTo wd1 wd2 wd3 = wd1 : enumFromThenTo wd2 (toEnum $ (2 * fromEnum wd2) - (fromEnum wd1)) wd3
applySchedule :: Schedule -> Integer -> Int -> Weekday -> Day
applySchedule schedule year month d = fromGregorian year month $ 1 +
case schedule of
First -> ((dateMatches year month d) !! 0)
Second -> ((dateMatches year month d) !! 1)
Third -> ((dateMatches year month d) !! 2)
Fourth -> ((dateMatches year month d) !! 3)
Last -> (last (dateMatches year month d))
Teenth -> (dropWhile (< 12) (dateMatches year month d)) !! 0
--meetupDay First Tuesday 2019 2 == "2019/2/5"
firstDayOfMonth :: Integer -> Int -> Weekday
firstDayOfMonth year month = dayOfWeek (fromGregorian year month 1)
meetupDay :: Schedule -> Weekday -> Integer -> Int -> Day
meetupDay schedule weekday year month = applySchedule schedule year month weekday
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment