extra/tools/which/which.factor

   1 ! Copyright (C) 2012 John Benediktsson
   2 ! See http://factorcode.org/license.txt for BSD license
   3
   4 USING: arrays assocs combinators.short-circuit command-line
   5 environment io io.backend io.files io.files.info io.pathnames
   6 kernel namespaces sequences sets splitting system unicode ;
   7
   8 IN: tools.which
   9
  10 <PRIVATE
  11
  12 : executable? ( path -- ? )
  13     {
  14         [ exists? ]
  15         [ file-executable? ]
  16         [ file-info directory? not ]
  17     } 1&& ;
  18
  19 : split-path ( paths -- seq )
  20     os windows? ";" ":" ? split harvest ;
  21
  22 : path-extensions ( command -- commands )
  23     "PATHEXT" os-env [
  24         split-path 2dup [ [ >lower ] bi@ tail? ] with any?
  25         [ drop 1array ] [ [ append ] with map ] if
  26     ] [ 1array ] if* ;
  27
  28 : find-which ( commands paths -- file/f )
  29     [ normalize-path ] map members
  30     cartesian-product flip concat
  31     [ prepend-path ] { } assoc>map
  32     [ executable? ] find nip ;
  33
  34 : (which) ( command path -- file/f )
  35     split-path os windows? [
  36         [ path-extensions ] [ "." prefix ] bi*
  37     ] [ [ 1array ] dip ] if find-which ;
  38
  39 PRIVATE>
  40
  41 : which ( command -- file/f )
  42     "PATH" os-env (which) ;
  43
  44 : ?which ( command -- file/command )
  45     [ which ] [ or ] bi ;
  46
  47 : run-which ( -- )
  48     command-line get [ which [ print ] when* ] each ;
  49
  50 MAIN: run-which