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 assocs classes.algebra
   4 combinators.short-circuit continuations io.directories
   5 io.encodings.utf8 io.files io.pathnames kernel make math.parser
   6 memoize namespaces sequences summary system vocabs vocabs.loader
   7 words ;
   8 IN: vocabs.metadata
   9
  10 : check-vocab ( vocab -- vocab )
  11     dup find-vocab-root [ no-vocab ] unless ;
  12
  13 : vocab-file-path ( vocab name -- path/f )
  14     [ dup vocab-dir ] [ append-path ] bi* vocab-append-path ;
  15
  16 MEMO: vocab-file-lines ( vocab name -- lines/f )
  17     vocab-file-path dup [
  18         dup exists? [
  19             utf8 file-lines harvest
  20         ] [
  21             drop f
  22         ] if
  23     ] when ;
  24
  25 : set-vocab-file-lines ( lines vocab name -- )
  26     dupd vocab-file-path [
  27         swap [ ?delete-file ] [ swap utf8 set-file-lines ] if-empty
  28         \ vocab-file-lines reset-memoized
  29     ] [ vocab-name no-vocab ] ?if ;
  30
  31 : vocab-resources-path ( vocab -- path/f )
  32     "resources.txt" vocab-file-path ;
  33
  34 : vocab-resources ( vocab -- patterns )
  35     "resources.txt" vocab-file-lines ;
  36
  37 : vocab-summary-path ( vocab -- path/f )
  38     "summary.txt" vocab-file-path ;
  39
  40 : vocab-summary ( vocab -- summary )
  41     dup "summary.txt" vocab-file-lines [
  42         vocab-name " vocabulary" append
  43     ] [
  44         nip first
  45     ] if-empty ;
  46
  47 M: vocab summary
  48     [
  49         dup vocab-summary %
  50         " (" %
  51         words>> assoc-size #
  52         " words)" %
  53     ] "" make ;
  54
  55 M: vocab-link summary vocab-summary ;
  56
  57 : vocab-tags-path ( vocab -- path/f )
  58     "tags.txt" vocab-file-path ;
  59
  60 : vocab-tags ( vocab -- tags )
  61     "tags.txt" vocab-file-lines ;
  62
  63 : vocab-authors-path ( vocab -- path/f )
  64     "authors.txt" vocab-file-path ;
  65
  66 : vocab-authors ( vocab -- authors )
  67     "authors.txt" vocab-file-lines ;
  68
  69 : vocab-platforms-path ( vocab -- path/f )
  70     "platforms.txt" vocab-file-path ;
  71
  72 ERROR: bad-platform name ;
  73
  74 : vocab-platforms ( vocab -- platforms )
  75     "platforms.txt" vocab-file-lines
  76     [ dup "system" lookup-word [ ] [ bad-platform ] ?if ] map ;
  77
  78 : supported-platform? ( platforms -- ? )
  79     [ t ] [ [ os swap class<= ] any? ] if-empty ;
  80
  81 : don't-load? ( vocab -- ? )
  82     {
  83         [ vocab-tags "not loaded" swap member? ]
  84         [ vocab-platforms supported-platform? not ]
  85     } 1|| ;
  86
  87 : don't-test? ( vocab -- ? )
  88     vocab-tags "not tested" swap member? ;
  89
  90 TUPLE: unsupported-platform vocab requires ;
  91
  92 : throw-unsupported-platform ( vocab requires -- )
  93     unsupported-platform boa throw-continue ;
  94
  95 M: unsupported-platform summary
  96     drop "Current operating system not supported by this vocabulary" ;
  97
  98 [
  99     dup vocab-platforms dup supported-platform?
 100     [ 2drop ] [ [ vocab-name ] dip throw-unsupported-platform ] if
 101 ] check-vocab-hook set-global