import Data.Maybe (fromJust, fromMaybe)
import Data.List (intercalate)
import Control.Monad (when)

import Data.Time
import System.Locale

import System.Console.ZipEdit

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

import Text.Feed.Import
import Text.RSS.Syntax
import Text.Feed.Types

import System.IO
import System.Cmd

planetURL = "http://planet.haskell.org/rss20.xml"

-- | The status of a post.
data Status = N    -- ^ Normal
            | NP   -- ^ Non-Planet, i.e. not a normal member of the community
            | H    -- ^ Highlighted
  deriving (Read, Show)

defaultDay :: Day
defaultDay = fromJust $ parseTime defaultTimeLocale "%a, %d %b %Y" "Mon, 01 Jan 2000"

-- | An item from Planet Haskell.
data PItem = PItem { date   :: Day       -- ^ publication date (for sorting)
                   , author :: String    -- ^ author
                   , title  :: String    -- ^ title of the post
                   , desc   :: String    -- ^ editorial summary
                   , url    :: String    -- ^ link
                   , status :: Status

                   , body   :: String    -- ^ actual text of the post
                   , use    :: Bool      -- ^ should we use this one?
                   }

-- | Create a PItem out of an RSS item.
mkItem :: RSSItem -> PItem
mkItem r = PItem { date   = fromMaybe defaultDay $ extractDate r
                 , author = extractAuthor r
                 , title  = extractTitle r
                 , desc   = ""
                 , url    = fromMaybe "" $ rssItemLink r
                 , status = N
                 , body   = fromMaybe "" $ extractBody r
                 , use    = False
                 }

-- | Get the publication date from an RSS item.
extractDate :: RSSItem -> Maybe Day
extractDate r = do
  pd <- rssItemPubDate r
  parseTime defaultTimeLocale "%a, %d %b %Y" . unwords . take 4  . words $ pd

extractAuthor :: RSSItem -> String
extractAuthor = fromMaybe "" . rssItemAuthor

extractTitle :: RSSItem -> String
extractTitle = fromMaybe "" . rssItemTitle

extractBody :: RSSItem -> Maybe String
extractBody r = rssItemDescription r >>= \rid ->
  Just . unwords . words . concat $ [ e | TagText e <- parseTags rid ]

yes :: PItem -> PItem
yes fi = fi { use = True }

no :: PItem -> PItem
no fi = fi { use = False }

setAuthor :: String -> PItem -> PItem
setAuthor a fi = fi { author = a }

setDesc :: String -> PItem -> PItem
setDesc d fi = fi { desc = d }

setStatus :: Status -> PItem -> PItem
setStatus s fi = fi { status = s }

setTitle :: String -> PItem -> PItem
setTitle t fi = fi { title = t }

-- | If the title is of the form "Foo: Bar", set the author field to
-- | "Foo" and the title to "Bar".
stripAuthor :: PItem -> PItem
stripAuthor i = i { author = newAuthor
                  , title  = newTitle
                  }
  where (newAuthor, newTitle) | ':' `elem` (title i)
                              = (takeWhile (/=':') $ title i,
                                 drop 2 . dropWhile (/=':') $ title i)
                              | otherwise = (author i, title i)

-- | Format an item for display to the user, showing the given nubmer
-- | of words from the body of the post.
showItem :: Int -> PItem -> String
showItem n i = concat [ title i, " (", author i, ", ", show $ date i, ") "
                      , show $ status i
                      , "\n"
                      , if (null (desc i))
                          then (unwords . take n . words $ body i)
                          else "\"" ++ (unwords . words $ desc i) ++ "\""
                      ]

ec :: EditorConf PItem
ec = EC { display = maybe "" (showItem 30)
        , prompt  = maybe "" (\fi -> (if use fi then "\n***> " else "\n   > ") ++ "? ")
        , actions = [ ('y', Modify yes
                            ?? "Use the current post.")
                    , ('n', Seq [Modify no, Fwd]
                            ?? "Don't use the current post, and move on to the next." )
                    , ('p', Output (showItem 100)
                            ?? "Show more of the current post." )
                    , ('a', ModifyWInp "Author: " setAuthor
                            ?? "Specify the author.")
                    , ('A', Modify stripAuthor
                            ?? "Automatically separate a title in Author: Title format.")
                    , ('t', ModifyWInp "Title: " setTitle
                            ?? "Specify the title.")
                    , ('N', Modify (setStatus N)
                            ?? "Set post to N (normal) status.")
                    , ('P', Modify (setStatus NP)
                            ?? "Set post to NP (non-Planet Haskell) status.")
                    , ('H', Modify (setStatus H)
                            ?? "Set post to H (highlighted) status.")
                    , ('u', ModifyWEditor (\p -> desc p ++ "\n\n" ++ body p) setDesc
                            ?? "Start an external editor to create a short summary or comment on the post.")
                    ]
                    ++ stdActions
        }

main = do
  RSSFeed rss <- (fromJust . parseFeedString) `fmap` openURL planetURL
  let items = map mkItem . rssItems . rssChannel $ rss
  ml <- edit ec items
  case ml of
    Nothing     -> return ()
    Just items' -> do
      f <- openFile "blogs.wiki" WriteMode
      hPutStr f . intercalate ",\n\n" . map fmt . filter use $ items'
      hClose f

fmt :: PItem -> String
fmt i = intercalate "\n" $
          [ "Post"
          , quote $ show (date i)
          , show (author i)
          , show (title i)
          , show (unwords . words $ desc i)
          , show (url i)
          , show (status i)
          ]

quote x = "\"" ++ x ++ "\""