s426211/twilight-library
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Add entry numeration

Browse Source
This commit is contained in:
Wojciech Pakulski 2021-04-09 02:35:44 +02:00
parent e5561156be
commit 26f9c5c181
1 changed files with 21 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
app/urzadpatentowy.hs
View File

@ -28,17 +28,19 @@ fetchLinks year xs failedTries = do
"https://grab.uprp.pl/sites/Wydawnictwa/WydawnictwaArchiwum/_layouts/15/inplview.aspx?List={D7CA1A2D-B281-4EB6-A9DE-E20ED7654A37}&View={AFA62008-9FDA-4B91-B630-AA3EC8CFB774}&ViewCount=9&IsXslView=TRUE&GroupString=%3B%23" ++ "https://grab.uprp.pl/sites/Wydawnictwa/WydawnictwaArchiwum/_layouts/15/inplview.aspx?List={D7CA1A2D-B281-4EB6-A9DE-E20ED7654A37}&View={AFA62008-9FDA-4B91-B630-AA3EC8CFB774}&ViewCount=9&IsXslView=TRUE&GroupString=%3B%23" ++
show year ++ show year ++
"%3B%23&IsGroupRender=TRUE&WebPartID={AFA62008-9FDA-4B91-B630-AA3EC8CFB774}" "%3B%23&IsGroupRender=TRUE&WebPartID={AFA62008-9FDA-4B91-B630-AA3EC8CFB774}"
)) >>> setTraceLevel 1 >>> wupExtractor >>> arr toShadowItem) )) >>> setTraceLevel 1 >>> wupExtractor) >>> arr toShadowItem
if length items == 0 then if length items == 0 then
if failedTries == 10 then if failedTries == 10 then
mapM_ (putStrLn . show) xs return xs
else else
fetchLinks (year + 1) xs (failedTries + 1) fetchLinks (year + 1) xs (failedTries + 1)
else else
fetchLinks (year + 1) (xs ++ items) 0 fetchLinks (year + 1) (xs ++ items) 0
toShadowItem :: ((String, String), String) -> ShadowItem toShadowItem :: ((String, String), String) -> ShadowItem
toShadowItem ((date, relativeFileUrl), url) = toShadowItem ((date, relativeFileUrl), url) =
(defaultShadowItem url title) { (defaultShadowItem url title) {
@ -48,7 +50,9 @@ toShadowItem ((date, relativeFileUrl), url) =
finalUrl = fileUrl finalUrl = fileUrl
} }
where fileUrl = "https://grab.uprp.pl" ++ relativeFileUrl where fileUrl = "https://grab.uprp.pl" ++ relativeFileUrl
title = "WUP" title = "Wiadomosci Urzedu Patentowego nr "
namedShadowItem shadowItem num = title shadowItem ++ show num
main = do main = do
let start = "https://grab.uprp.pl/sites/Wydawnictwa/WydawnictwaArchiwum/WydawnictwaArchiwum/Forms/AllItems.aspx" let start = "https://grab.uprp.pl/sites/Wydawnictwa/WydawnictwaArchiwum/WydawnictwaArchiwum/Forms/AllItems.aspx"
@ -61,5 +65,18 @@ main = do
firstPageItems <- runX $ (arr (const start) >>> setTraceLevel 1 >>> extractFirstPage) firstPageItems <- runX $ (arr (const start) >>> setTraceLevel 1 >>> extractFirstPage)
let firstYear = read $ (head . tail . words . fst . head) firstPageItems :: Int let firstYear = read $ (head . tail . words . fst . head) firstPageItems :: Int
fetchLinks firstYear [] 0 shadowItems <- fetchLinks firstYear [] 0
let namedShadowItems = zipWith (\shadowItem num -> ShadowItem {
url = url shadowItem,
title = (title shadowItem) ++ show (num + 1),
itype = itype shadowItem,
originalDate = originalDate shadowItem,
creator = creator shadowItem,
format = format shadowItem,
lang = lang shadowItem,
finalUrl = finalUrl shadowItem,
description = description shadowItem
}) shadowItems [0 .. length shadowItems]
mapM_ (putStrLn . show) namedShadowItems