1 ! Copyright (C) 2009 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors assocs kernel math.order sorting sequences definitions
4 namespaces arrays splitting io math.parser math init ;
5 IN: source-files.errors
7 TUPLE: source-file-error error asset file line# ;
9 : sort-errors ( errors -- alist )
10 [ [ [ line#>> ] compare ] sort ] { } assoc-map-as sort-keys ;
12 : group-by-source-file ( errors -- assoc )
13 H{ } clone [ [ push-at ] curry [ dup file>> ] prepose each ] keep ;
15 TUPLE: error-type type word plural icon quot ;
17 GENERIC: error-type ( error -- type )
19 : <definition-error> ( error definition class -- source-file-error )
23 [ where [ first2 [ >>file ] [ >>line# ] bi* ] when* ] bi
26 : delete-file-errors ( seq file type -- )
28 [ swap file>> = ] [ swap error-type = ]
30 ] 2curry filter-here ;
34 error-types [ V{ } clone ] initialize
36 : define-error-type ( error-type -- )
37 dup type>> error-types get set-at ;
39 : error-icon-path ( type -- icon )
40 error-types get at icon>> ;
42 : error-counts ( -- alist )
43 error-types get [ nip dup quot>> call( -- seq ) length ] assoc-map ;
45 : error-summary ( -- )
47 [ nip 0 > ] assoc-filter
51 [ " - show " write number>string write bl ]
52 [ plural>> print ] tri*
55 : all-errors ( -- errors )
56 error-types get values
57 [ quot>> call( -- seq ) ] map
60 GENERIC: errors-changed ( observer -- )
62 SYMBOL: error-observers
64 [ V{ } clone error-observers set-global ] "source-files.errors" add-init-hook
66 : add-error-observer ( observer -- ) error-observers get push ;
68 : remove-error-observer ( observer -- ) error-observers get delq ;
70 : notify-error-observers ( -- ) error-observers get [ errors-changed ] each ;