dependency_tree_t Derived Type

type, public :: dependency_tree_t

Respresentation of a projects dependencies

The dependencies are stored in a simple array for now, this can be replaced with a binary-search tree or a hash table in the future.


Contents

Source Code


Components

Type Visibility Attributes Name Initial
character(len=:), public, allocatable :: cache

Cache file

type(dependency_node_t), public, allocatable :: dep(:)

Flattend list of all dependencies

character(len=:), public, allocatable :: dep_dir

Installation prefix for dependencies

integer, public :: ndep = 0

Number of currently registered dependencies

integer, public :: unit = output_unit

Unit for IO

integer, public :: verbosity = 1

Verbosity of printout


Type-Bound Procedures

generic, public, :: add => add_project, add_project_dependencies, add_dependencies, add_dependency, add_dependency_node

Overload procedure to add new dependencies to the tree

  • private subroutine add_project(self, package, error)

    Add project dependencies, each depth level after each other.

    We implement this algorithm in an interative rather than a recursive fashion as a choice of design.

    Arguments

    Type IntentOptional Attributes Name
    class(dependency_tree_t), intent(inout) :: self

    Instance of the dependency tree

    type(package_config_t), intent(in) :: package

    Project configuration to add

    type(error_t), intent(out), allocatable :: error

    Error handling

  • private recursive subroutine add_project_dependencies(self, package, root, main, error)

    Add a project and its dependencies to the dependency tree

    Arguments

    Type IntentOptional Attributes Name
    class(dependency_tree_t), intent(inout) :: self

    Instance of the dependency tree

    type(package_config_t), intent(in) :: package

    Project configuration to add

    character(len=*), intent(in) :: root

    Current project root directory

    logical, intent(in) :: main

    Is the main project

    type(error_t), intent(out), allocatable :: error

    Error handling

  • private subroutine add_dependencies(self, dependency, error)

    Add a list of dependencies to the dependency tree

    Arguments

    Type IntentOptional Attributes Name
    class(dependency_tree_t), intent(inout) :: self

    Instance of the dependency tree

    type(dependency_config_t), intent(in) :: dependency(:)

    Dependency configuration to add

    type(error_t), intent(out), allocatable :: error

    Error handling

  • private subroutine add_dependency(self, dependency, error)

    Add a single dependency to the dependency tree

    Arguments

    Type IntentOptional Attributes Name
    class(dependency_tree_t), intent(inout) :: self

    Instance of the dependency tree

    type(dependency_config_t), intent(in) :: dependency

    Dependency configuration to add

    type(error_t), intent(out), allocatable :: error

    Error handling

  • private subroutine add_dependency_node(self, dependency, error)

    Add a single dependency node to the dependency tree Dependency nodes contain additional information (version, git, revision)

    Arguments

    Type IntentOptional Attributes Name
    class(dependency_tree_t), intent(inout) :: self

    Instance of the dependency tree

    type(dependency_node_t), intent(in) :: dependency

    Dependency configuration to add

    type(error_t), intent(out), allocatable :: error

    Error handling

generic, public, :: dump => dump_to_file, dump_to_unit, dump_to_toml

Writing of dependency tree

  • private subroutine dump_to_file(self, file, error)

    Write dependency tree to file

    Arguments

    Type IntentOptional Attributes Name
    class(dependency_tree_t), intent(inout) :: self

    Instance of the dependency tree

    character(len=*), intent(in) :: file

    File name

    type(error_t), intent(out), allocatable :: error

    Error handling

  • private subroutine dump_to_unit(self, unit, error)

    Write dependency tree to file

    Arguments

    Type IntentOptional Attributes Name
    class(dependency_tree_t), intent(inout) :: self

    Instance of the dependency tree

    integer, intent(in) :: unit

    Formatted unit

    type(error_t), intent(out), allocatable :: error

    Error handling

  • private subroutine dump_to_toml(self, table, error)

    Write dependency tree to TOML datastructure

    Arguments

    Type IntentOptional Attributes Name
    class(dependency_tree_t), intent(inout) :: self

    Instance of the dependency tree

    type(toml_table), intent(inout) :: table

    Data structure

    type(error_t), intent(out), allocatable :: error

    Error handling

generic, public, :: find => find_name

Find a dependency in the tree

  • private pure function find_name(self, name) result(pos)

    Find a dependency in the dependency tree

    Arguments

    Type IntentOptional Attributes Name
    class(dependency_tree_t), intent(in) :: self

    Instance of the dependency tree

    character(len=*), intent(in) :: name

    Dependency configuration to add

    Return Value integer

    Index of the dependency

procedure, public, :: finished

Depedendncy resolution finished

  • private pure function finished(self)

    Check if we are done with the dependency resolution

    Arguments

    Type IntentOptional Attributes Name
    class(dependency_tree_t), intent(in) :: self

    Instance of the dependency tree

    Return Value logical

    All dependencies are updated

generic, public, :: has => has_dependency

True if entity can be found

  • private pure function has_dependency(self, dependency)

    True if dependency is part of the tree

    Arguments

    Type IntentOptional Attributes Name
    class(dependency_tree_t), intent(in) :: self

    Instance of the dependency tree

    class(dependency_node_t), intent(in) :: dependency

    Dependency configuration to check

    Return Value logical

generic, public, :: load => load_from_file, load_from_unit, load_from_toml

