-
-
Notifications
You must be signed in to change notification settings - Fork 2
/
reporter.lisp
96 lines (90 loc) · 4.56 KB
/
reporter.lisp
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
(defpackage #:inga/reporter
(:use #:cl)
(:import-from #:jsown)
(:import-from #:inga/analyzer/base
#:signature-load-failed
#:signature-load-failed-fq-class-name
#:signature-load-failed-path)
(:import-from #:inga/file
#:convert-to-pos)
(:import-from #:inga/plugin/jvm-helper
#:find-base-path)
(:export #:output-report
#:output-error
#:convert-to-report-pos))
(in-package #:inga/reporter)
(defun output-report (results output-path root-path)
(with-open-file (out (merge-pathnames "report.json" output-path)
:direction :output
:if-exists :supersede
:if-does-not-exist :create)
(labels ((convert (poss)
(mapcan (lambda (pos)
`((:obj
("type" . ,(cdr (assoc :type pos)))
("origin" . ,(cons :obj (convert-to-report-pos
(cdr (assoc :origin pos))
root-path)))
,@(when (assoc :entrypoint pos)
`(("entrypoint" . ,(cons :obj (convert-to-report-pos
(cdr (assoc :entrypoint pos))
root-path)))))
,@(when (or (equal (cdr (assoc :type pos)) "entrypoint")
(equal (cdr (assoc :type pos)) "searching"))
`(("service" . ,(find-service-name
(cdr (assoc "path"
(convert-to-report-pos
(or
(cdr (assoc :entrypoint pos))
(cdr (assoc :origin pos)))
root-path)))
root-path)))))))
poss)))
(format out "~a"
(jsown:to-json
`(:obj
("version" . "0.2")
("results" . ,(mapcar #'convert results)))))))
(merge-pathnames "report.json" output-path))
(defun output-error (errors output-path root-path)
(with-open-file (out (merge-pathnames "error.json" output-path)
:direction :output
:if-exists :supersede
:if-does-not-exist :create)
(labels ((get-type (error)
(string-downcase (type-of error)))
(convert (errors)
(loop for error in errors
with results
do
(typecase error
(signature-load-failed
(push `(:obj
("type" . ,(get-type error))
("service". ,(find-service-name (signature-load-failed-path error)
root-path))
("path" . ,(signature-load-failed-path error))
("fq-class-name" . ,(signature-load-failed-fq-class-name error)))
results)))
finally (return (remove-duplicates results :test #'equal)))))
(format out "~a"
(jsown:to-json
`(:obj
("version" . "0.1")
("errors" . ,(convert errors)))))))
(merge-pathnames "error.json" output-path))
(defun convert-to-report-pos (pos root-path)
(unless pos (return-from convert-to-report-pos))
(when (eq (cdr (assoc :type pos)) :rest-server)
(setf pos (cdr (assoc :file-pos pos))))
(let ((text-pos (convert-to-pos (merge-pathnames (cdr (assoc :path pos)) root-path)
(cdr (assoc :top-offset pos)))))
`(("path" . ,(enough-namestring (cdr (assoc :path pos)) root-path))
("name" . ,(cdr (assoc :name pos)))
("line" . ,(cdr (assoc :line text-pos)))
("offset" . ,(cdr (assoc :offset text-pos))))))
(defun find-service-name (path root-path)
(let ((base-path (find-base-path path root-path)))
(if (equal base-path root-path)
(directory-namestring root-path)
(enough-namestring base-path root-path))))