Now generating RSS feeds for all lists

1 files changed, 82 insertions, 0 deletions

diff --git a/build/generate-rss.hs b/build/generate-rss.hs
new file mode 100755
index 0000000..18d2d6f
--- /dev/null
+++ b/build/generate-rss.hs
@@ -0,0 +1,82 @@
+#!/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 "test" -- DEBUG
+
+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.getFileStatus 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.getFileStatus link
+  if F.isSymbolicLink status then
+    F.readSymbolicLink link >>= mkUrl
+    else
+    return $ mkUrl' link
+mkUrl' :: FilePath -> String
+mkUrl' path = (++) "http://dirty-haskell.org/posts/" $ switchExt ".md" ".html" $ FP.takeFileName path
+
+switchExt prev after str = if ('.':prev) `isSuffixOf` str then (dropWhileEnd (/= '.') str) ++ after else str
+
+(<->) :: [(a -> b)] -> a -> [b]
+[] <-> _ = []
+(f:fs) <-> x = (f x:fs <-> x)
+
+(<-->) :: [(a -> a)] -> a -> a
+[] <--> x = x
+(f:fs) <--> x = fs <--> (f x)