blob: 1ace4018bd25432481bd0a3d0fbbeb9e41524975 (
plain) (
blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
|
{-# LANGUAGE OverloadedStrings #-}
import Data.UUID.V4
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 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
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) -- 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) (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 :: [Text] -> IO ()
writeFirstItem 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'
|
