content: import Data.List (intercalate)
  
  data DayOfWeek = Monday | Tuesday | Wednesday | Thursday | Friday |
      Saturday | Sunday
      deriving (Eq, Show)
  
  -- the whole thing bases upon an infinite list of weeks
  
  daysFrom1_1_1900 :: [DayOfWeek]
  daysFrom1_1_1900 = concat $ repeat [Monday, Tuesday, Wednesday,
      Thursday, Friday, Saturday, Sunday]
  
  data Month = January | February | March | April | May | June | July |
      August | September | October | November | December
      deriving (Show)
  
  type Year = Int
  type YearCalendar = (Year, [DayOfWeek])
  type MonthlyCalendar = (Year, [(Month, [DayOfWeek])])
  
  -- makes groups of 365 or 366 days for each year (infinite list)
  
  yearsFrom :: [DayOfWeek] -> Year -> [YearCalendar]
  yearsFrom s i = (i, yeardays) : yearsFrom rest (i + 1)
      where
          yeardays = take (leapOrNot i) s
          yearlen  = length yeardays
          rest    = drop yearlen s
          leapOrNot n = if isLeapYear n then 366 else 365
  
  yearsFrom1900 :: [YearCalendar]
  yearsFrom1900 = yearsFrom daysFrom1_1_1900 1900
  
  -- makes groups of days for each month of the year
  
  months :: YearCalendar -> MonthlyCalendar
  months (y, d) = (y, [(January, january), (February, february),
      (March, march), (April, april), (May, may), (June, june),
      (July, july), (August, august), (September, september),
      (October, october), (November, november), (December, december)])
      where
          leapOrNot = if isLeapYear y then 29 else 28
          january = take 31 d
          february = take leapOrNot $ drop 31 d
          march = take 31 $ drop (31 + leapOrNot) d
          april = take 30 $ drop (62 + leapOrNot) d
          may = take 31 $ drop (92 + leapOrNot) d
          june = take 30 $ drop (123 + leapOrNot) d
          july = take 31 $ drop (153 + leapOrNot) d
          august = take 31 $ drop (184 + leapOrNot) d
          september = take 30 $ drop (215 + leapOrNot) d
          october = take 31 $ drop (245 + leapOrNot) d
          november = take 30 $ drop (276 + leapOrNot) d
          december = take 31 $ drop (306 + leapOrNot) d
  
  -- see if a year is a leap year
  
  isLeapYear n
      | n `mod` 100 == 0 = n `mod` 400 == 0
      | otherwise = n `mod` 4 == 0
  
  -- make a list of the months of a year that have 5 weekends
  -- (they must have 31 days and the first day must be Friday)
  -- if the year doesn't contain any 5-weekended months, then
  -- return the year and an empty list
  
  whichFiveWeekends :: MonthlyCalendar -> (Year, [Month])
  whichFiveWeekends (y, ms) = (y, map (\(m, _) -> m) found) -- extract the months & leave out their days
      where   found = filter (\(m, a@(d:ds)) -> and [length a == 31,
                  d == Friday]) ms
  
  -- take all days from 1900 until 2100, grouping them by years, then by
  -- months, and calculating whether they have any 5-weekended months
  -- or not
  
  calendar :: [MonthlyCalendar]
  calendar = map months $ yearsFrom1900
  
  fiveWeekends1900To2100 :: [(Year, [Month])]
  fiveWeekends1900To2100 = takeWhile (\(y, _) -> y <= 2100) $
      map whichFiveWeekends calendar
  
  main = do
      -- count the number of years with 5 weekends
      let answer1 = foldl (\c (_, m) -> c + length m) 0 fiveWeekends1900To2100
      -- take only the years with 5-weekended months
          answer2 = filter (\(_, m) -> not $ null m) fiveWeekends1900To2100
      -- take only the years without 5-weekended months
          answer30 = filter (\(_, m) -> null m) fiveWeekends1900To2100
      -- count how many years without 5-weekended months there are
          answer31 = length answer30
      -- show the years without 5-weekended months
          answer32 = intercalate ", " $ map (\(y, m) -> show y) answer30
      putStrLn $ "There are " ++ show answer1 ++ " months with 5 weekends between 1900 and 2100."
      putStrLn "\nThe first ones are:"
      mapM_ (putStrLn . formatMonth) $ take 5 $ answer2
      putStrLn "\nThe last ones are:"
      mapM_ (putStrLn . formatMonth) $ reverse $ take 5 $ reverse answer2
      putStrLn $ "\n" ++ show answer31 ++ " years don't have at least one five-weekened month"
      putStrLn "\nThose are:"
      putStrLn answer32
  
  formatMonth :: (Year, [Month]) -> String
  formatMonth (y, m) = show y ++ ": " ++ intercalate ", " [ show x | x <- m ]
  