##########################################################################

# COLL.TCL, collection management procedures
# Copyright (C) 2016-2025 Xavier Delaruelle
#
# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program.  If not, see <http://www.gnu.org/licenses/>.

##########################################################################

# build list of what to undo then do to move from an initial list to a target
# list, eventually checking element presence in extra from/to lists
proc getMovementBetweenList {from to {extfrom {}} {extto {}} {cmp eq}} {
   reportDebug "from($from) to($to) with extfrom($extfrom) extto($extto)"

   set undo {}
   set do {}

   # determine what element to undo then do
   # to restore a target list from a current list
   # with preservation of the element order
   ##nagelfar ignore #2 Badly formed if statement
   set imax [if {[llength $to] > [llength $from]} {llength $to} {llength\
      $from}]
   set list_equal 1
   for {set i 0} {$i < $imax} {incr i} {
      set to_obj [lindex $to $i]
      set from_obj [lindex $from $i]
      # check from/to element presence in extra from/to list
      set in_extfrom [expr {$from_obj in $extfrom}]
      set in_extto [expr {$to_obj in $extto}]
      # are elts the sames and are both part of or missing from extra lists
      # when comparing modules, ask comparison against loaded module
      # alternative and simplified names (modEq will also compare variants)
      if {($cmp eq {modeq} && ![modEq $to_obj $from_obj equal 1 3 1]) ||\
         ($cmp eq {eq} && $to_obj ne $from_obj) || $in_extfrom != $in_extto} {
         set list_equal 0
      }
      if {!$list_equal} {
         if {$to_obj ne {}} {
            lappend do $to_obj
         }
         if {$from_obj ne {}} {
            lappend undo $from_obj
         }
      }
   }

   return [list $undo $do]
}

# build list of currently loaded modules where modulename is registered minus
# module version if loaded version is the default one
proc getSimplifiedLoadedModuleList {} {
   set curr_mod_list {}
   array set curr_tag_arr {}
   set modpathlist [getModulePathList]
   foreach mod [getEnvLoadedModulePropertyParsedList name] {
      set altandsimplist [getLoadedAltAndSimplifiedName $mod]

      set parentmod [file dirname $mod]
      set simplemod $mod
      # simplify to parent name as long as it is found in simplified name list
      while {$parentmod ne {.}} {
         if {$parentmod in $altandsimplist} {
            set simplemod $parentmod
            set parentmod [file dirname $parentmod]
         } else {
            set parentmod .
         }
      }

      # add each module specification as list to correctly enclose spaces in
      # module name or variant name or value
      set simplemodvr [list $simplemod {*}[getVariantList $mod 5 1]]
      lappend curr_mod_list $simplemodvr
      # record tags applying to module in simplified version form
      set tag_list [getSaveTagList $mod]
      if {[llength $tag_list]} {
         set curr_tag_arr($simplemodvr) $tag_list
      }
   }

   return [list $curr_mod_list [array get curr_tag_arr]]
}

# return saved collections found in user directory which corresponds to
# enabled collection target if any set. extract one collection specifically
# when search mode is set to exact. only compute collection name if mode is
# set to name. translate collection name to __init__ if not found and
# swap_by_init enabled. if no_other_target enabled, ensure no result from
# other target are returned from glob search
proc findCollections {{coll *} {search glob} {swap_by_init 0} {errnomatch 0}\
   {checkvalid 1} {no_other_target 0}} {
   # initialize description with collection name
   set colldesc $coll

   if {$coll eq {}} {
      reportErrorAndExit [getEmptyNameMsg collection]
   } elseif {$coll eq {__init__}} {
      set collfile $coll
      set colldesc {}
   # is collection a filepath
   } elseif {[string first / $coll] > -1} {
      # collection target has no influence when
      # collection is specified as a filepath
      set collfile $coll
   # elsewhere collection is a name
   } elseif {[isEnvVarDefined HOME]} {
      set coll_dir [file join $::env(HOME) .module]
      set coll_glob $coll
      # find saved collections (matching target suffix). a target is a domain
      # on which a collection is only valid. when a target is set, only the
      # collections made for that target will be available to list and
      # restore, and saving will register the target footprint. current target
      # is ignored if --all option is set on savelist command
      set colltarget [getConf collection_target]
      if {$colltarget ne {} && ([getState hiding_threshold] < 2 ||\
         [currentState commandname] ne {savelist})} {
         append coll_glob .$colltarget
         # add knowledge of collection target on description
         append colldesc " (for target \"$colltarget\")"
      }
      set collfile [file join $coll_dir $coll_glob]
   } else {
      reportErrorAndExit {HOME not defined}
   }

   switch -- $search {
      glob {
         # glob excludes by default files starting with "."
         if {[catch {set clist [glob -nocomplain -directory $coll_dir\
            $coll_glob]} errMsg]} {
            reportErrorAndExit "Cannot access collection directory.\n$errMsg"
         } else {
            set res {}
            foreach cfile $clist {
               # test collection is from correct target or no target if
               # no_other_target is enabled
               set cfile_ext [string range [file extension $cfile] 1 end]
               if {(!$no_other_target || $cfile_ext eq [getConf\
                  collection_target]) && [checkValidColl $cfile]} {
                  lappend res $cfile
               }
            }
         }
      }
      exact {
         if {$coll ne {__init__}} {
            # verify that file exists
            if {![file exists $collfile]} {
               if {$errnomatch} {
                  reportErrorAndExit "Collection $colldesc cannot be found"
               } else {
                  set collfile {}
               }
            # error will be raised if collection not valid
            } elseif {$checkvalid && ![checkValidColl $collfile\
               $errnomatch]} {
               set collfile {}
            }
         }
         if {$collfile eq {} && $swap_by_init} {
            set collfile __init__
            set colldesc {}
         }
         # return coll filename and its description for exact and name modes
         set res [list $collfile $colldesc]
      }
      name {
         set res [list $collfile $colldesc]
      }
   }

   return $res
}

