nixredo/lib.nix

{ pkgs ? import <nixpkgs> {} }:
let
  lib = pkgs.lib;
  inherit (builtins) baseNameOf dirOf length genList pathExists isString match
  replaceStrings readDir;
  inherit (lib) take splitString last foldl foldr head tail removePrefix
  hasSuffix removeSuffix flatten crossLists reverseList all any unique hasPrefix
  cleanSourceWith;

  inherit (pkgs) runCommand symlinkJoin;

  butlast = list: take (length list - 1) list;

  doFileSuffix = "do";

  genPatterns = path: let
    fn = baseNameOf path;
  in (map (x: "default." + x)
       (foldr (a: b: let x = (head b); in [ (a + "." + x) ] ++ b)
         [ doFileSuffix ]
         (tail (splitString "." fn))));

  genPathlist = path: let
    pathlist = (splitString "/" path);
    foldedpaths = foldr (a: b:
      let
        h = if length b == 0 then "" else head b;
      in [ (h + a + "/") ] ++ b) [] (tail (reverseList pathlist));
  in foldedpaths;

  searchPath = path:
    let
      pathlist = (splitString "/" path);
      pat = (last pathlist);
      doFile = path + "." + doFileSuffix;
      patlist = genPatterns pat;
      foldedpaths = genPathlist path;
      pths = crossLists (p: pat: p + pat) [ foldedpaths patlist ];
    in [ doFile ] ++ pths;

  whichdo = path: let
    pathlist = searchPath path;
  in foldl (res: p: if res == "" then if pathExists p then p else res else res) "" pathlist;

  # Redo's $1, the full name of the target
  d1 = path: pat: let
    dir = (dirOf pat) + "/";
  in removePrefix dir path;

  # Redo's $2, the full name of the target or the name stripped by a suffix for
  # a default.* target.
  d2 = path: pat: let
    dir = (dirOf pat) + "/";
    _path = removePrefix dir path;
    _pat = removeSuffix ".${doFileSuffix}" (removePrefix "${dir}default" pat);
    _out = removeSuffix _pat _path;
  in if _out == "" then _path else _out;

  # The varargs capture combinator used by getSrc.
  # Fuctions calling this are expected to supply a function treating one
  # argument to the final function and a second function that operates on the
  # whole list of arguments. Call the final function with literal null to
  # trigger evaluation.
  captureFunc = argFun: f: {
    args = [];
    __functor = self: a: let
      _a = argFun a;
    in if a == null
       then f self.args
       else self // { args = self.args ++ [ _a ]; };
    __toString = self: f self.args;
  };

  # Resolve a src given as string relative to cwd and root.
  resolveSrc = root: rcwd: a: let
    sanitize = s: let _s = replaceStrings [ "/./" ] ["/"] s; in if s != _s then sanitize _s else s;
    _a = toString (/. + (root + "/" + rcwd + "/" + (sanitize a)));
  in
    if isString a then _a else toString a;

  # Add all preceding paths to a src down to the root. Otherwise
  # builtins.filterSource will reject it.
  augmentedSrcs = root: srcs: let
    aug = map (s: (map (p: root + (removeSuffix "/" p)) (genPathlist (removePrefix root s)))) srcs;
  in unique (flatten aug);

  # The source tree resolver combinator.
  # Takes the source root and cwd of the current builder and a list of paths
  # that shall always be rejected.
  # Also takes a resolver to derive unknown paths and a function to which the
  # resulting set is applied to.
  #
  # Returns a filter that accepts zero to n paths relative to cwd. Captures the
  # whole source tree when called with zero arguments.
  getSrc = root: rcwd: rejected: resolver: outFunc:
    captureFunc (resolveSrc root rcwd) (srcs: let

      rejector = path: (all (x: path != x) rejected);

      # Filter non-existant sources and build them with resolver.
      # Recreate the source directory structure.
      nonExistantSrcs = builtins.filter (x: let
        isLink = x: let
          base = baseNameOf x;
          parent = dirOf x;
          type = (readDir parent).${base} or null;
        in (type == "symlink");
      in !pathExists x || isLink x) srcs;

      builtSrcs = map (s: let
        relPath = removePrefix (root + "/") s;
        filePath = resolver s;
      in runCommand relPath { preferLocalBuild = true; allowSubstitutes = false; } ''
         mkdir -p "$out/${dirOf relPath}"
         ln -s "${filePath}" "$out/${relPath}"
      '') nonExistantSrcs;

      # If a src in srcs is a prefix to a that (it must be a dir, then, or the
      # file itself), allow all sub-paths.
      srcFilter = path:
        if srcs == []
        then true
        else (any (x: (hasPrefix x path)) (builtins.filter pathExists srcs));

      # Allow all directories lying on the way to specified srcs.
      _srcs = (augmentedSrcs root srcs);
      srcDirFilter = path: if srcs == []
                        then true # No explicit srcs means: Take the whole source tree!
                        else (any (x: path == x) (_srcs));

      # Filter the sources by our defined criteria and create a source tree
      # derivation.
      filter = (path: type:
        (baseNameOf path != ".git") &&
        (baseNameOf path != ".envrc") &&
        (rejector path) &&
        ((srcFilter path) ||
         (srcDirFilter path)));
      filteredSrcs = cleanSourceWith { inherit filter; src = root; };

      # Merge the filtered sources and the newly built dependencies.
      mergedSrcs = symlinkJoin { name = "srcs"; paths = [ filteredSrcs ] ++ builtSrcs; };

    in outFunc mergedSrcs);

  self = {
    inherit doFileSuffix whichdo d1 d2 getSrc;
    # For testing. To be removed.
    inherit searchPath augmentedSrcs genPathlist captureFunc;
  };

in self