{-# LANGUAGE ScopedTypeVariables #-}
{-
Copyright 2011 Ken Takusagawa
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU Affero 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 Affero General Public License
along with this program.  If not, see <http://www.gnu.org/licenses/>.
-}

module Main (main) where{
import System.Environment;
import Data.Time;
import Data.List;
import Network.CGI;
import Text.Printf;
import Factor_cmd;
import Control.Monad;
import System.Locale;

cgi_main :: CGI(CGIResult);
cgi_main = (do{
  yr :: Maybe(Integer) <- (readInput "yr");
  mo :: Maybe(Int) <- (readInput "mo");
  dy :: Maybe(Int) <- (readInput "dy");
  offset :: Maybe(Integer) <- (readInput "offset");
  action :: Maybe(String) <- (getInput "action");
  (case (yr, mo, dy, offset) of {
  ((Just yr), (Just mo), (Just dy), (Just offset))-> (let {
f :: (Integer -> Int -> Int -> Integer -> IO(String));
f = (case action of {
  (Just "list")-> gen_list;
  _ -> gen_test
})
}
 in ((liftIO (f yr mo dy offset)) >>= output));
  _ -> (outputInternalServerError [(show yr), (show mo), (show dy), (show offset)])
});
});
main :: IO(());
main = (runCGI (handleErrors cgi_main));
main2 :: IO(());
main2 = (do{
  args :: [](String) <- getArgs;
  ((gen_test (read ((!!) args 0)) (read ((!!) args 1)) (read ((!!) args 2)) (read ((!!) args 3))) >>= putStrLn);
});
gen_test :: Integer -> Int -> Int -> Integer -> IO(String);
gen_test yr mo dy offset = (do{
  let {  start :: Day;  start = (fromGregorian yr mo dy);};
  today :: Day <- (getToday >>= (return . (addDays offset)));
  let {  interval :: Integer;  interval = (diffDays today start);};
  let {  today_string :: String;  today_string = ("<!-- Today is " ++ (show today) ++ ". -->\n");};
  info_today :: String <- (case (compare interval 0) of {
  EQ-> (return "You are born today!");
  LT-> (return "Requested date is in the future.");
  _ -> (do{
  fs :: [](Integer) <- (factor interval);
  (case (length fs) of {
  0-> (return "You are 1 day old.");
  1-> (do_prime_day today);
  _ -> (find_from_composite today interval fs)
});
})
});
  nextp :: String <- (case (compare interval 0) of {
  LT-> (return "");
  _ -> (next_prime_day interval today)
});
  (return((create_html ((show start) ++ " birthday Prime Day calculator"))(("<p align=\"right\"><a href=\"" ++ "primeday.cgi?action=test" ++ "&yr=" ++ (show yr) ++ "&mo=" ++ (show mo) ++ "&dy=" ++ (show dy) ++ "&offset=" ++ (show(((+) 1)(offset))) ++ "\" title=\"Peek at tomorrow's calculation\">Peek tomorrow</a></p>\n" ++ today_string ++ "<p>" ++ info_today ++ "</p><p>" ++ nextp ++ "</p>\n" ++ (case (its_your_birthday today start) of {
  True-> "<p>Also, <strong>happy birthday!</strong></p>\n";
  _ -> ""
}) ++ (case offset of {
  0-> "<p><em>Bookmark this page to automatically recalculate whenever you open the bookmark.</em></p>\n";
  _ -> ""
}) ++ "\n<hr>\n<p>" ++ "<a href=" ++ "\"primeday.cgi?action=list" ++ "&yr=" ++ (show yr) ++ "&mo=" ++ (show mo) ++ "&dy=" ++ (show dy) ++ "&offset=0" ++ "\">List all your Prime Days this year</a></p><p>" ++ "<a href=\"http://web.mit.edu/kenta/www/one/primeday/flrwhcmr/\">Back to Prime Day Calculator</a></p><p>" ++ "Leave comments on <a href=\"http://kenta.blogspot.com/2011/05/flrwhcmr-prime-day-calculator.html\">this blog post</a></p><p>" ++ "<a href=\"http://web.mit.edu/kenta/www/one/primeday/flrwhcmr/src\">View source code</a></p>"))));
});
getToday :: IO(Day);
getToday = (getZonedTime >>= (return . localDay . zonedTimeToLocalTime));
make_day :: [](String) -> Day;
make_day x = (case x of {
  [(yr ), (mo ), (dy )]-> (fromGregorian (read yr) (read mo) (read dy));
  _ -> (error ("expecting [year,month,day], but got " ++ (show x)))
});
do_prime_day :: Day -> IO(String);
do_prime_day today = (return ("<font size=\"+4\">Happy Prime Day!</font></p><p>You have lived a prime number of days, as of " ++ (show_day today) ++ "."));
find_from_composite :: Day -> Integer -> [](Integer) -> IO(String);
find_from_composite today total factors = (do{
  let {  dm :: (Integer, Integer);  dm = (divMod total (last factors));};
  let {  last_chapter_ago :: Integer;  last_chapter_ago = (fst dm);};
  let {  last_chapter_start :: Day;  last_chapter_start = (addDays (negate last_chapter_ago) today);};
  (case (snd dm) of {
  0-> (return ());
  _ -> (error "did not divide cleanly")
});
  (return ("<font size=\"+3\">Happy Composite Day!</font></p><p>" ++ "As of today, " ++ (show_day today) ++ ", your life may be divided into exactly <strong>" ++ (show(last(factors))) ++ "</strong> chapters" ++ " of <strong>" ++ (show last_chapter_ago) ++ "</strong> days each." ++ "<br>   The latest chapter started on <strong>" ++ (show_day last_chapter_start) ++ "</strong> and ended yesterday.  The next chapter begins today!"));
});
plural :: Integer -> String;
plural i = (case i of {
  1-> "";
  _ -> "s"
});
next_prime_day :: Integer -> Day -> IO(String);
next_prime_day total today = (do{
  np :: Integer <- (next_prime ((+) 1 total));
  let {  interval :: Integer;  interval = ((-) np total);};
  let {  the_day :: Day;  the_day = (addDays interval today);};
  (return ("Your next Prime Day is " ++ (case interval of {
  1-> "tomorrow";
  _ -> ("in " ++ (show interval) ++ " days")
}) ++ ", on " ++ (show_day the_day) ++ ".</p>" ++ (case (compare total 0) of {
  GT-> ("<p>Your <a href=\"https://secure.wikimedia.org/wikipedia/en/wiki/Prime_number_theorem\">average spacing</a> between Prime Days is " ++ (printf "%.4f" ((log(fromInteger(total))) :: Double)) ++ " days.");
  _ -> ""
})));
});
create_html :: String -> String -> String;
create_html title body = (unlines ["<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\">", ("<html><head><title>" ++ title ++ "</title></head><body>"), body, " </body></html>"]);
gen_list :: Integer -> Int -> Int -> Integer -> IO(String);
gen_list yr mo dy offset = (do{
  let {  start :: Day;  start = (fromGregorian yr mo dy);};
  today :: Day <- getToday;
  let {  target :: Integer;  target = (((+) offset)(get_year(today)));};
  prime_days :: [](Day) <- (get_prime_days start target);
  let {
link :: Integer -> String;
link offset = ("\"primeday.cgi?action=list" ++ "&yr=" ++ (show yr) ++ "&mo=" ++ (show mo) ++ "&dy=" ++ (show dy) ++ "&offset=" ++ (show offset) ++ "\"")
};
  (return (create_html ("Your Prime Days for " ++ (show target)) ("<h1>Your Prime Days for " ++ (show target) ++ "</h1>\n<p>" ++ (concat((intersperse "<br>\n")((map show_day)(prime_days)))) ++ "</p>\n<p>" ++ "<a href=" ++ (link (pred offset)) ++ ">Previous year</a> -  " ++ "<a href=" ++ (link (succ offset)) ++ ">Next year</a>" ++ "</p>" ++ "\n<hr><a href=\"http://web.mit.edu/kenta/www/one/primeday/flrwhcmr/\">Back to Prime Day Calculator</a><br>" ++ "<a href=\"http://web.mit.edu/kenta/www/one/primeday/flrwhcmr/src\">View source code</a>")));
});
get_year :: Day -> Integer;
get_year d = (case (toGregorian d) of {
  (yr, _, _)-> yr
});
days_of_the_year :: Integer -> [](Day);
days_of_the_year yr = (let {
this_year :: Day -> Bool;
this_year d = ((==) yr (get_year d))
}
 in (takeWhile this_year (enumFrom (fromGregorian yr 1 1))));
is_prime_day :: Day -> Day -> IO(Bool);
is_prime_day start today = (is_prime (diffDays today start));
get_prime_days :: Day -> Integer -> IO([](Day));
get_prime_days start yr = (filterM (is_prime_day start) (days_of_the_year yr));
its_your_birthday :: Day -> Day -> Bool;
its_your_birthday x y = (case ((toGregorian x), (toGregorian y)) of {
  ((_, xm, xd), (_, ym, yd))-> ((&&) ((==) xm ym) ((==) xd yd))
});
show_day :: Day -> String;
show_day d = ((show d) ++ " " ++ (formatTime defaultTimeLocale "%A" d))
}