message id and filename

1 files changed, 71 insertions, 30 deletions

diff --git a/Main.hs b/Main.hs
index 1f56a14..1ace401 100644
--- a/Main.hs
+++ b/Main.hs
@@ -1,16 +1,26 @@
 {-# LANGUAGE OverloadedStrings #-}
 
+import Data.UUID.V4
+import Data.UUID
+import Data.Char
 import Data.Generics
 import Data.Maybe
 import Data.Text (Text)
-import Data.Text qualified as T
+import qualified Data.Text as T
 import Text.Feed.Import
 import Text.Feed.Query
 import Text.Feed.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
+    author :: Maybe Text,
+    home :: Maybe Text
   }
   deriving (Show)
 
@@ -19,25 +29,16 @@ data Message = Message
     subject :: Text,
     date :: Text,
     messageId :: Text,
-    body :: Text,
-    newsGroup :: Text
+    body :: Text
+--    newsGroup :: Text
   }
   deriving (Show)
 
 formatMessage :: Message -> Text
-formatMessage (Message from subject date messageId body newsGroup) =
-  T.concat
-    [ "Date: ",
-      date,
-      "\nMessage-ID: ",
-      messageId,
-      "\nSubject: ",
-      subject,
-      "\nFrom: ",
-      from,
-      "\n\n",
-      body
-    ]
+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
@@ -45,28 +46,68 @@ getItemAuthor' item = case getItemAuthor item of
   Just author -> Just author
   Nothing -> Nothing
 
-toMessage :: FeedMetadata -> Item -> Message
-toMessage (FeedMetadata title author) item =
-  Message
+toMessage :: FeedMetadata -> Item -> IO Message
+toMessage (FeedMetadata title author home) item = do
+  messageId <- genMessageId (fromMaybe "" $ T.unpack <$> home)
+               (T.unpack . snd <$> getItemId item)
+  return $ Message
     (fromMaybe title $ orElse (getItemAuthor' item) author)
     (fromMaybe "Untitled" $ getItemTitle item)
-    (fromMaybe "" $ getItemDate item)
-    (fromMaybe "" $ snd <$> getItemId item)
-    (fromMaybe "" $ getItemDescription item)
-    title
+    (fromMaybe "" $ getItemDate item) -- default should be current date
+    (T.pack messageId)
+    (formatBody (getItemLink item) (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)
+  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 :: String -> Maybe String -> IO String
+genMessageId feedLink guid = do
+  id <- case guid of
+          Just guid' -> return $ hyphenateNonAlNum <$> guid'
+          Nothing -> show <$> nextRandom
+  return $ id ++ "@" ++ (hyphenateNonAlNum <$> feedLink) ++ "gnu"
 
 -- for testing purposes
-writeFirstItem :: Maybe [Text] -> IO ()
+writeFirstItem :: [Text] -> IO ()
 writeFirstItem msgs =
-  writeFile "./firstMsg" $ T.unpack $ head $ fromMaybe [""] msgs
+  writeFile "./firstMsg" $ T.unpack $ head $ msgs
 
+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'
+  -- writeFirstItem $ do
+  --   feed' <- feed
+  --   return $ formatMessage <$> toMessage (toFeedMetadata feed') <$> getFeedItems feed'