proc checkValidColl {collfile {report_issue 0}} {
   set res 0
   if {[catch {
      set fdata [readFile $collfile 1]
      # extract magic cookie (first word)
      set fh [string trimright [lindex [split [string range $fdata 0 32]]\
         0] #]
   } errMsg ]} {
      if {$report_issue} {
         reportErrorAndExit [parseAccessIssue $collfile]
      }
   } else {
      # collection without magic cookie are valid
      # check if min version requirement is met
      if {[string equal -length 8 $fh {#%Module}] && [string length $fh] \
         > 8 && [versioncmp [getState modules_release] [string range $fh 8\
         end]] < 0} {
         if {$report_issue} {
            reportErrorAndExit "Collection $collfile requires at least\
               Modules version [string range $fh 8 end]"
         }
      } else {
         set res 1
      }
   }
   return $res
}

# generate collection content based on provided path and module lists
proc formatCollectionContent {path_list mod_list tag_arrser header {sgr 0}} {
   set content {}
   array set tag_arr $tag_arrser

   # graphically enhance module command if asked
   set modcmd [expr {$sgr ? [sgr cm module] : {module}}]

   # start collection content with modulepaths
   foreach path $path_list {
      # enclose path if space character found in it
      if {[string first { } $path] != -1} {
         set path "{$path}"
      }
      # 'module use' prepends paths by default so we clarify
      # path order here with --append flag
      append content "$modcmd use --append $path" \n
   }

   # then add modules
   foreach mod $mod_list {
      # save tags associated to module (like auto-loaded tag)
      if {[info exists tag_arr($mod)] && [llength $tag_arr($mod)]} {
         set opt "--tag=[join $tag_arr($mod) :] "
      } else {
         set opt {}
      }
      # no need to specifically enclose module specification if space char
      # used in it as $mod is a list so elements including space will be
      # automatically enclosed
      append content "$modcmd load $opt$mod" \n
   }

   # prepend header if defined and some content has been generated
   if {[string length $header] && [string length $content]} {
      set content "$header\n$content"
   }

   return $content
}

# read given collection file and return the path and module lists it defines
proc readCollectionContent {collfile colldesc} {
   # read file
   if {[catch {
      set fdata [split [readFile $collfile] \n]
   } errMsg ]} {
      reportErrorAndExit "Collection $colldesc cannot be read.\n$errMsg"
   }

   return [parseCollectionContent $fdata]
}

proc parseCollectionContent {fdata} {
   # init lists (maybe coll does not set mod to load)
   set path_list {}
   set mod_list {}
   set nuasked_list {}
   array set tag_arr {}

   # analyze collection content
   foreach fline $fdata {
      if {[regexp {module use (.*)$} $fline match patharg]} {
         # paths are appended by default
         set stuff_path append
         # manage multiple paths and path options specified on single line,
         # for instance "module use --append path1 path2 path3", with list
         # representation of patharg (which handles quoted elements containing
         # space in their name)
         foreach path $patharg {
            # following path is asked to be appended
            if {($path eq {--append}) || ($path eq {-a})\
               || ($path eq {-append})} {
               set stuff_path append
            # following path is asked to be prepended
            # collection generated with 'save' does not prepend
            } elseif {($path eq {--prepend}) || ($path eq {-p})\
               || ($path eq {-prepend})} {
               set stuff_path prepend
            } else {
               # ensure given path is absolute to be able to correctly
               # compare with paths registered in MODULEPATH
               set path [getAbsolutePath $path]
               # add path to end of list
               if {$stuff_path eq {append}} {
                  lappend path_list $path
               # insert path to first position
               } else {
                  lprepend path_list $path
               }
            }
         }
      } elseif {[regexp {module load (.*)$} $fline match modarg]} {
         # extract collection-specific flags from module specification
         switch -glob -- [lindex $modarg 0] {
            --notuasked {
               set tag_list [list auto-loaded]
               set cleanlist [lrange $modarg 1 end]
            }
            --tag=* {
               set tag_list [split [string range [lindex $modarg 0] 6 end] :]
               set cleanlist [lrange $modarg 1 end]
            }
            default {
               set tag_list {}
               set cleanlist $modarg
            }
         }
         # parse module specification to distinguish between module + variant
         # specified and multiple modules specified on a single line
         set parsedlist [parseModuleSpecification 0 0 0 0 {*}$cleanlist]
         foreach parsed $parsedlist {
            set tag_arr($parsed) $tag_list
         }
         lappend mod_list {*}$parsedlist
      }
   }
   return [list $path_list $mod_list [array get tag_arr]]
}

# return specified collection content and differences compared to currently
# defined environment
proc getDiffBetweenCurEnvAndColl {collfile colldesc} {
   # read specific __init__ collection from __MODULES_LMINIT env var
   if {$collfile eq {__init__}} {
      lassign [parseCollectionContent [getEnvLoadedModulePropertyParsedList\
         init]] coll_path_list coll_mod_list coll_tag_arrser
   } else {
      lassign [readCollectionContent $collfile $colldesc] coll_path_list\
         coll_mod_list coll_tag_arrser
   }

   # build list of module tagged auto-loaded in collection
   array set coll_tag_arr $coll_tag_arrser
   set coll_nuasked_list {}
   foreach mod [array names coll_tag_arr] {
      if {{auto-loaded} in $coll_tag_arr($mod)} {
         lappend coll_nuasked_list $mod
      }
   }

   # collection should at least define a path or a mod, but initial env may be
   # totally empty
   if {$collfile ne {__init__} && ![llength $coll_path_list] && ![llength\
      $coll_mod_list]} {
      reportErrorAndExit "$colldesc is not a valid collection"
   }

   # load tags from loaded modules
   cacheCurrentModules

   defineModEqProc [isIcase] [getConf extended_default]

   # fetch what is currently loaded
   set curr_path_list [getModulePathList returnempty 0]
   # get current loaded module list
   set curr_mod_list [getEnvLoadedModulePropertyParsedList name]
   set curr_nuasked_list [getTaggedLoadedModuleList auto-loaded]
   # get current save tags of loaded modules
   array set curr_tag_arr [getLoadedModuleWithVariantSaveTagArrayList]

   # determine what module to unload to restore collection from current
   # situation with preservation of the load order (asking for a modeq
   # comparison will help to check against simplified mod name and variants)
   lassign [getMovementBetweenList $curr_mod_list $coll_mod_list\
      $curr_nuasked_list $coll_nuasked_list modeq] mod_to_unload mod_to_load

   # proceed as well for modulepath
   lassign [getMovementBetweenList $curr_path_list $coll_path_list] \
      path_to_unuse path_to_use

   # indicate if loaded modules that matches modules in collection have
   # different tags set
   if {![llength $mod_to_load]} {
      # consider a not-set entry as an empty element when comparing collection
      # and current environment tags. compare tags as unordered lists
      lassign [getDiffBetweenArray curr_tag_arr coll_tag_arr 1 1] notincoll\
         diff notincurr
      set is_tags_diff [llength $diff]
   # if some module from collection are not yet loaded, consider there is a
   # difference
   } else {
      set is_tags_diff 1
   }

   return [list $coll_path_list $coll_mod_list $coll_tag_arrser\
      $coll_nuasked_list $mod_to_unload $mod_to_load $path_to_unuse\
      $path_to_use $is_tags_diff]
}

proc getCollectionFromStash {stash} {
   if {[string match stash-* $stash]} {
      set coll $stash
   } elseif {[string is integer -strict $stash]} {
      # filter collection from other target (especially if no target set)
      set collfile [lindex [lsort -decreasing [findCollections stash-* glob\
         0 0 1 1]] $stash]
      if {$collfile eq {}} {
         knerror "Invalid stash index '$stash'"
      }
      # extract collection name (without path and target extension)
      set coll [file rootname [file tail $collfile]]
   } else {
      knerror "Invalid stash collection name '$stash'"
   }

   return $coll
}

# ;;; Local Variables: ***
# ;;; mode:tcl ***
# ;;; End: ***
# vim:set tabstop=3 shiftwidth=3 expandtab autoindent: