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