{-# LANGUAGE ScopedTypeVariables #-}

{-

Prints out every date and day of week in a 400-year Gregorian calendar
cycle.

Copyright 2013 Ken Takusagawa

This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program.  If not, see <http://www.gnu.org/licenses/>.
 -}

module Main where {
newtype Year = Year Integer deriving (Eq, Ord, Show) ;
data Month = January | February | March | April | May | June | July |
August | September | October | November | December
deriving (Eq,Show);
newtype Day = Day Int deriving (Eq,Show);
data DayOfWeek = Monday | Tuesday | Wednesday | Thursday | Friday |
Saturday | Sunday deriving (Eq, Show);
data Date = Date Year Month Day DayOfWeek deriving (Eq,Show);

gregorianTomorrow :: Date -> Date;
gregorianTomorrow (Date inYear inMonth inDay inDayOfWeek) =
{- Assumes a valid date as input -}
case (incrementDay inYear inMonth inDay) of {
(outDay, newMonth) -> let {
partial :: Month -> Year -> Date;
partial m y = Date y m outDay (incrementDayOfWeek inDayOfWeek);
} in case newMonth of {
NoRollover -> partial inMonth inYear;
YesRollover -> case (incrementMonth inMonth) of {
(outMonth, newYear) -> partial outMonth $ case newYear of {
NoRollover -> inYear;
YesRollover -> incrementYear inYear;
}
}
}};

data Rollover = NoRollover | YesRollover;

thirtyDayMonths :: [Month];
thirtyDayMonths = [April, June, September, November];

incrementDay :: Year -> Month -> Day -> (Day, Rollover);
incrementDay (Year y) m d = let {
lastDayOfMonth :: Day;
lastDayOfMonth = Day $ if
elem m thirtyDayMonths then 30
else if m /= February then 31
else case mod y 4 of {
0 -> case mod y 100 of {
0 -> case mod y 400 of {
0 -> 29;
_ -> 28;
};
_ -> 29;
};
_ -> 28;
};
internalIncrement :: Day;
internalIncrement = case d of {
Day internal -> Day $ succ internal;
};
} in if d == lastDayOfMonth
then (Day 1, YesRollover)
else (internalIncrement, NoRollover);

{- | Given a list and an item in a list, return the next item after
the given item -}
cyclicIncrement :: forall a. (Eq a) => [a] -> a -> a;
cyclicIncrement l target = let {
cyclicIncrementInternal :: a -> [a] -> a;
cyclicIncrementInternal first (h:t) = if target /= h
then cyclicIncrementInternal first t;
else case t of {
[] -> first;
_ -> head t;
}
} in cyclicIncrementInternal (head l) l;

incrementMonth :: Month -> (Month, Rollover);
incrementMonth m = let {
newYear :: Rollover;
newYear = case m of {
December -> YesRollover;
_ -> NoRollover;
};
nextMonth :: Month;
nextMonth = cyclicIncrement [January, February, March, April, May,
June, July, August, September, October, November, December] m;
} in (nextMonth, newYear);

incrementYear :: Year -> Year;
incrementYear (Year y) = Year $ succ y;

incrementDayOfWeek :: DayOfWeek -> DayOfWeek;
incrementDayOfWeek = cyclicIncrement [Monday, Tuesday, Wednesday,
Thursday, Friday, Saturday, Sunday];

startDate :: Date;
startDate = Date (Year 0) January (Day 1) Saturday;
gregorianCycleDays :: Int;
gregorianCycleDays = 146097;
main :: IO();
main = mapM_ print $ take gregorianCycleDays $
iterate gregorianTomorrow startDate;
}