]> gitweb.factorcode.org Git - factor.git/blobdiff - basis/help/lint/lint.factor
use reject instead of [ ... not ] filter.
[factor.git] / basis / help / lint / lint.factor
index 47b8820f18d87b4466e66ac2fbc71c44edb1015e..25115905b455af92f7d1850906a5833ca4dad262 100644 (file)
@@ -1,9 +1,9 @@
 ! Copyright (C) 2006, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: assocs continuations fry help help.lint.checks
-help.topics io kernel namespaces parser sequences
-source-files.errors vocabs.hierarchy vocabs words classes
-locals tools.errors listener ;
+USING: assocs combinators continuations fry help
+help.lint.checks help.topics io kernel namespaces parser
+sequences source-files.errors vocabs.hierarchy vocabs words
+classes locals tools.errors listener ;
 FROM: help.lint.checks => all-vocabs ;
 FROM: vocabs => child-vocabs ;
 IN: help.lint
@@ -16,7 +16,7 @@ TUPLE: help-lint-error < source-file-error ;
 
 SYMBOL: +help-lint-failure+
 
-T{ error-type
+T{ error-type-holder
    { type +help-lint-failure+ }
    { word ":lint-failures" }
    { plural "help lint failures" }
@@ -34,7 +34,7 @@ M: help-lint-error error-type drop +help-lint-failure+ ;
 
 PRIVATE>
 
-: help-lint-error ( error topic -- )
+: notify-help-lint-error ( error topic -- )
     lint-failures get pick
     [ [ [ <help-lint-error> ] keep ] dip set-at ] [ delete-at drop ] if
     notify-error-observers ;
@@ -43,16 +43,18 @@ PRIVATE>
 
 :: check-something ( topic quot -- )
     [ quot call( -- ) f ] [ ] recover
-    topic help-lint-error ; inline
+    topic notify-help-lint-error ; inline
 
 : check-word ( word -- )
     [ with-file-vocabs ] vocabs-quot set
     dup word-help [
         [ >link ] keep '[
-            _ dup word-help
-            [ check-values ]
-            [ check-class-description ]
-            [ nip [ check-nulls ] [ check-see-also ] [ check-markup ] tri ] 2tri
+            _ dup word-help {
+                [ check-values ]
+                [ check-value-effects ]
+                [ check-class-description ]
+                [ nip [ check-nulls ] [ check-see-also ] [ check-markup ] tri ]
+            } 2cleave
         ] check-something
     ] [ drop ] if ;
 
@@ -65,8 +67,8 @@ PRIVATE>
     ] check-something ;
 
 : check-about ( vocab -- )
-    vocab-link boa dup
-    '[ _ vocab-help [ article drop ] when* ] check-something ;
+    <vocab-link> dup
+    '[ _ vocab-help [ lookup-article drop ] when* ] check-something ;
 
 : check-vocab ( vocab -- )
     "Checking " write dup write "..." print flush
@@ -90,13 +92,11 @@ PRIVATE>
 
 : :lint-failures ( -- ) lint-failures get values errors. ;
 
-: unlinked-words ( words -- seq )
-    all-word-help [ article-parent not ] filter ;
+: unlinked-words ( vocab -- seq )
+    words all-word-help [ article-parent ] reject ;
 
 : linked-undocumented-words ( -- seq )
     all-words
-    [ word-help not ] filter
+    [ word-help ] reject
     [ article-parent ] filter
-    [ predicate? not ] filter ;
-
-MAIN: help-lint
+    [ predicate? ] reject ;