-
Notifications
You must be signed in to change notification settings - Fork 0
/
command.rkt
82 lines (71 loc) · 2.43 KB
/
command.rkt
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
#lang racket/base
(require "sendy.rkt"
"lowkey/console.rkt"
"lowkey/options.rkt"
punct/fetch
punct/doc
racket/cmdline
racket/list
racket/match
racket/runtime-path
txexpr)
(provide (all-defined-out))
(define-runtime-path options.ini "options.ini")
(define opt (make-options-ref options.ini))
(define check-only (make-parameter #f))
(module+ raco
(define filename
(command-line #:program "raco news"
#:once-each
[("-c" "--check-only") "Only check links, do not upload campaign"
(check-only #t)]
#:args (filename)
filename))
(raco-news-command filename))
(define (raco-news-command filename)
(define doc (display/check-file filename))
(and doc (for-each display/link-check (list-link-urls doc)))
(unless (check-only)
(and (display/api-check opt)
(display/campaign-create doc opt))))
(define (display/check-file filename)
(define maybe-doc
(cond
[(file-exists? filename)
(with-handlers ([exn:fail? (λ (e) (format "Fatal: ~a" (object-name e)))])
(get-doc filename))]
[else (format "File doesn’t exist: ~a" filename)]))
(match maybe-doc
[(? string? err) (printc #f err) #f]
[(var d) (printc #t (format "Loaded ~a" filename)) d]))
(define (display/api-check opt-proc)
(define (task str) (format "Sendy API check… ~a" str))
(define endpoint (opt-proc 'sendy-endpoint))
(match (check-api opt-proc)
[(list 'success _ _)
(printc #t (task "success!"))
#true]
[(list 'error 200 msg)
(printc #f (task msg))
#false]
[(list 'error -inf.0 msg)
(printc #f (task (format "Fatal: ~a" msg endpoint)))
#false]
[(list 'error code msg)
(printc #f (task (format "~a ~a returned from ~a" code msg endpoint)))
#false]))
(define (display/campaign-create doc opt-proc)
(apply printc (create-campaign doc opt-proc)))
(define (link? tx)
(and (list? tx) (eq? 'link (car tx))))
(define (list-link-urls doc)
(define link-xprs (findf*-txexpr `(root ,@(document-body doc)) link?))
(remove-duplicates
(for/list ([xpr (in-list link-xprs)])
(attr-ref xpr 'dest))))
(define (display/link-check url)
(match (check-link url)
[(list 200 msg)
(printc #t (format "~a: ~a" msg url) 200) #t]
[(list code msg)
(printc #f (format "~a: ~a" msg url) code) #f]))