#!/usr/bin/env runhaskell

import System.Environment (getArgs)
import qualified Control.Monad.State as S
import Control.Monad (sequence)

import Text.Feed.Constructor
import Text.Feed.Util
import Text.Feed.Export
import Text.Feed.Types

import Text.Pandoc
import Text.Pandoc.Pretty

import qualified System.Time as T
import qualified System.Posix.Files as F
import qualified Text.XML.Light.Output as X
import qualified System.FilePath as FP
import System.Posix.Types

import Data.Maybe (fromMaybe)
import Data.List (dropWhileEnd, isSuffixOf)

type FeedState = (Feed, Maybe T.ClockTime)

feedKind = RSSKind $ Just "2.0"

extract_title :: Pandoc -> String
extract_title d@(Pandoc m _) = do
  title <- render Nothing $ cat $ map pretty (docTitle m)
  return title
    where pretty :: Inline -> Doc
          pretty (Str s) = text s
          pretty Space = space
          pretty _ = empty

main :: IO ()
main = do
  (title:entries) <- getArgs
  currentTime <- T.getClockTime
  let feed = withFeedHome "http://dirty-haskell.org" $ withFeedTitle title $ newFeed feedKind
  (populatedFeed, itemTime) <- S.execStateT (sequence $ map addItem' entries) (feed, Nothing)
  let populatedFeed' = withFeedDate (toFeedDateString feedKind $ fromMaybe currentTime itemTime) populatedFeed
  putStrLn $ X.ppElement $ xmlFeed populatedFeed'

addItem' :: FilePath -> S.StateT FeedState IO ()
addItem' mdFile = do
  url <- S.liftIO $ mkUrl mdFile
  fileStatus <- S.liftIO $ F.getSymbolicLinkStatus mdFile
  fileContents <- S.liftIO $ readFile mdFile
  let title = extract_title $ document
      contents = writeAsciiDoc def document
      document = readMarkdown def fileContents
  (feed, time) <- S.get
  let fileTime = maximum ([F.modificationTime, F.statusChangeTime] <-> fileStatus) :: System.Posix.Types.EpochTime
      fileTime' = T.TOD (toInteger $ fromEnum fileTime) 0
  let item = [ withItemTitle title
             , withItemLink url
             , withItemDate $ toFeedDateString feedKind fileTime'
             , withItemDescription contents
             ] <--> (newItem feedKind) :: Item
  S.put (addItem item feed, if (Just fileTime' > time) then Just fileTime' else time)

mkUrl :: FilePath -> IO String
mkUrl link = do
  status <- F.getSymbolicLinkStatus link
  if F.isSymbolicLink status then
    do target <- F.readSymbolicLink link
       mkUrl $ FP.combine (FP.takeDirectory link) target
    else
    return $ mkUrl' link
mkUrl' :: FilePath -> String
mkUrl' path = (++) "http://dirty-haskell.org/posts/" $ (flip FP.replaceExtension) "html" $ FP.takeFileName path

(<->) :: [(a -> b)] -> a -> [b]
[] <-> _ = []
(f:fs) <-> x = (f x:fs <-> x)

(<-->) :: [(a -> a)] -> a -> a
[] <--> x = x
(f:fs) <--> x = fs <--> (f x)