Reading of dependency tree

  • private subroutine load_from_file(self, file, error)

    Read dependency tree from file

    Arguments

    Type IntentOptional Attributes Name
    class(dependency_tree_t), intent(inout) :: self

    Instance of the dependency tree

    character(len=*), intent(in) :: file

    File name

    type(error_t), intent(out), allocatable :: error

    Error handling

  • private subroutine load_from_unit(self, unit, error)

    Read dependency tree from file

    Arguments

    Type IntentOptional Attributes Name
    class(dependency_tree_t), intent(inout) :: self

    Instance of the dependency tree

    integer, intent(in) :: unit

    File name

    type(error_t), intent(out), allocatable :: error

    Error handling

  • private subroutine load_from_toml(self, table, error)

    Read dependency tree from TOML data structure

    Arguments

    Type IntentOptional Attributes Name
    class(dependency_tree_t), intent(inout) :: self

    Instance of the dependency tree

    type(toml_table), intent(inout) :: table

    Data structure

    type(error_t), intent(out), allocatable :: error

    Error handling

generic, public, :: resolve => resolve_dependencies, resolve_dependency

Resolve dependencies

  • private subroutine resolve_dependencies(self, root, error)

    Resolve all dependencies in the tree

    Arguments

    Type IntentOptional Attributes Name
    class(dependency_tree_t), intent(inout) :: self

    Instance of the dependency tree

    character(len=*), intent(in) :: root

    Current installation prefix

    type(error_t), intent(out), allocatable :: error

    Error handling

  • private subroutine resolve_dependency(self, dependency, global_settings, root, error)

    Resolve a single dependency node

    Arguments

    Type IntentOptional Attributes Name
    class(dependency_tree_t), intent(inout) :: self

    Instance of the dependency tree

    type(dependency_node_t), intent(inout) :: dependency

    Dependency configuration to add

    type(fpm_global_settings), intent(in) :: global_settings

    Global configuration settings.

    character(len=*), intent(in) :: root

    Current installation prefix

    type(error_t), intent(out), allocatable :: error

    Error handling

generic, public, :: update => update_dependency, update_tree

Update dependency tree

  • private subroutine update_dependency(self, name, error)

    Update dependency tree

    Arguments

    Type IntentOptional Attributes Name
    class(dependency_tree_t), intent(inout) :: self

    Instance of the dependency tree

    character(len=*), intent(in) :: name

    Name of the dependency to update

    type(error_t), intent(out), allocatable :: error

    Error handling

  • private subroutine update_tree(self, error)

    Update whole dependency tree

    Arguments

    Type IntentOptional Attributes Name
    class(dependency_tree_t), intent(inout) :: self

    Instance of the dependency tree

    type(error_t), intent(out), allocatable :: error

    Error handling

Source Code

  type :: dependency_tree_t
    !> Unit for IO
    integer :: unit = output_unit
    !> Verbosity of printout
    integer :: verbosity = 1
    !> Installation prefix for dependencies
    character(len=:), allocatable :: dep_dir
    !> Number of currently registered dependencies
    integer :: ndep = 0
    !> Flattend list of all dependencies
    type(dependency_node_t), allocatable :: dep(:)
    !> Cache file
    character(len=:), allocatable :: cache

  contains

    !> Overload procedure to add new dependencies to the tree
    generic :: add => add_project, add_project_dependencies, add_dependencies, &
      add_dependency, add_dependency_node
    !> Main entry point to add a project
    procedure, private :: add_project
    !> Add a project and its dependencies to the dependency tree
    procedure, private :: add_project_dependencies
    !> Add a list of dependencies to the dependency tree
    procedure, private :: add_dependencies
    !> Add a single dependency to the dependency tree
    procedure, private :: add_dependency
    !> Add a single dependency node to the dependency tree
    procedure, private :: add_dependency_node
    !> Resolve dependencies
    generic :: resolve => resolve_dependencies, resolve_dependency
    !> Resolve dependencies
    procedure, private :: resolve_dependencies
    !> Resolve dependency
    procedure, private :: resolve_dependency
    !> True if entity can be found
    generic :: has => has_dependency
    !> True if dependency is part of the tree
    procedure, private :: has_dependency
    !> Find a dependency in the tree
    generic :: find => find_name
    !> Find a dependency by its name
    procedure, private :: find_name
    !> Depedendncy resolution finished
    procedure :: finished
    !> Reading of dependency tree
    generic :: load => load_from_file, load_from_unit, load_from_toml
    !> Read dependency tree from file
    procedure, private :: load_from_file
    !> Read dependency tree from formatted unit
    procedure, private :: load_from_unit
    !> Read dependency tree from TOML data structure
    procedure, private :: load_from_toml
    !> Writing of dependency tree
    generic :: dump => dump_to_file, dump_to_unit, dump_to_toml
    !> Write dependency tree to file
    procedure, private :: dump_to_file
    !> Write dependency tree to formatted unit
    procedure, private :: dump_to_unit
    !> Write dependency tree to TOML data structure
    procedure, private :: dump_to_toml
    !> Update dependency tree
    generic :: update => update_dependency, update_tree
    !> Update a list of dependencies
    procedure, private :: update_dependency
    !> Update all dependencies in the tree
    procedure, private :: update_tree
  end type dependency_tree_t