diff options
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')  | 
