aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/Main.hs~127
1 files changed, 0 insertions, 127 deletions
diff --git a/src/Main.hs~ b/src/Main.hs~
deleted file mode 100644
index 81ef417..0000000
--- a/src/Main.hs~
+++ /dev/null
@@ -1,127 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-
-import Data.UUID.V4
-import System.Directory
-import Control.Monad.Extra
-import Data.UUID
-import Data.Char
-import Data.Generics
-import Data.Maybe
-import Data.Text (Text)
-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
-import Network.HostName
-import System.Random
-import System.FilePath
-
-data FeedMetadata = FeedMetadata
- { title :: Text,
- author :: Maybe Text,
- home :: Maybe Text
- }
- deriving (Show)
-
-data Message = Message
- { from :: Text,
- subject :: Text,
- date :: Text,
- messageId :: Text,
- body :: Text
--- newsGroup :: Text
- }
- deriving (Show)
-
-formatMessage :: Message -> Text
-formatMessage (Message from subject date messageId body) =
- "MIME-Version: 1.0\n" <> "Date: " <> date <> "\nSubject: " <> subject <>
- "\nFrom: " <> from <> "\nMessage-ID: " <> messageId <>
- "\nContent-Type: text/html" <> "\n\n" <> body
-
-getItemAuthor' :: Item -> Maybe Text
-getItemAuthor' item = case getItemAuthor item of
- Just "" -> Nothing
- 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 "" home) (snd <$> getItemId item)
- return $ Message
- (fromMaybe title $ orElse (getItemAuthor' item) author)
- (fromMaybe "Untitled" $ getItemTitle item)
- (fromMaybe "" $ getItemDate item) -- default should be current date
- messageId
- (formatBody (getItemLink item) $
- (getItemContent item) `orElse` (getItemContent' item) `orElse`
- (getItemDescription item))
--- title
-
-formatBody :: Maybe Text -> Maybe Text -> Text
-formatBody link desc =
- let linkText = case link of
- Nothing -> ""
- Just link' -> "Link: " <> link' <> "\n\n" in
- linkText <> (fromMaybe "" desc)
-
-toFeedMetadata :: Feed -> FeedMetadata
-toFeedMetadata feed =
- FeedMetadata (getFeedTitle feed) (getFeedAuthor feed) (getFeedHome feed)
-
-genFilename :: FilePath -> IO String
-genFilename root = do
- epoch <- formatTime defaultTimeLocale "%s" <$> getCurrentTime
- pid <- getProcessID
- host <- getHostName
- rand <- randomRIO (10000, 99999) :: IO Int
- return $ root </> "new" </> epoch <> "." <> show pid <> "." <>
- host <> "." <> show rand
-
-genUniqFilename :: FilePath -> IO String
-genUniqFilename root = do
- filename <- genFilename root
- exists <- fileExist filename
- if exists then genUniqFilename root else return filename
-
-hyphenateNonAlNum :: Char -> Char
-hyphenateNonAlNum c
- | isAlphaNum c = c
- | otherwise = '-'
-
-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" <> ">"
-
-writeMessage :: FilePath -> Message -> IO ()
-writeMessage root msg =
- genUniqFilename root >>=
- \filename -> writeFile filename $ T.unpack (formatMessage msg)
-
-main :: IO ()
-main = do
- feed <- parseFeedFromFile "./stallman.xml"
- let root = "./maildir"
- mapM_ (createDirectoryIfMissing True)
- [root </> "new", root </> "cur", root </> "tmp"]
- whenJust feed $
- \feed' ->
- mapM_ (\msg ->
- writeMessage root =<< toMessage (toFeedMetadata feed') msg)
- (getFeedItems feed')