module Main where

import Text.HTML.TagSoup
import Text.HTML.Download

import Text.PrettyPrint.HughesPJ
import Text.Printf
import Text.Regex (mkRegex, matchRegex)
import Data.Char (isSpace, isDigit, isPrint)
import Data.Maybe (mapMaybe)

import qualified Data.Map as M

import Data.Time.Calendar as Calendar
import Data.Time.Calendar.WeekDate (toWeekDate)

import Graphics.Rendering.HSparklines

import Control.Monad
import Control.Arrow hiding ((<+>), (+++))
import System.Time
import System.Environment
import System.Console.GetOpt
import System.Exit

data Output = Statistics | Weekly | Monthly | Pending | Help | Version | Catchup Int | Chart FilePath

data Page = P { pageHeader  :: String
              , pageFooter  :: String
              , bookDetails :: Book
              } deriving (Show)
type Details = (String,Score)
type Score = (Int,Int)

data Recipe = Recipe { done     :: Bool
                     , url      :: String
                     , recipe   :: String }
                deriving (Eq,Show)
data Chapter a = Chapter { chapterTitle     :: String
                         , chapterContents  :: a }
                deriving (Eq, Show)

instance Functor Chapter where
    fmap f (Chapter t c) = Chapter t (f c)

type Book = [Chapter [Recipe]]

chapterStats :: Chapter [Recipe] -> Score
chapterStats ch = (length . filter done &&& length) $ chapterContents ch

bookStats :: Book -> [(String,Score)]
bookStats bk = map (chapterTitle &&& chapterStats) bk

overallStats :: Book -> Score
overallStats = foldr f (0,0) . map snd . bookStats
    where f (a,b) (c,d) = (a+c,b+d)

recipesPending :: Book -> Book
recipesPending = map (fmap (filter (not.done)))

recipesUrl = "http://www.helenhare.net/food/index.php/challenge/"

nigella :: IO Book
nigella = do
    tags <- parseTags `liftM` openURL recipesUrl
    return $ map (\d -> Chapter (chapTitle d) (mkR . rs $ d)) $ splitIntoChapters $ extractEntry tags 
    where
        extractEntry = takeWhile (~/= "</div>") . head . sections (~== "<div class=\"entry\">")
        splitIntoChapters = partitions (~== "<h3>")

        -- separate tags at <li>
        rs :: [Tag] -> [[Tag]]
        rs = partitions (isTagOpenName "li")
        -- make Recipes from list items
        mkR :: [[Tag]] -> [Recipe]
        mkR = map (\r -> Recipe { done = any (isTagOpenName "a") r, recipe = cleanStr (innerText r), url = extrUrl r})

        cleanStr = takeWhile (isPrint) . dropWhile (isSpace) . map (\c -> if c=='\n' then ' ' else c)
        chapTitle = fromTagText . flip (!!) 1
        extrUrl ts = case filter (isTagOpenName "a") ts of
                        []      -> ""
                        (t:_)   -> fromAttrib "href" t

monthlyStats :: Book -> [(Month,Int)]
monthlyStats =  M.toList . M.fromListWith (+) . map (flip (,) 1) . convertToMonth

weeklyStats :: Book -> [(Int,Int)]
weeklyStats bk = M.toList $ M.fromListWith (+) $ baseline ++ [(w,1)| w <- wks]
    where baseline = [(w,0)| w <- [1..(maximum wks)]]
          wks = convertToWeek bk

regex :: String -> Maybe [String]
regex = matchRegex (mkRegex "([[:digit:]]{4})/([[:digit:]]{2})/([[:digit:]]{2})/(.*)/") . dropWhile (not . isDigit)

regexStringToDay :: [String] -> Calendar.Day
regexStringToDay (y:m:d:_) = fromGregorian (read y) (read m) (read d)

stringToMonth :: String -> Month
stringToMonth = toEnum . pred . read
stringToWeekNum :: [String] -> Int
stringToWeekNum = (\(_,wk,_) -> wk) . toWeekDate . regexStringToDay

convertToWeek :: Book  -> [Int]
convertToWeek = map stringToWeekNum . mapMaybe regex . concatMap (map url . chapterContents)

convertToMonth :: Book -> [Month]
convertToMonth = map (\(_:m:_) -> stringToMonth m) . mapMaybe regex . concatMap ((map url) . chapterContents)

ppMonthly :: [(Month,Int)] -> Doc
ppMonthly stats = vcat $ map (\(s,i) -> field (show s) (int i)) stats
    where field l r = text l <> text (replicate (15 - length l) ' ') <> r

