blob: ee68578ea8c30a053fa353b8e5fcce0e649993b4 (
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
|
{-# LANGUAGE OverloadedStrings #-}
module F2Md.Import (toMessagesFromFile, toMessagesFromUrl) where
import Control.Monad
import Data.Time
import System.Process
import Data.UUID
import Data.UUID.V4
import Data.Char
import Data.Text (Text)
import Text.Feed.Types
import qualified Data.Text as T
import Data.Maybe
import Text.Feed.Query
import Data.Generics
import Text.RSS.Syntax hiding (RSSItem)
import Data.XML.Types
import Text.Feed.Import
import Text.Feed.Types
import F2Md.Types
toMessagesFromFile :: FilePath -> IO [Message]
toMessagesFromFile file = do
feed <- parseFeedFromFile file
case feed of
Nothing -> return []
Just feed' ->
mapM (\msg -> toMessage (toFeedMetadata feed') msg) (getFeedItems feed')
toMessagesFromUrl :: Text -> Maybe ZonedTime -> IO [Message]
toMessagesFromUrl url after = do
feed <- parseFeedString <$> (fetchFeed $ T.unpack url)
case feed of
Nothing -> return []
Just feed' -> catMaybes <$>
mapM (\msg -> toMessage' after (toFeedMetadata feed') msg) (getFeedItems feed')
wgetCommand :: String
wgetCommand = "wget -O- 2>/dev/null"
fetchFeed :: String -> IO String
fetchFeed url = readCreateProcess (shell $ wgetCommand ++ " " ++ url) ""
toMessage' :: Maybe ZonedTime -> FeedMetadata -> Item -> IO (Maybe Message)
toMessage' after feed item
| isNothing after = toMessage feed item >>= return . Just
| isNothing date || zonedTimeToUTC (fromJust after) >= fromJust date =
return Nothing
| otherwise = toMessage feed item >>= return . Just
where date = join $ getItemPublishDate item
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
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
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)
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" <> ">"
hyphenateNonAlNum :: Char -> Char
hyphenateNonAlNum c
| isAlphaNum c = c
| otherwise = '-'
|
