scoop - Distributed Felix package manager 
  Author Mike Maul
  See README.md for more details
  
  SETUP_LOG="";
  include "std/felix/pkgtool/pkgtool_base";
  
  open PkgTool;
  open Filename;
  var LIST_INSTALLED = false;
  var DEGITIFY = false;
  var CLEANBUILD = false;
  val SCOOP_VERSION = "0.3";
  var flx_extra_opts = "";
  proc get_pkg (pkg:string,dest:string) {
    cfg = read_cfg((LITTERBOX.join(pkg)).join("README.md"));
    match get cfg 'PKG_URL' with
    |Some pkg_url => { git_get(pkg_url,dest); }
    |_ => { general_fail(pkg+" not found in litterbox.");  }
    endmatch;
  }
  
  proc task (s:string) { dsply.task s; }
  proc warning (s:string) { dsply.warning s; }
  proc banner (s:string) { dsply.banner s; }
  proc phase (s:string) { dsply.phase s; }
  proc kudos (s:string) { dsply.kudos s; }
  
  fun head[T] (l:list[T]) => match l with |Cons (hd,_) => Some hd |Empty => None[T] endmatch;
  
  fun safe_tail[T](l:list[T]) => match l with |Empty => Empty[T] |Cons(_,t) => t endmatch;
   
  proc info (pkg:string) () {
    var readme = (LITTERBOX.join(pkg)).join("README.md");
    match filetype(readme) with
    |REGULAR => { 
      val cfg = read_cfg(readme);
      task("NAME: " + (get cfg 'NAME').or_else "");
      task("DESCRIPTION: " + (get cfg 'DESCRIPTION').or_else "");
      task("VERSION: " + (get cfg 'VERSION').or_else "");
      task("PKG_URL: " + (get cfg 'PKG_URL').or_else "");
      task("AUTHOR: " + (get cfg 'AUTHOR').or_else "");
      task("AUTHOR_URL: " + (get cfg 'AUTHOR_URL').or_else "");
      display$ "----"+NL;
      display(((get cfg 'LONG_DESCRIPTION').or_else "")+NL);
    }
    |_ => { general_fail(q"No package README.md found for $(pkg) or $(pkg) does not exist");}
    endmatch; 
  }
  
  fun getchar: 1->int = "getchar()" requires C89_headers::stdio_h;
  
  proc readme (pkg:string) {
    var readme = (LITTERBOX.join(pkg)).join("README.md");
    var lines = atoi(Env::getenv("LINES","24"));
    match filetype(readme) with
    |REGULAR => { 
      val cfg_h = fopen_input(readme);
      if valid(cfg_h) do
        while not feof(cfg_h) do
          for var i in 0 upto lines do
            print$ readln$ cfg_h;
          done
          if not feof(cfg_h) do
            endl;print$ "More....(Press Enter)";
            C_hack::ignore(getchar());
          done
        done
        endl;
      done
    }
    |_ => { general_fail(q"No package README.md found for $(pkg) or $(pkg) does not exist");}
    endmatch; 
  }
  
  
  
  fun is_litterbox_fresh() =>
    let git_dir = LITTERBOX.join(".git") in
    if FileStat::fileexists(git_dir) then
      let fetch_head = git_dir.join("FETCH_HEAD") in
        if FileStat::fileexists(fetch_head) then
          (time() - FileStat::filetime(fetch_head)) < 86400.0
        else 
          false
        endif
    else
      false
    endif;
  
  
  proc search (opts:list[string]) () {
     val num_opts = int(len(opts));
     var not_even_num_args = (num_opts > 1) and ((num_opts % 2) != 0);
     if (num_opts < 1) or not_even_num_args do
       general_fail("""search requires ether a single name or an even number of terms 
  (e.g. field search_string ...)""");
     done
     fun to_assoc_list[T] (l:list[T]):list[T^2] =>
       match l with
       |Cons (k,Cons(v,tl)) => Cons((k,v) , to_assoc_list(tl))
       |Empty => Empty[T^2]
       endmatch;
  
     var searchd = if num_opts == 1 then 
       list[string^2](("NAME",(let Some v = head(opts) in v)))
     else 
       to_assoc_list(opts)     
     endif;
     match Directory::filesin(LITTERBOX) with
     |Some files => { 
       for file in sort(filter (fun (f:string) => not f == "build" and not f.startswith ".") files) do
         var dir_path = LITTERBOX.join(file);
          match filetype(dir_path) with 
         |DIRECTORY => {
          var pkg_readme = dir_path.join("README.md");
          match filetype(pkg_readme) with
          |REGULAR => { 
            var pkg = read_cfg(pkg_readme);
            var ss : list[string*string] = sort searchd;
            var it  = iterator(ss);
            for itm12 in it do
              var iiiitm:string^2 = itm12; 
              match get pkg (toupper(iiiitm.0)) with
              |Some pkg_v => { 
                match find((toupper(pkg_v)), (toupper(iiiitm.1))) with
                |Some _ => {
  	        var name = (get pkg "NAME").or_else("");
                  if not name == "" do
                    var inst_ver = is_installed(name);
                    var pkg_ver = atof(match get pkg "VERSION" with |Some v =>v |_ => "" endmatch);
  	          task$ ((match is_installed(name) with
                    |Some inst_ver when inst_ver == pkg_ver => 
                      blue_((ljust(name,20)).[0 to 20]+" "+
                      (ljust(str(pkg_ver),6)).[0 to 6]) 
                    |Some inst_ver when pkg_ver > inst_ver  => 
                        red_((ljust(name,20)).[0 to 20]+" "+
                      (ljust(str(pkg_ver),6)).[0 to 6]) 
                    |_ => yellow_((ljust(name,20)).[0 to 20]+" "+
                      (ljust(str(pkg_ver),6)).[0 to 6])
                    endmatch) + 
                      "   "  + NC_(((get pkg "DESCRIPTION").or_else "")));
                    
                  done
                  //grr(Empty);
                  goto enough; 
                }
                |_ => {}
                endmatch;
              }
  	    |_ => { }
              endmatch;
            done
  enough:>
          }
          |_ => {}
          endmatch;
        }
        |_ => {}
        endmatch;
        
      done
    }
    |_ => {}
    endmatch;
    endl;
    dsply.task(blue_("* installed")+" "+red_("* newer version")+" "+
         yellow_("* not installed"));  
  }
  
  proc refresh () {
    git_get(LITTERBOX_URL,LITTERBOX);
  
  }
    proc help(unit) {
      println$ """
  scoop: A distributed package manager for Felix
  
  usage:
    Repository Related commands
    ---------------------------
    scoop list   [installed] [options] Lists all packages on litterbox. 
                                       If 'installed' argument is passed then
                                     only installed packages are listed.
    scoop search  <package>  [options] Searches for package on litterbox
    scoop info    <package>  [options] Displays package info
    scoop info    <package>  [options] Displays package README.md
    scoop refresh            [options] Refreshes litterbox package directory cache
    scoop reinstall          [options] Reinstalls all previously installed packages
  
    Package Commands
    ---------------
    scoop get     <package> [build dir] [options] Pull package from litterbox 
      to the HOME/.felix/litterbox/build/<package> directory or [build dir] 
      if specified
    scoop build   [package] [build dir] [options] Builds package in
      HOME/.felix/litterbox/build/<package> or [build dir]
    scoop test    [package]  [options] Runs package test on package in
      HOME/.felix/litterbox/build/<package> or [build dir]
    scoop install [package]  [options] Installs package located at
      HOME/.felix/litterbox/build/<package> or [build dir]
    scoop clean [package]  [options] Removes package build directory at
      HOME/.felix/litterbox/build/<package> or [build dir]
    scoop dump  Removes litterbox package directory at
      HOME/.felix/litterbox
  
    * For package commands with optional [package] argument when [package] is omitted
       and you are in a package directory, scoop will apply command to current directory.
   
    Miscelaneous Commands and Options
    ---------------------------------
    scoop help               Displays this message
    scoop help    <command>  Displays detailed help for command
  
    options:
    --litterbox-url=[Repository URL]           Specify a new repository to use
    --litterbox=[Local repository cache dir]   Use a specific litterbox cache dir
    --degitify                                 Strip git repo info from package
                                               only active for 'scoop get'
    --force                                    Skip tests and do not stop on
                                               missing dependencies durring
                                               'scoop install' 
  """;
  NC();
  }
  
    proc help_command (command:list[string]) {
      match command with
      |Empty => {help();}
      |Cons (cmd,_) when cmd == 'get'   => { println$ """
  Description: Pulls package from remote package source into the current working directory and places into a driectory with the same name as the package.
  
  For package build options run 'flx setup help' inside the package directory.
  Refer to the package README.md as well. 
  Usage: scoop get [package]
  
  """;
      }
      |Cons (cmd,_) when cmd == 'list'    => {
        println$ """
  Description: List all available packages in the litterbox package directory.
  
  Usage: setup.flx list
  """;
        }
      |Cons (cmd,_) when cmd == 'search' => {
        println$ """
  Description: Searchs package definitions. Given one argument 'scoop search' will
  search for a package name that is a partial match for the given argument.
  For example:  scoop search x
  Will find the x11 package
  Given an even number of argument search will search is specific package 
  definition fields for string matches. Package definition fields are 
   NAME , DESCRIPTION, CATEGORY, VERSION, AUTHOR, PKGDIR, PKG_URL, LICENSE,
   REQUIRES
  For example: 'scoop search CATEGORY GUI' will match the 'fltk' and 'x11' packages.
  Multiple package fields can be specified. For example: 'scoop search CATEGORY GUI NAME fltk' will only match the 'fltk' package.
  
  Package field names and match strings are case independant.
  
  Usage: scoop search [package name]
         scoop search [<package field> <string match>]...
  """;
        }
      |Cons (cmd,_) when cmd == 'info'   => {
        println$ """
  Description: Displays detailed package info.
  
  Usage: scoop info [package]
  
  """;
        }
      |Cons (cmd,_) when cmd == 'install'    => {
        println$ """
  Description: Install package into Felix root installation. This command pulls 
  the package from the remote package to the directory HOME/.felix/.litterbox/build/<package>.
  It then proceeds to execute the packages install script.
  
  Usage: scoop install [package]
  """;
        }
  
     |Cons (cmd,_) when cmd == 'refresh'    => {
        println$ """
  Description: Pull a updated copy of the litterbox package directory.
  
  Usage: scoop refresh
  """;
        }
       |Cons (cmd,_) when cmd == 'help'    => {
        println$ """
  Description:  Displays help.
  """;
      }
      |Cons (cmd,_) when cmd == 'installed'    => {
        println$ """
  Description:  Displays a listing of all installed packages and versions.
  """;
      }
      |cmd                       => {
        invalid_cmd(join_list(cmd));
      }
    endmatch;
    }
  
  proc invalid_cmd(cmd:string) {
        warning("Invalid commaind:"+cmd);
        help();  
  }
  
  gen handle_local_options(optt:int*list[string]) = {
    var valid_opts = 0;
    var unused_opts = Empty[string];
    match optt with
    |v,opts => {
      for arg in opts do
        match arg with
        |option when option.startswith "--litterbox-url=" => {
          LITTERBOX_URL = arg.[16 to];
          valid_opts++;
        }
        |option when option.startswith "--litterbox=" => {
          LITTERBOX = arg.[12 to];
          valid_opts++;
        }
        |option when option.startswith "--degitify" => {
          DEGITIFY = true;
          valid_opts++;
        }
        |option when option.startswith "--force" => {
          FORCE = true;
          valid_opts++;
        }
        |option when option.startswith "--clean" => {
          CLEANBUILD = true;
          valid_opts++;
        }
        |option when option.startswith "--version" => {
          display$ "Scoop version " + SCOOP_VERSION;
          valid_opts++;
        }
        |option => { unused_opts += option; }
        endmatch;
      done
    }
    endmatch;
    return (valid_opts,unused_opts);
  }
  
    proc clean(pkg:string,pkg_dir:string,extra_opts:string) {
    if CLEANBUILD and match filetype(pkg_dir) with |DIRECTORY => true |_ => false endmatch do
        if System::system(FLX+" --inline=5 " + " "+ flx_extra_opts + " "+
          pkg_dir.join("setup")+" clean --build-dir=" + pkg_dir +
          extra_opts) != 0 do
          warning("Clean failed");
        done
      done
    }
  
    proc get(pkg:string,pkg_dir:string) {
      phase(q"Scooping package $(pkg) from litterbox.",
        proc () { get_pkg(pkg,pkg_dir); });
    }
  
    proc build(pkg:string, pkg_dir:string,extra_opts:string) {
      validate_pkg_dir(pkg,pkg_dir);
      var cmd = FLX+" --inline=0 " + " "+ flx_extra_opts + " "+
        pkg_dir.join("setup")+" build --build-dir=" + pkg_dir +
        extra_opts;
     val result = System::system(cmd);
      if result != 0 do  
        warning("Build failed");
      else
        kudos("Build successful");
      done  
    }
  
    proc test(pkg:string, pkg_dir:string,extra_opts:string) {
      validate_pkg_dir(pkg,pkg_dir);
      val result = System::system(FLX+" --inline=0 " + " "+ flx_extra_opts + " "+
      pkg_dir.join("setup")+" test --build-dir=" + pkg_dir +
      extra_opts);
      if result != 0 do  
        warning("Test failed");
      else
        kudos("Test successful");
      done  
    }
  
    fun pkg_setup_exists(pkg:string,pkg_dir:string) =>
      FileStat::fileexists(pkg_dir.join("setup.flx"));
  
    proc install(pkg:string, pkg_dir:string, extra_opts:string) {
      if not pkg_setup_exists(pkg,pkg_dir) do
        get(pkg,pkg_dir);
        build(pkg,pkg_dir,extra_opts);
        if not FORCE do test(pkg,pkg_dir,extra_opts); done
      done 
      
      val result = System::system(FLX+" --inline=0 " + " "+ flx_extra_opts + " "+
      pkg_dir.join("setup")+" install --build-dir=" + pkg_dir +
      extra_opts);
      if result != 0 do  
        warning("Install failed");
      else
        kudos("Install successful");
        cleanup(pkg,pkg_dir);
      done   
    }
  
    fun validate_pkg_dir(pkg:string, pkg_dir:string) = {
      if not FileStat::fileexists(pkg_dir) do
        general_fail("Error package directory "+pkg_dir+
          " does not exist. Did you forget to do 'scoop get "+pkg+"'?");
      done
      if FileStat::fileexists(pkg_dir.join("setup.flx")) do
        var cfg = read_cfg(pkg_dir.join("README.md"));
        match get cfg "NAME" with
        |None => { general_fail("Error package directory "+pkg_dir+
          " because it does not appear to be a valid package directory"); }
        |Some p => { if not p == pkg do 
          general_fail("Error package direcotry "+pkg_dir+
          " because it does not appear to be a valid package directory");
          done
        }
        endmatch;
      else
        general_fail("Error package directory "+pkg_dir+
          " because it does not appear to be a valid package directory");
      done
    }
  
    proc cleanup(pkg:string, pkg_dir:string) {
      if not pkg_dir == "." do  
        var result_code = 0;
          task$ "Removing build directory:" + pkg_dir;
          if FileStat::fileexists(pkg_dir.join("setup.flx")) do
            var cfg = read_cfg(pkg_dir.join("README.md"));
            match get cfg "NAME" with
            |None => { general_fail("Unable to remove package direcotry "+pkg_dir+
              " because it does not appear to be a package dir"); }
            |Some p => { if not p == pkg do 
              general_fail("Unable to remove build directory because "+pkg_dir+
                " does not appear to be a package dir for the package "+pkg);
              done
            }
            endmatch;
            if PLAT_WIN32 do
              result_code=System::system("rd /S /Q "+pkg_dir);
            else
              result_code=System::system("rm -rf "+pkg_dir);
            done
            if not result_code == 0 do
              warning$ "Unable to remove build directory:"+pkg_dir;
            done
          else
            general_fail("Error:"+pkg_dir+" does not appear to be a scoop_package dir");
          done
      else
        default_clean();
      done
    }
  
    proc dump() {
  println$ LITTERBOX_URL;
  println$ LITTERBOX;
      if FileStat::fileexists(LITTERBOX) do
        match filetype(LITTERBOX) with
        |DIRECTORY => { 
           var result_code = if PLAT_WIN32 then
             System::system("rd /S /Q "+LITTERBOX)
           else
             System::system("rm -rf "+LITTERBOX)
           endif;
           if not result_code == 0 do
             general_fail("Unable to empty litterbox:" + LITTERBOX);
           done
        }
        endmatch;
      done
      task$ "Litterbox at "+LITTERBOX+" emptyed";
      refresh();  
    }  
  
    proc do_package_command(cmd:string,options:list[string]) {
      var pkg,pkg_dir,remaining_options = get_pkg_dir_and_opts(options);
      var extra_opts = "";
      if not DEST_DIR == "" do extra_opts += " --dest-dir=" + DEST_DIR + " "; done
      if not EXTRA_INCDIR == "" do extra_opts += " -I" + EXTRA_INCDIR + " "; done
      if not EXTRA_LIBDIR == "" do extra_opts += " -L" + EXTRA_LIBDIR + " "; done
      if TEST_MODE do flx_extra_opts +=  " --test=" + DEST_DIR; 
                                   extra_opts += " --test=" + DEST_DIR;  FLX_INSTALL_DIR=DEST_DIR; done
      if FORCE do extra_opts += " --force "; done
      if DRY_RUN  do extra_opts += " --dry-run "; done
      match cmd with
      |"get" => get(pkg,pkg_dir);
      |"build" => build(pkg,pkg_dir,extra_opts);
      |"test" => test(pkg,pkg_dir,extra_opts);
      |"install" => install(pkg,pkg_dir,extra_opts);
      |"clean" => cleanup(pkg,pkg_dir);
      |_ => warning("Invalid command");
      endmatch;
    }
  
  fun get_pkg_dir_and_opts(options:list[string]) = {
    var retval = "","",Empty[string];
    match options with
    |Cons (pkg,as) when not pkg.startswith "--" => {
      var name=pkg; 
      retval = match head(as) with 
        |Some dir  when not dir.startswith "--" => name,dir,safe_tail(as) 
        |_ => name,(LITTERBOX.join("build")).join(pkg),as //safe_tail(as) 
      endmatch;
    }
    |_ => {
      var cfg = read_cfg(".".join("README.md"));
      match get cfg "NAME" with
      |Some pkg =>
        if pkg_setup_exists(pkg,".") do
          retval = pkg,".",options;
        done
      |_ =>
        general_fail("No package name specified");
      endmatch; 
    }
    endmatch;
    return retval;
  }
  
  
  proc run() {
      banner("Felix package manager");
      var args = tail(System::args());
      C_hack::ignore(handle_local_options$ handle_global_options(args));
      match filetype(LITTERBOX) with
      |NONEXISTANT => { phase("Initializing package repository",refresh);}
      |DIRECTORY => { }
      |_ => { general_fail("Error creating:"+LITTERBOX + ", try removing if it exists or checking permissions"); }
      endmatch;
      if not is_litterbox_fresh() do
        refresh();
      done
      var opts = Empty[string];
      var valid_opts = 0;
      match args with
      |Cons (command,options) => {
        match command with
        |cmd when cmd == "get" => { do_package_command(cmd,options); }
        |cmd when cmd == "install" => { do_package_command(cmd,options); }
        |cmd when cmd == "build" => { do_package_command(cmd,options); }
        |cmd when cmd == "test" => { do_package_command(cmd,options); }
        |cmd when cmd == "clean" => { do_package_command(cmd,options); }
        |cmd when cmd == "reinstall" => { repeat_history(); }
        |cmd when cmd == "search" => { 
            banner("Search");
            phase("packages matching:"+str(options),(search options) );
          }
        |cmd when cmd == "list" => {
          match options with
          |Cons (opt,_) when opt == 'installed' => { 
            banner("Installed Package");
            for pkg in installed() do
              match pkg with
              | p,v when not p == "" => { task(INDENT+p+" "+v); }
              |_ => { }
              endmatch; 
            done
          }
          |_ => {
            banner("Packages");
            phase(INDENT+(ljust("package",20)).[0 to 20]+" "+
              (ljust("ver.",6)).[0 to 6],(search (list('NAME','')) ));
          }
          endmatch; 
         }
        |cmd when cmd == "info" => { 
            banner("Info");
            phase("packages info:" + ((head(options)).or_else ""),
              (info ((head(options)).or_else "")) );
          }
        |cmd when cmd == "readme" => { 
            banner("README.md");
            readme ((head(options)).or_else "");
          }
        |cmd when cmd == "refresh" => { 
            banner("Refresh");
            phase("Refresh Repository",refresh);
          }
        |cmd when cmd == "dump" => { 
            banner("Dumping Litterbox");
            phase("Emptying Litterbox",dump);
          }
        |cmd when cmd == "help" => {
          help_command(options);
          }
        |cmd => { invalid_cmd(cmd); }
        endmatch;
      }
      
      |_ => { invalid_cmd("?"); }
      endmatch;
  }
  
  run();