import Text.HTML.Download
import Text.Printf

import Data.Time
import Data.List
import Data.Maybe
import Control.Monad (liftM2)

import System.Console.ZipEdit

import System.IO

data Quote = Quote { nick :: String
                   , text :: String
                   , day  :: Day
                   }
  deriving (Read, Show)

data FlaggedQuote = FQ { quote :: Quote
                       , use   :: Bool
                       }

yes (FQ q _) = FQ q True
no  (FQ q _) = FQ q False
mkFQ q = FQ q False

showQuote :: Quote -> String
showQuote q = nick q ++ ": " ++ text q ++ "\n(" ++ show (day q) ++ ")\n"

ec :: EditorConf FlaggedQuote
ec = EC { display = maybe "No quotes." (showQuote . quote)
        , prompt  = maybe "   >" (\fq -> if use fq then "***> " else "   > ")
        , actions = [ ('y', Seq [Modify yes, Fwd] ?? "Use this quote.")
                    , ('n', Seq [Modify no,  Fwd] ?? "Don't use this quote.")
                    ]
                    ++ stdActions
        }

fmtDay :: Day -> String
fmtDay d = printf "%02d.%02d.%02d" (y-2000) m dt
  where (y,m,dt) = toGregorian d

url :: Day -> String
url d = "http://tunes.org/~nef/logs/haskell/" ++ fmtDay d

extractQuote :: Day -> String -> Maybe Quote
extractQuote d s = do
  s' <- maybeTail $ dropWhile (\w -> w `notElem` ["remember", "@remember"]) (words s)
  n  <- maybeHead s'
  t  <- unwords `fmap` maybeTail s'
  return $ Quote n t d

maybeHead [] = Nothing
maybeHead (x:_) = Just x

maybeTail [] = Nothing
maybeTail (_:xs) = Just xs

decDay :: Day -> Day
decDay = addDays (-1)

getQuotes :: Day -> IO ([FlaggedQuote],Day)
getQuotes d = do
  page <- openURL (url d)
  let qs = mapMaybe (fmap mkFQ . extractQuote d) . filter isQuote . lines $ page
  if null qs
    then getQuotes (decDay d)
    else return (reverse qs,decDay d)

isQuote :: String -> Bool
isQuote = liftM2 (||) ("@remember " `isInfixOf`) ("preflex: remember " `isInfixOf`)

getMoreQuotes :: Day -> IO ([FlaggedQuote], Maybe (LCont FlaggedQuote))
getMoreQuotes d = fmap (\(qs,d') -> (qs, Just (LC $ getMoreQuotes d'))) $
                    getQuotes d

main = do
  d <- utctDay `fmap` getCurrentTime
  (quotes,d') <- getQuotes d
  ml <- editWCont ec quotes (getMoreQuotes d')
  case ml of
    Nothing -> return ()
    Just quotes' -> do
      f <- openFile "quotes.wiki" WriteMode
      hPutStr f . intercalate ",\n\n" . map (fmt.quote) . filter use $ quotes'
      hClose f

fmt :: Quote -> String
fmt q = concat [ "Quote\n", show (nick q), "\n", show . munge $ text q ]
  where munge = concatMap m
        m '<' = "&lt;"
        m '>' = "&gt;"
        m x = [x]