ppWeekly :: [(Int,Int)] -> Doc
ppWeekly = vcat . map (\(wk,num) -> int wk <+> int num)

ppTextBook :: Book -> Doc
ppTextBook bk = vcat $ map (ppTextChapter . fmap (map ppTextRecipe)) bk
    where ppTextChapter :: Chapter [Doc] -> Doc
          ppTextChapter ch = vcat $ text (chapterTitle ch) : chapterContents ch
          ppTextRecipe :: Recipe -> Doc
          ppTextRecipe r = text " - " <> text (recipe r)

ppTextLine :: Details -> Doc
ppTextLine (title,(done,total)) = chaptertitle <> fractiondone <+> equals <+> percentage
    where lalign s = text s <> text (replicate (20 - length s) ' ')
          ralign n = text (replicate (3 - length (show n)) ' ') <> int n

          chaptertitle = lalign title
          fractiondone = ralign done <> char '/' <> ralign total
          percentage   = ralign (done %% total) <> char '%'

ppText :: Page -> Doc
ppText pg = intro $$ details $$ outro
    where details = vcat $ map ppTextLine $ bookStats $ bookDetails pg
          intro   = text $ pageHeader pg
          outro   = text $ pageFooter pg


(%%) :: (Integral a) => a -> a -> a
(%%) n d = round $ (100 * fromIntegral n) / fromIntegral d


writeChart :: [(Int,Int)] -> FilePath -> IO ()
writeChart stats filename = make opts vals' >>= savePngFile filename
    where vals = map (snd) stats
          vals' = map fromIntegral vals
          opts = barSpark { height = 30, limits = (0,maximum vals) }

parseArgs :: IO Output
parseArgs = do
    args <- getArgs
    if null args
        then return Statistics
        else case getOpt Permute options args of
                ([o],_,[]) -> return o
                (_,_,[])   -> error usage
                (_,_,errs) -> error (concat errs ++ usage)

version :: String
version = "Nigella Food Challenge, v0.4"
usage :: String
usage = usageInfo header options
    where header = unlines ["Usage: nigella [OPTION]"
                           ,"Show the progress of the challenge by reading the Challenge"
                           ,"section of the website at helenhare.net/food/"]

options :: [OptDescr Output]
options =
    [ Option "h" ["help"]  (NoArg Help) "Usage information"
    , Option "t" ["text"]  (NoArg Statistics) "Text output (default)"
    , Option "m" ["monthly"] (NoArg Monthly) "Monthly statistics"
    , Option "w" ["weekly"] (NoArg Weekly) "Weekly statistics"
    , Option "s" ["sparkline"] (ReqArg (Chart) "FILE") "Write mini barchart to FILE"
    , Option "v" ["version"] (NoArg Version) "Version number"
    , Option "c" ["catchup"] (ReqArg (Catchup . read) "N") "Catch up in N days"
    , Option "p" ["pending"] (NoArg Pending) "Print recipes pending"
    ]

main = do
    output <- parseArgs
    book <- nigella
    today <- (succ . ctYDay) `liftM` (getClockTime >>= toCalendarTime)

    let header = "'Nigella Express' Challenger"
        footer = summaryStatement today book
    
    case output of
                Statistics  -> putStrLn $ render $ ppText (P header footer book)
                Monthly     -> putStrLn $ render $ ppMonthly $ monthlyStats book
                Weekly      -> putStrLn $ render $ ppWeekly $ weeklyStats book
                Pending     -> putStrLn $ render $ ppTextBook $ recipesPending book
                Catchup n   -> putStrLn $ verdict today n book
                Chart file  -> writeChart (weeklyStats book) file
                Help        -> putStrLn usage
                Version     -> putStrLn version

summaryStatement :: Int -> Book -> String
summaryStatement day bk = msg1 ++ '\n' : msg2
    where (done,total) = overallStats bk
          taskspercent = done %% total
          timepercent = day %% 366
          msg1 = printf "We have cooked %d recipes in %d days" done day
          msg2 = printf "This is %d%% of the book in %d%% of the year" taskspercent timepercent

verdict :: Int -> Int -> Book -> String
verdict day target bk = reachparity (overallStats $ bk) (day,366) target

-- Number of recipes done, total num of recipes
-- Number of days passed, total num of days
-- Number of days in which to catch up
reachparity (done,total) (days,year) duration =
    if target > 0
        then printf "You need to cook %d recipes in %d days to break even!" target duration
        else "You're not behind schedule..."
    where target = (total * newdays `div` year) - done
          newdays = days + duration