basis/vocabs/metadata/metadata.factor

   1 ! Copyright (C) 2009, 2010 Slava Pestov, Joe Groff.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors arrays assocs io.directories io.encodings.utf8
   4 io.files io.pathnames kernel make math.parser memoize sequences
   5 sets sorting summary vocabs vocabs.loader words system
   6 classes.algebra combinators.short-circuit fry continuations
   7 namespaces ;
   8 IN: vocabs.metadata
   9
  10 : check-vocab ( vocab -- vocab )
  11     dup find-vocab-root [ no-vocab ] unless ;
  12
  13 MEMO: vocab-file-contents ( vocab name -- seq )
  14     vocab-append-path dup
  15     [ dup exists? [ utf8 file-lines ] [ drop f ] if ] when ;
  16
  17 : ?delete-file ( pathname -- ) '[ _ delete-file ] ignore-errors ;
  18
  19 : set-vocab-file-contents ( seq vocab name -- )
  20     dupd vocab-append-path [
  21         swap [ ?delete-file ] [ swap utf8 set-file-lines ] if-empty
  22         \ vocab-file-contents reset-memoized
  23     ] [ vocab-name no-vocab ] ?if ;
  24
  25 : vocab-windows-icon-path ( vocab -- string )
  26     vocab-dir "icon.ico" append-path ;
  27
  28 : vocab-mac-icon-path ( vocab -- string )
  29     vocab-dir "icon.icns" append-path ;
  30
  31 : vocab-resources-path ( vocab -- string )
  32     vocab-dir "resources.txt" append-path ;
  33
  34 : vocab-resources ( vocab -- patterns )
  35     dup vocab-resources-path vocab-file-contents harvest ;
  36
  37 : set-vocab-resources ( patterns vocab -- )
  38     dup vocab-resources-path set-vocab-file-contents ;
  39
  40 : vocab-summary-path ( vocab -- string )
  41     vocab-dir "summary.txt" append-path ;
  42
  43 : vocab-summary ( vocab -- summary )
  44     dup dup vocab-summary-path vocab-file-contents
  45     [
  46         vocab-name " vocabulary" append
  47     ] [
  48         nip first
  49     ] if-empty ;
  50
  51 M: vocab summary
  52     [
  53         dup vocab-summary %
  54         " (" %
  55         words>> assoc-size #
  56         " words)" %
  57     ] "" make ;
  58
  59 M: vocab-link summary vocab-summary ;
  60
  61 : set-vocab-summary ( string vocab -- )
  62     [ 1array ] dip
  63     dup vocab-summary-path
  64     set-vocab-file-contents ;
  65
  66 : vocab-tags-path ( vocab -- string )
  67     vocab-dir "tags.txt" append-path ;
  68
  69 : vocab-tags ( vocab -- tags )
  70     dup vocab-tags-path vocab-file-contents harvest ;
  71
  72 : set-vocab-tags ( tags vocab -- )
  73     dup vocab-tags-path set-vocab-file-contents ;
  74
  75 : add-vocab-tags ( tags vocab -- )
  76     [ vocab-tags append prune ] keep set-vocab-tags ;
  77
  78 : remove-vocab-tags ( tags vocab -- )
  79     [ vocab-tags swap diff ] keep set-vocab-tags ;
  80
  81 : vocab-authors-path ( vocab -- string )
  82     vocab-dir "authors.txt" append-path ;
  83
  84 : vocab-authors ( vocab -- authors )
  85     dup vocab-authors-path vocab-file-contents harvest ;
  86
  87 : set-vocab-authors ( authors vocab -- )
  88     dup vocab-authors-path set-vocab-file-contents ;
  89
  90 : vocab-platforms-path ( vocab -- string )
  91     vocab-dir "platforms.txt" append-path ;
  92
  93 ERROR: bad-platform name ;
  94
  95 : vocab-platforms ( vocab -- platforms )
  96     dup vocab-platforms-path vocab-file-contents
  97     [ dup "system" lookup [ ] [ bad-platform ] ?if ] map ;
  98
  99 : set-vocab-platforms ( platforms vocab -- )
 100     [ [ name>> ] map ] dip
 101     dup vocab-platforms-path set-vocab-file-contents ;
 102
 103 : supported-platform? ( vocab -- ? )
 104     vocab-platforms [ t ] [ [ os swap class<= ] any? ] if-empty ;
 105
 106 : unportable? ( vocab -- ? )
 107     {
 108         [ vocab-tags "untested" swap member? ]
 109         [ supported-platform? not ]
 110     } 1|| ;
 111
 112 ERROR: unsupported-platform vocab ;
 113
 114 M: unsupported-platform summary
 115     drop "Current operating system not supported by this vocabulary" ;
 116
 117 [ dup supported-platform? [ drop ] [ vocab-name unsupported-platform ] if ]
 118 check-vocab-hook set-global