1 USING: accessors arrays classes classes.error combinators
2 continuations english formatting generic help help.lint.checks
3 help.markup io io.streams.string io.styles kernel math
4 namespaces parser sequences sequences.deep sets sorting
5 splitting strings summary vocabs vocabs.parser words words.alias ;
6 FROM: namespaces => set ;
9 TUPLE: word-help-coverage
10 { word-name word initial: POSTPONE: f }
11 { omitted-sections sequence initial: { } }
12 { empty-examples? boolean initial: f }
13 { 100%-coverage? boolean initial: f } ;
16 ERROR: unloaded-vocab spec ;
18 M: unloaded-vocab summary
19 drop "Not a loaded vocabulary" ;
21 CONSTANT: ignored-words {
32 : (word-help) ( word -- content )
33 [ "help" word-prop ] [ word-help* ] ?unless ;
35 GENERIC: write-object* ( object -- )
36 M: string write-object* write ;
37 M: pair write-object* first2 write-object ;
39 : write-object-seq ( object-seq -- )
42 [ write-object* ] each
43 ] [ write-object* ] if
47 : (assemble-word-metadata) ( vec word -- vec )
49 [ "[" ] dip vocabulary>> dup lookup-vocab 2array "] "
52 [ name>> ] keep 2array ": "
56 : (assemble-empty-examples) ( vec coverage -- vec )
57 empty-examples?>> [ "empty " \ $examples [ name>> ] keep 2array "; "
61 : (assemble-omitted-sections) ( vec coverage -- vec )
63 length "section" ?pluralize ": " append
65 [ [ name>> ] keep 2array ] map "and" comma-list
67 [ "needs help " ] 2dip
68 3array over push-all ;
70 : (assemble-full-coverage) ( vec coverage -- vec )
71 drop "full help coverage" over push ;
73 : (present-coverage) ( coverage-report -- )
75 [ word-name>> (assemble-word-metadata) ] keep
77 [ (assemble-full-coverage) ] [
78 [ (assemble-empty-examples) ]
79 [ (assemble-omitted-sections) ] bi
80 ] if "\n" over push write-object-seq ;
82 M: word-help-coverage summary
83 [ (present-coverage) ] with-string-writer ; inline
85 : find-word ( name -- word/f )
86 dup words-named dup length {
89 [ drop <ambiguous-use-error> throw-restarts ]
92 : sorted-loaded-child-vocabs ( prefix -- assoc )
93 loaded-child-vocab-names sort ; inline
95 : filter-private ( seq -- no-private )
96 [ ".private" ?tail nip ] reject ; inline
98 : ?remove-$values ( word spec -- spec )
99 \ $values over member? [
100 swap "declared-effect" word-prop [
102 \ $values swap remove
104 ] when* ] [ nip ] if ;
106 : should-define ( word -- spec )
108 ! predicates have generated docs
109 { [ dup predicate? ] [ drop { } ] }
110 { [ dup primitive? ] [ drop { $description } ] }
111 ! aliases should describe why they exist but ideally $values should be
112 ! automatically inherited from the aliased word's docs
113 { [ dup alias? ] [ drop { $values $description } ] }
114 { [ dup error-class? ] [ drop { $values $description $error-description } ] }
115 { [ dup class? ] [ drop { $class-description } ] }
116 { [ dup generic? ] [ drop { $values $contract $examples } ] }
117 { [ dup word? ] [ drop { $values $description $examples } ] }
118 } cond ?remove-$values ;
120 : word-defines-sections ( word -- seq )
121 (word-help) [ ignored-words member? ] reject [ ?first ] map ;
123 ! only words that need examples, need to have them nonempty
124 ! not defining examples is not the same as an empty { $examples }
125 : empty-examples? ( word -- ? )
126 (word-help) \ $examples swap elements [ f ] [ first rest empty? ] if-empty ;
128 : missing-sections ( word -- missing )
129 [ should-define ] [ word-defines-sections ] bi diff ;
131 GENERIC: loaded-vocab? ( vocab-spec -- ? )
132 M: string loaded-vocab? lookup-vocab >boolean ;
133 M: vocab loaded-vocab? source-loaded?>> +done+ = ;
136 GENERIC: <word-help-coverage> ( word -- coverage )
137 M: word <word-help-coverage>
138 dup [ missing-sections ] [ empty-examples? ] bi
139 2dup [ empty? ] both? word-help-coverage boa ; inline
141 M: string <word-help-coverage>
142 find-word <word-help-coverage> ; inline
144 : <vocab-help-coverage> ( vocab-spec -- coverage )
146 [ auto-use? off vocab-words sort [ <word-help-coverage> ] map ] with-scope
151 : <prefix-help-coverage> ( prefix private? -- coverage )
153 [ auto-use? off group-articles vocab-articles set
154 [ sorted-loaded-child-vocabs ] dip not
155 [ filter-private ] when
156 [ <vocab-help-coverage> ] map flatten
162 GENERIC: help-coverage. ( coverage -- )
163 M: sequence help-coverage.
165 [ help-coverage. ] each
167 [ [ 100%-coverage?>> ] count ] [ length ] bi /f
169 "\n%3.1f%% of words have complete documentation\n"
173 M: word-help-coverage help-coverage.
176 : word-help-coverage. ( word-spec -- ) <word-help-coverage> help-coverage. ;
177 : vocab-help-coverage. ( vocab-spec -- ) <vocab-help-coverage> help-coverage. ;
178 : prefix-help-coverage. ( prefix-spec private? -- ) <prefix-help-coverage> help-coverage. ;