diff options
| -rw-r--r-- | Main.hs | 51 |
1 files changed, 34 insertions, 17 deletions
@@ -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') |