extra/tldr/tldr.factor

   1 ! Copyright (C) 2021 John Benediktsson
   2 ! See http://factorcode.org/license.txt for BSD license
   3
   4 USING: assocs combinators command-line http.client io
   5 io.directories io.encodings.utf8 io.files io.files.temp
   6 io.launcher io.pathnames json.reader kernel namespaces sequences
   7 splitting system urls wrap.strings ;
   8
   9 IN: tldr
  10
  11 SYMBOL: tldr-language
  12 tldr-language [ "en" ] initialize
  13
  14 SYMBOL: tldr-platform
  15 tldr-platform [
  16     os {
  17         { macosx [ "osx" ] }
  18         { linux [ "linux" ] }
  19         { windows [ "windows" ] }
  20     } case
  21 ] initialize
  22
  23 <PRIVATE
  24
  25 CONSTANT: tldr-zip URL" https://tldr-pages.github.io/assets/tldr.zip"
  26
  27 : download-tldr ( -- )
  28     "tldr" cache-file dup make-directory [
  29         tldr-zip "tldr.zip" download-to
  30         { "unzip" "tldr.zip" } try-process
  31     ] with-directory ;
  32
  33 : ?download-tldr ( -- )
  34     "tldr/tldr.zip" cache-file file-exists? [ download-tldr ] unless ;
  35
  36 MEMO: tldr-index ( -- index )
  37     "tldr/index.json" cache-file path>json ;
  38
  39 : find-command ( name -- command )
  40     tldr-index "commands" of [ "name" of = ] with find nip ;
  41
  42 : platform ( command -- platform )
  43     "platform" of tldr-platform get '[ _ = ] find nip "common" or ;
  44
  45 : language ( command -- language )
  46     "language" of tldr-language get '[ _ = ] find nip "en" or ;
  47
  48 : tldr-path ( name platform language -- path )
  49     "pages" over "en" = [ nip ] [ "." glue ] if prepend-path
  50     swap ".md" append append-path "tldr" cache-file prepend-path ;
  51
  52 PRIVATE>
  53
  54 : tldr ( name -- lines )
  55     dup find-command [ platform ] [ language ] bi
  56     tldr-path utf8 file-lines ;
  57
  58 : tldr. ( name -- )
  59     tldr [
  60         { "`" "    " } [ ?head ] any? [
  61             "`" ?tail drop 76 "  " wrap-indented-string
  62         ] [
  63             { "# " "= " "> " "- " } [ ?head ] any? drop
  64             76 wrap-string
  65         ] if print
  66     ] each ;
  67
  68 : tldr-main ( -- )
  69     command-line get [ tldr. nl ] each ;
  70
  71 MAIN: tldr-main