1 files changed, 38 insertions, 35 deletions

diff --git a/src/F2Md/Import.hs b/src/F2Md/Import.hs
index 3ed4d2f..8dfdb40 100644
--- a/src/F2Md/Import.hs
+++ b/src/F2Md/Import.hs
@@ -1,7 +1,9 @@
 {-# LANGUAGE OverloadedStrings #-}
 
-module F2Md.Import (toMessagesFromFile, toMessagesFromUrl) where
+module F2Md.Import (toMessagesFromUrl) where
 
+import Data.List
+import Data.Text.Encoding
 import Control.Monad
 import Data.Time
 import System.Process
@@ -19,22 +21,16 @@ import Data.XML.Types
 import Text.Feed.Import
 import Text.Feed.Types
 import F2Md.Types
-
-toMessagesFromFile :: Text -> FilePath -> IO [Message]
-toMessagesFromFile url file = do
-  feed <- parseFeedFromFile file
-  case feed of
-    Nothing -> return []
-    Just feed' ->
-      mapM (\msg -> toMessage (toFeedMetadata feed' url) msg) (getFeedItems feed')
+import Crypto.Hash
 
 toMessagesFromUrl :: Text -> Maybe ZonedTime -> IO [Message]
 toMessagesFromUrl url after = do
   feed <- parseFeedString <$> (fetchFeed $ T.unpack url)
   case feed of
     Nothing -> return []
-    Just feed' -> catMaybes <$>
-      mapM (\msg -> toMessage' after (toFeedMetadata feed' url) msg) (getFeedItems feed')
+    Just feed' -> return $
+      sortOn (\msg -> zonedTimeToUTC (mDate msg)) $ catMaybes $
+      toMessage' after (toFeedMetadata feed' url) <$> getFeedItems feed'
 
 wgetCommand :: String
 wgetCommand = "wget -O- 2>/dev/null"
@@ -42,26 +38,31 @@ wgetCommand = "wget -O- 2>/dev/null"
 fetchFeed :: String -> IO String
 fetchFeed url = readCreateProcess (shell $ wgetCommand ++ " " ++ url) ""
 
-toMessage' :: Maybe ZonedTime -> FeedMetadata -> Item -> IO (Maybe Message)
+toMessage' :: Maybe ZonedTime -> FeedMetadata -> Item -> Maybe Message
 toMessage' after feed item
-  | isNothing date = return Nothing
-  | isNothing after = toMessage feed item >>= return . Just
-  | zonedTimeToUTC (fromJust after) >= fromJust date = return Nothing
-  | otherwise = toMessage feed item >>= return . Just
+  | isNothing date = Nothing
+  | isNothing after = Just $ toMessage feed item
+  | zonedTimeToUTC (fromJust after) >= fromJust date = Nothing
+  | otherwise = Just $ toMessage feed item
   where date = join $ getItemPublishDate item
 
-toMessage :: FeedMetadata -> Item -> IO Message
-toMessage (FeedMetadata title author home url) item = do
-  messageId <- genMessageId (fromMaybe "" home) (snd <$> getItemId item)
-  return $ Message
+toMessage :: FeedMetadata -> Item -> Message
+toMessage (FeedMetadata title author home url) item =
+  Message
     (fromMaybe title $ orElse (getItemAuthor' item) author)
     (fromMaybe "Untitled" $ getItemTitle item)
     (fromJust $ join $ getItemPublishDate item) -- default should be current date
     messageId
-    (formatBody (getItemLink item) $
-     (getItemContent item) `orElse` (getItemContent' item) `orElse`
-     (getItemDescription item))
+    body
     url
+  where body =
+          (formatBody (getItemLink item) (getItemEnclosure item) $
+            (getItemContent item) `orElse` (getItemContent' item) `orElse`
+            (getItemDescription item))
+        messageId =
+          "<" <> (T.pack $ show $ hashWith MD5 (encodeUtf8 body)) <> "@" <>
+          (T.map hyphenateNonAlNum url) <> ".gnu" <> ">"
+
 
 getItemAuthor' :: Item -> Maybe Text
 getItemAuthor' item = case getItemAuthor item of
@@ -76,25 +77,27 @@ getItemContent' (RSSItem item) =
   $ rssItemOther item
 getItemContent' _ = Nothing
 
-formatBody :: Maybe Text -> Maybe Text -> Text
-formatBody link desc =
+formatBody :: Maybe Text -> Maybe (Text, Maybe Text, Maybe Integer) -> Maybe Text -> Text
+formatBody link encl desc =
   let linkText = case link of
         Nothing -> ""
-        Just link' -> "Link: " <> link' <> "\n\n" in
-    linkText <> (fromMaybe "" desc)
+        Just link' -> "Link: <" <> link' <> ">\n\n"
+      enclText = case encl of
+        Nothing -> ""
+        Just (url, Nothing, Nothing) -> urlPt url <> "\n\n"
+        Just (url, Just ty, Nothing) -> urlPt url <> " (" <> ty <> ")\n\n"
+        Just (url, Nothing, Just len) -> urlPt url <> " (" <> lenPt len <> ")\n\n"
+        Just (url, Just ty, Just len) ->
+          urlPt url <> " (" <> ty <> ", " <> lenPt len <> ")\n\n"
+        where urlPt url = "Enclosure: <" <> url <> ">"
+              lenPt len = (T.pack $ show len) <> " bytes"
+  in
+    linkText <> enclText <> (fromMaybe "" desc)
 
 toFeedMetadata :: Feed -> Text -> FeedMetadata
 toFeedMetadata feed url =
   FeedMetadata (getFeedTitle feed) (getFeedAuthor feed) (getFeedHome feed) url
 
-genMessageId :: Text -> Maybe Text -> IO Text
-genMessageId feedLink guid = do
-  id <- case guid of
-          Just guid' -> return $ T.map hyphenateNonAlNum guid'
-          Nothing -> toText <$> nextRandom
-  return $
-    "<" <> id <> "@" <> (T.map hyphenateNonAlNum feedLink) <> ".gnu" <> ">"
-
 hyphenateNonAlNum :: Char -> Char
 hyphenateNonAlNum c
   | isAlphaNum c = c