Haskell Exercism at Haskell Meetup

meetup.hs

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