fetcher.fnl


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
114
115
116
117
118
119
120
121
122
123
124

(import-macros {: reduce : map} :lib.macro)

(local peg
 (if (pick-values 1 (pcall require :lpeg))
   (require :lpeg)
   (require :vendor.lpeglj)))
(local array (require :lib.array))
(local json (require :vendor.json))
(local parser (require :parser))
(local http (require :http))

(fn retry [what times sleep]
  (var result nil)
  (var stop? false)
  (var err nil)

  (for [i 1 times &until stop?]
    (local (ok? value) (pcall what))
    (if ok?
     (do
      (set result value)
      (set stop? true))
     (do
       (set err value)
       (os.execute (.. "sleep " sleep)))))

  (when (not stop?)
    (error (.. "failed after " times " retries:\n" err)))

  result)

(fn walk-html-pages [url-formatter path item-peg]
  (fn gather [page knil]
    (local url (url-formatter path page))
    (print (.. "requesting " url))
    (local (status _ html)
      (luna.http.request "GET" url {:User-Agent (http.random-user-agent)} ""))

    (if (= status 200)
     (let [products (parser.match-many html item-peg)]
      (if (or (= products nil) (= 0 (# products)))
          knil
          (do
            (os.execute "sleep 1")
            (gather (+ page 1) (array.concat knil products)))))
     (= status 404)
      knil
     (retry #(gather page knil) 3 1)))

  (gather 1 []))

(fn guess-category [title]
  (if (: (parser.anywhere (+ (peg.P "зеленый") "Зеленый")) :match title)
    "Зеленый чай"
   (: (parser.anywhere (+ (peg.P "Улун") "улун")) :match title)
    "Улун"
   (: (parser.anywhere (+ (peg.P "Белый") "белый")) :match title)
    "Белый чай"
   (: (parser.anywhere (+ (peg.P "Желтый") "желтый")) :match title)
    "Желтый чай"
   (: (parser.anywhere (+ (peg.P "Красный") "красный")) :match title)
    "Красный чай"
   "Неизвестная категория"))

(fn categorize-many [items category]
  (map
   (fn [_ item]
      (tset item :category
       (if category category (guess-category item.title)))
      item)
   items))

(fn from-html [url-formatter categories normalizer item-peg]
  (reduce
   (fn [_ {: category : path} result]
     (array.concat
       result
       (categorize-many
         (map #(normalizer $2)
              (walk-html-pages url-formatter path item-peg))
         category)))
   categories
   []))

(fn walk-json-pages [url-formatter path]
  (fn gather [page knil]
    (local url (url-formatter path page))
    (print (.. "requesting " url))
    (local (status _ content)
      (luna.http.request
        "GET"
        url
        {:User-Agent (http.random-user-agent)
         :Content-Type "application/json"
         :Accept "application/json"}
        ""))

    (if (= status 200)
     (let [products (json.decode content)]
      (if (or (= products nil) (= 0 (# products)))
          knil
          (do
           (os.execute "sleep 1")
           (gather (+ page 1) (array.concat knil products)))))
     (= status 404)
      knil
     (retry #(gather page knil) 3 1)))

  (gather 1 []))

(fn from-json [url-formatter categories normalizer]
  (reduce
   (fn [_ {: category : path} result]
     (array.concat
      result
      (categorize-many
       (map #(normalizer $2)
            (walk-json-pages url-formatter path))
       category)))
   categories
   []))

{: from-html
 : from-json}