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
|
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
module Main where
import Conduit
import Control.Exception
import Data.Maybe
import Data.Text qualified as T
import Data.XML.Types
import Network.HTTP.Conduit
import Text.Atom.Conduit.Parse
import Text.Atom.Conduit.Render
import Text.Atom.Types
import Text.XML.Stream.Parse
import Text.XML.Stream.Render
import Text.XML.Unresolved (elementToEvents)
env_FEED_TITLE :: T.Text
env_FEED_TITLE = "code.nomath.org"
env_FEED_ID :: T.Text
env_FEED_ID = "code.nomath.org"
env_FEED_URLS :: [String]
env_FEED_URLS =
[ "https://code.nomath.org/anissue/atom",
"https://code.nomath.org/apaperless/atom",
"https://code.nomath.org/abuilder/atom",
"https://code.nomath.org/infra/atom",
"https://code.nomath.org/json2sql/atom",
"https://code.nomath.org/nomath-org/atom",
"https://code.nomath.org/static-nomath-org/atom"
]
main :: IO ()
main = do
manager <- newManager tlsManagerSettings
runResourceT do
feeds <- mapM (getFeed manager) env_FEED_URLS
let feed = merge feeds
runConduit do
renderAtomFeed feed
.| renderBytes def
.| sinkFile "output.atom"
merge :: [AtomFeed] -> AtomFeed
merge feeds =
AtomFeed
{ feedAuthors = concatMap (.feedAuthors) feeds,
feedCategories = concatMap (.feedCategories) feeds,
feedContributors = concatMap (.feedContributors) feeds,
feedEntries = concatMap (.feedEntries) feeds,
feedGenerator = Nothing,
feedIcon = Nothing,
feedId = env_FEED_ID,
feedLinks = concatMap (.feedLinks) feeds,
feedLogo = Nothing,
feedRights = Nothing,
feedSubtitle = Nothing,
feedTitle = AtomPlainText TypeText env_FEED_TITLE,
feedUpdated = minimum (map (.feedUpdated) feeds)
}
data ParserError = ParserError String
deriving (Show)
instance Exception ParserError
getFeed :: Manager -> String -> ResourceT IO AtomFeed
getFeed manager url = do
request <- parseRequest url
response <- http request manager
fromMaybe (throw (ParserError url))
<$> runConduit do
responseBody response
.| parseBytes def
.| massage
.| atomFeed
massage :: ConduitT Event Event (ResourceT IO) ()
massage = do
await >>= \case
Nothing -> pure ()
Just e -> do
yield e -- BeginDocument
await >>= \case
Nothing -> pure ()
Just e -> do
yield e -- <feed>
yieldMany (elementToEvents idE)
yieldMany (elementToEvents updatedE)
mapC id
where
idE =
-- TODO(id)
Element
"{http://www.w3.org/2005/Atom}id"
[]
[ NodeContent (ContentText "TODO")
]
updatedE =
-- TODO(updated)
Element
"{http://www.w3.org/2005/Atom}updated"
[]
[ NodeContent (ContentText "1970-01-01T00:00:00Z")
]
|
