Load a directory tree with combinators

load-tree.nix

let
  inherit (builtins)
    attrNames
    concatMap
    concatStringsSep
    elem
    elemAt
    filter
    hasAttr
    head
    isAttrs
    listToAttrs
    map
    match
    readDir
    substring
    stringLength
    isPath
    isFunction
    warn
    trace
    length
    ;
  id = arg: arg;
  traceValFn = f: val: trace (f val) val;
  traceVal = traceValFn id;
  warnIf = cond: msg: if cond then warn msg else x: x;
  hasSuffix =
    suffix: content:
    let
      lenContent = stringLength content;
      lenSuffix = stringLength suffix;
    in
    # Before 23.05, paths would be copied to the store before converting them
    # to strings and comparing. This was surprising and confusing.
    warnIf (isPath suffix)
      ''
        lib.strings.hasSuffix: The first argument (${toString suffix}) is a path value, but only strings are supported.
            There is almost certainly a bug in the calling code, since this function always returns `false` in such a case.
            This function also copies the path to the Nix store, which may not be what you want.
            This behavior is deprecated and will throw an error in the future.''
      (lenContent >= lenSuffix && substring (lenContent - lenSuffix) lenContent content == suffix);
  nameValuePair = name: value: {inherit name value;};
  filterAttrs = pred: set: removeAttrs set (filter (name: !pred name set.${name}) (attrNames set));
  foldr =
    op: nul: list:
    let
      len = length list;
      fold' = n: if n == len then nul else op (elemAt list n) (fold' (n + 1));
    in
    fold' 0;
  foldl =
    op: nul: list:
    let
      foldl' = n: if n == -1 then nul else op (foldl' (n - 1)) (elemAt list n);
    in
    foldl' (length list - 1);
  self = rec {
    lazyTree' = readDir: parts': path': let
      dir = readDir path';
      in listToAttrs (map (name: let
          path = "${path'}/${name}";
          parts = parts' ++ [name];
          children = lazyTree' readDir parts path;
        in nameValuePair name ({
          inherit name path parts;
          type = dir.${name};
          origType = dir.${name};
          origName = name;
          origPath = path;
          origParts = parts;
        } // (if dir.${name} == "directory" then { inherit children; origChildren = children; } else {}))
        ) (attrNames dir));
    lazyTree = readDir: path: lazyTree' readDir [] path;
    readTree' = lazyTree' readDir;
    readTree = path: readTree' [] path;

    make = let
        multi = name: attrs: f: prev: 
          (listToAttrs (map (attr: nameValuePair attr (f attr prev)) attrs)) // {inherit name;};
        rawFilter = name: type: f: multi name [type] (_: f);
      in {
      inherit multi rawFilter;
      walk = name: f: multi name ["walk"] (_: f);
      loader = name: f: multi name ["loader"] (_: f);
      outer = name: f: multi name ["outer"] (_: f);
      filter = name: type: f: rawFilter name type (prev: ops: loc: node: (f ops loc node) && (prev.${type} ops loc node));

      overidable = (attr: prev: ops: loc: node: let
          subdir =  concatStringsSep "/" loc.parts;
          hasOverride = (hasAttr subdir ops.override) && (hasAttr attr ops.override."${subdir}");
          overridenValue = ops.override."${subdir}";
          overridden = if isFunction overridenValue then overridenValue ops else overridenValue;
          overideOps = if hasOverride then ops // overridden else prev;
          fn = if hasOverride then overideOps.${attr} else prev.${attr};
        in fn overideOps loc node
      );

      walker = name: walkers: prev:
        foldl 
          (prev': walker': prev' // (if isFunction walker' then walker' prev' else walker'))
          prev
          (walkers ++ [{ inherit name walkers; }]);
    };


    hasRegularFile = name: node: 
      (node ? children) && hasAttr name node.children && node.children.${name}.type == "regular";


    outer = {
      allModules = make.outer "outer.allModules" (_prev: _ops: _loc: result:
          result // { __functor = _: {
              imports = map (n: result.${n}) (attrNames result);
            };
        });
    };
    loader = {
      importFile = make.loader "loader.importFile" (_prev: _ops: loc: node: 
        nameValuePair loc.name (import node.path));

      filter = make.loader "loader.filter" (prev: ops: loc: node: let
        included = ops.filterLoad ops loc node;
        in if included then prev.loader ops loc node else null
      );
    };
    filter = {
      /**
        Filters out any directory that contains the .skip-tree marker file.
      */
      skipTree = make.filter "filter.skipTree" "filter" (ops: loc: node: 
        !((node ? origChildren) && node.origChildren ? ".skip-tree")
      );

      /**
        Filters out any dotfiles.

        This means any file or directory that begins with a dot (.) will not be further processed
        and will also not appear in the final tree.
      */
      dotFiles = make.filter "filter.dotFiles" "filter" (ops: loc: node:
        (substring 0 1 loc.name) != ".");

      target = make.filter "filter.target" "filter" (ops: loc: node: 
        loc.name != ops.target
      );

      nixFile = make.filter "filter.nixFile" "filter" (ops: loc: node:
        let
            nixFile = utils.nixFileName loc.name;
          in node.type == "directory" || nixFile != null
      );

    };
    walk = {
      /**
        Filters out sub-directories if the .skip-subtree marker file exists.
        
        Looks for a file called .skip-subtree in the children of the node and if
          found filters out any directories from the children.
      */
      skipSubTree = make.walk "walk.skipSubTree" (prev: ops: loc: node: 
        if (node ? children) && (node ? origChildren) && node.origChildren ? ".skip-subtree"
        then let
            children = filterAttrs (_: child: child.type != "directory") node.children;
            newNode = node // { inherit children; };
          in prev.walk ops loc newNode
        else prev.walk ops loc node
      );

      /**
        Loads target file if it exists instead of walking the directory.


        ```

        ```
      */
      loadTarget = make.walk "walk.loadTarget" (prev: ops: loc: node:
        if hasRegularFile ops.target node
        then ops.loader ops loc node.children.${ops.target}
        else prev.walk ops loc node);

      onlyFileTarget = make.walk "walk.onlyFileTarget" (prev: ops: loc: node:
        if hasRegularFile ops.target node
        then let
            children = (filterAttrs (n: v: v.type == "directory" || n == ops.target) node.children);
            newNode = node // {inherit children;};
          in prev.walk ops loc newNode
        else prev.walk ops loc node
      );

      onlyTarget = make.walk "walk.onlyTarget" (prev: ops: loc: node:
        if hasRegularFile ops.target node
        then let 
            children = { children."${ops.target}" = node.children.${ops.target}; };
            newNode = node // children;
          in prev.walk ops loc newNode
        else prev.walk ops loc node
      );

      subDirectories = make.walk "walk.subDirectories" (prev: ops: loc: node: let
        prevPair = (prev.walk ops loc node);
        children = if node ? children then ops.walkChildren ops loc node else null;
        in if prevPair != null
          then nameValuePair prevPair.name (if children != null then prevPair.value // children else prevPair.value)
          else null);
      
      filter = make.walk "filterWalk" (prev: ops: loc: node: let
        included = ops.filterWalk ops loc node;
        in if included then prev.walk ops loc node else null
      );

      outerTransform = make.walk "walk.outerTransform" (prev: ops: loc: node: 
        ops.outer ops loc (prev.walk ops loc node)
      );

      loadFiles = make.walk "loadFiles" (prev: ops: loc: node:
        if node ? children
        then prev.walk ops loc node
        else ops.loader ops loc node);
      rename = make.walk "walk.rename" (prev: ops: loc: node: let
          newOps = if isFunction ops.rename then ops else ops // { rename = prev.rename; };
          prevPair = prev.walk newOps loc node;
          newName = if isFunction ops.rename then ops.rename newOps loc prevPair.name else ops.rename;
        in if prevPair != null then nameValuePair newName prevPair.value else null);
      
      root = make.walk "walk.root" (prev: ops: loc: node: 
        utils.walkChildren (ops // {inherit (prev) walk;}) loc node
      );
    };
    
    rename = {
      nixFile = prev: {
        name = "rename.nixFile";
        rename = ops: loc: name: let
          nixFile = utils.nixFileName loc.name;
        in if nixFile != null then nixFile else name;
      };
    };
    
    utils = {
      nixFileName = file:
        let res = match "(.*)\\.nix" file;
        in if res == null then null else head res;

      childrenToAttrs = _ops: _loc: children: 
        listToAttrs (filter (d: d != null) children);
      walkChildren = ops: loc: node: let
          children' = (map (n: {loc = {name = n; parts = loc.parts ++ [n]; }; node = node.children.${n};}) (attrNames node.children));
          filtered = builtins.filter (child: ops.filterChildren ops child.loc child.node) children';
          walked = map (child: ops.walk ops child.loc child.node) filtered;
        in 
        ops.childrenToAttrs ops loc walked;

    };

    multi = {
      overridable = make.multi "overridable" [
          "walk" "loader" "filter" "filterChildren" "filterWalk" "filterLoad" "rename" "outer" "walkChildren" "childrenToAttrs"
        ] make.overidable;
    };

    walker = {
      defaultValues = {
        target = "default.nix";
        walkChildren = utils.walkChildren;
        childrenToAttrs = _ops: _loc: children: 
          listToAttrs (builtins.filter (d: d != null) children);
        override = {};
        filterChildren = ops: loc: node: ops.filter ops loc node;
        filterWalk = ops: loc: node: ops.filter ops loc node;
        filterLoad = ops: loc: node: ops.filter ops loc node;
        filter = _ops: _loc: _node: true;
        loader = _ops: loc: _node: nameValuePair loc.name {};
        outer = _ops: _loc: node: node;
        rename = _ops: _loc: name: name;
        walk = _ops: loc: _node: nameValuePair loc.name {};
      };
      default = (make.walker "default" [
        walker.defaultValues
        walk.importFile
        walk.emptyValueWalk
        walk.rename
        walk.subDirectories
        walk.loadFiles
        rename.nixFile
        filter.nixFile
        walk.outerTransform
        multi.overridable
        walk.skipSubTree
        filter.skipTree
        walk.root
        {
          override = {
            "nixos-modules" = prev: make.walker "nixosModules" [
              prev
              {rename = "nixosModules";}
            ];
          };
        }
      ]);

      readTree = (make.walker "readTree" [
        loader.importFile
        rename.nixFile
        filter.nixFile

        walk.loadTarget
        walk.subDirectories

        walk.loadFiles
        walk.onlyFileTarget

        filter.dotFiles
        walk.skipSubTree
        filter.skipTree
        filter.target

        #walk.filter
        #loader.filter
        walk.rename
        walk.outerTransform
        multi.overridable
      ]);
    };

    loadTree = {
        path
      , walker ? walker.defaultWalker
      , target ? "default.nix"
      }@args: let
        walker' = make.walker "loadTree" [
          self.walker.defaultValues
          args
          walker
          walk.root
        ];
        actual = walker' {};
        tree = { children =  readTree path; };
        in actual.walk actual {name = "root"; parts = [];} tree
      ;
  };
in self