fixed content

1 files changed, 34 insertions, 17 deletions

diff --git a/Main.hs b/Main.hs
index 1ace401..5b9b021 100644
--- a/Main.hs
+++ b/Main.hs
@@ -1,6 +1,8 @@
 {-# LANGUAGE OverloadedStrings #-}
 
 import Data.UUID.V4
+import System.Directory
+import Control.Monad.Extra
 import Data.UUID
 import Data.Char
 import Data.Generics
@@ -10,6 +12,8 @@ import qualified Data.Text as T
 import Text.Feed.Import
 import Text.Feed.Query
 import Text.Feed.Types
+import Text.RSS.Syntax hiding (RSSItem)
+import Data.XML.Types
 import Data.Time
 import System.Posix.Process
 import System.Posix.Files
@@ -46,16 +50,24 @@ getItemAuthor' item = case getItemAuthor item of
   Just author -> Just author
   Nothing -> Nothing
 
+getItemContent' :: Item -> Maybe Text
+getItemContent' (RSSItem item) =
+  (fmap (T.concat . elementText) . listToMaybe .
+   filter (\e -> namePrefix (elementName e) == Just "content"))
+  $ rssItemOther item
+getItemContent' _ = Nothing
+
 toMessage :: FeedMetadata -> Item -> IO Message
 toMessage (FeedMetadata title author home) item = do
-  messageId <- genMessageId (fromMaybe "" $ T.unpack <$> home)
-               (T.unpack . snd <$> getItemId item)
+  messageId <- genMessageId (fromMaybe "" home) (snd <$> getItemId item)
   return $ Message
     (fromMaybe title $ orElse (getItemAuthor' item) author)
     (fromMaybe "Untitled" $ getItemTitle item)
     (fromMaybe "" $ getItemDate item) -- default should be current date
-    (T.pack messageId)
-    (formatBody (getItemLink item) (getItemDescription item))
+    messageId
+    (formatBody (getItemLink item) $
+     (getItemContent item) `orElse` (getItemContent' item) `orElse`
+     (getItemDescription item))
 --    title
 
 formatBody :: Maybe Text -> Maybe Text -> Text
@@ -75,7 +87,8 @@ genFilename root = do
   pid <- getProcessID
   host <- getHostName
   rand <- randomRIO (10000, 99999) :: IO Int
-  return $ root </> "new" </> epoch <> "." <> show pid <> "." <> host <> "." <> show rand
+  return $ root </> "new" </> epoch <> "." <> show pid <> "." <>
+    host <> "." <> show rand
 
 genUniqFilename :: FilePath -> IO String
 genUniqFilename root = do
@@ -88,26 +101,30 @@ hyphenateNonAlNum c
   | isAlphaNum c = c
   | otherwise = '-'
 
-genMessageId :: String -> Maybe String -> IO String
+genMessageId :: Text -> Maybe Text -> IO Text
 genMessageId feedLink guid = do
   id <- case guid of
-          Just guid' -> return $ hyphenateNonAlNum <$> guid'
-          Nothing -> show <$> nextRandom
-  return $ id ++ "@" ++ (hyphenateNonAlNum <$> feedLink) ++ "gnu"
+          Just guid' -> return $ T.map hyphenateNonAlNum guid'
+          Nothing -> toText <$> nextRandom
+  return $ id <> "@" <> (T.map hyphenateNonAlNum feedLink) <> ".gnu"
 
 -- for testing purposes
 writeFirstItem :: [Text] -> IO ()
 writeFirstItem msgs =
   writeFile "./firstMsg" $ T.unpack $ head $ msgs
 
+writeMessage :: FilePath -> Message -> IO ()
+writeMessage root msg =
+  genUniqFilename root >>=
+  \filename -> writeFile filename $ T.unpack (formatMessage msg)
+
 main :: IO ()
 main = do
   feed <- parseFeedFromFile "./plug.xml"
-  case feed of
-    Just feed' ->
-       mapM (fmap formatMessage . toMessage (toFeedMetadata feed')) (getFeedItems feed') >>= writeFirstItem
-    Nothing -> return ()
-  -- print $ do
-  -- writeFirstItem $ do
-  --   feed' <- feed
-  --   return $ formatMessage <$> toMessage (toFeedMetadata feed') <$> getFeedItems feed'
+  let root = "."
+  createDirectoryIfMissing True root
+  whenJust feed $
+    \feed' ->
+      mapM_ (\msg -> 
+               writeMessage root =<< toMessage (toFeedMetadata feed') msg)
+      (getFeedItems feed')