basis/help/lint/lint.factor

   1 ! Copyright (C) 2006, 2009 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: assocs combinators continuations fry help
   4 help.lint.checks help.topics io kernel namespaces parser
   5 sequences source-files.errors vocabs.hierarchy vocabs words
   6 classes locals tools.errors listener ;
   7 FROM: help.lint.checks => all-vocabs ;
   8 FROM: vocabs => child-vocabs ;
   9 IN: help.lint
  10
  11 SYMBOL: lint-failures
  12
  13 lint-failures [ H{ } clone ] initialize
  14
  15 TUPLE: help-lint-error < source-file-error ;
  16
  17 SYMBOL: +help-lint-failure+
  18
  19 T{ error-type-holder
  20    { type +help-lint-failure+ }
  21    { word ":lint-failures" }
  22    { plural "help lint failures" }
  23    { icon "vocab:ui/tools/error-list/icons/help-lint-error.tiff" }
  24    { quot [ lint-failures get values ] }
  25    { forget-quot [ lint-failures get delete-at ] }
  26 } define-error-type
  27
  28 M: help-lint-error error-type drop +help-lint-failure+ ;
  29
  30 <PRIVATE
  31
  32 : <help-lint-error> ( error topic -- help-lint-error )
  33     \ help-lint-error <definition-error> ;
  34
  35 PRIVATE>
  36
  37 : notify-help-lint-error ( error topic -- )
  38     lint-failures get pick
  39     [ [ [ <help-lint-error> ] keep ] dip set-at ] [ delete-at drop ] if
  40     notify-error-observers ;
  41
  42 <PRIVATE
  43
  44 :: check-something ( topic quot -- )
  45     [ quot call( -- ) f ] [ ] recover
  46     topic notify-help-lint-error ; inline
  47
  48 : check-word ( word -- )
  49     [ with-file-vocabs ] vocabs-quot set
  50     dup word-help [
  51         [ >link ] keep '[
  52             _ dup word-help {
  53                 [ check-values ]
  54                 [ check-value-effects ]
  55                 [ check-class-description ]
  56                 [ check-class-slots ]
  57                 [ nip [ check-nulls ] [ check-see-also ] [ check-markup ] tri ]
  58             } 2cleave
  59         ] check-something
  60     ] [ drop ] if ;
  61
  62 : check-article ( article -- )
  63     [ with-interactive-vocabs ] vocabs-quot set
  64     >link dup '[
  65         _
  66         [ check-article-title ]
  67         [ article-content check-markup ] bi
  68     ] check-something ;
  69
  70 : check-about ( vocab -- )
  71     vocab-link boa dup
  72     '[ _ vocab-help [ lookup-article drop ] when* ] check-something ;
  73
  74 : check-vocab ( vocab -- )
  75     "Checking " write dup write "..." print flush
  76     [ check-about ]
  77     [ words [ check-word ] each ]
  78     [ vocab-articles get at [ check-article ] each ]
  79     tri ;
  80
  81 PRIVATE>
  82
  83 : help-lint ( prefix -- )
  84     [
  85         auto-use? off
  86         all-vocab-names all-vocabs set
  87         group-articles vocab-articles set
  88         child-vocabs
  89         [ check-vocab ] each
  90     ] with-scope ;
  91
  92 : help-lint-all ( -- ) "" help-lint ;
  93
  94 : :lint-failures ( -- ) lint-failures get values errors. ;
  95
  96 : unlinked-words ( vocab -- seq )
  97     words all-word-help [ article-parent not ] filter ;
  98
  99 : linked-undocumented-words ( -- seq )
 100     all-words
 101     [ word-help not ] filter
 102     [ article-parent ] filter
 103     [ predicate? not ] filter ;
 104
 105 MAIN: help-lint