Add a `--show-model` option to `build`

3 files changed, 183 insertions, 9 deletions

diff --git a/fpm/src/fpm.f90 b/fpm/src/fpm.f90
index d91b1d4..3a1c27c 100644
--- a/fpm/src/fpm.f90
+++ b/fpm/src/fpm.f90
@@ -9,7 +9,7 @@ use fpm_filesystem, only: is_dir, join_path, number_of_rows, list_files, exists,
 use fpm_model, only: fpm_model_t, srcfile_t, build_target_t, &
                     FPM_SCOPE_UNKNOWN, FPM_SCOPE_LIB, FPM_SCOPE_DEP, &
                     FPM_SCOPE_APP, FPM_SCOPE_EXAMPLE, FPM_SCOPE_TEST, &
-                    FPM_TARGET_EXECUTABLE, FPM_TARGET_ARCHIVE
+                    FPM_TARGET_EXECUTABLE, FPM_TARGET_ARCHIVE, show_model
 use fpm_compiler, only: add_compile_flag_defaults
 
 
@@ -199,6 +199,8 @@ if(settings%list)then
     do i=1,size(model%targets)
         write(stderr,*) model%targets(i)%ptr%output_file
     enddo
+else if (settings%show_model) then
+    call show_model(model)
 else
     call build_package(model)
 endif
diff --git a/fpm/src/fpm_command_line.f90 b/fpm/src/fpm_command_line.f90
index a733fc2..f7cd38f 100644
--- a/fpm/src/fpm_command_line.f90
+++ b/fpm/src/fpm_command_line.f90
@@ -59,6 +59,7 @@ end type
 
 type, extends(fpm_cmd_settings)  :: fpm_build_settings
     logical                      :: list=.false.
+    logical                      :: show_model=.false.
     character(len=:),allocatable :: compiler
     character(len=:),allocatable :: build_name
 end type
@@ -184,6 +185,7 @@ contains
             call set_args( '&
             & --release F &
             & --list F &
+            & --show-model F &
             & --compiler "'//get_env('FPM_COMPILER','gfortran')//'" &
             & --verbose F&
             & --',help_build,version_text)
@@ -195,6 +197,7 @@ contains
             & build_name=val_build,&
             & compiler=val_compiler, &
             & list=lget('list'),&
+            & show_model=lget('show-model'),&
             & verbose=lget('verbose') )
 
         case('new')
@@ -737,14 +740,15 @@ contains
     ' specified in the "fpm.toml" file.                                     ', &
     '                                                                       ', &
     'OPTIONS                                                                ', &
-    ' --release  build in build/*_release instead of build/*_debug with     ', &
-    '            high optimization instead of full debug options.           ', &
-    ' --compiler COMPILER_NAME  Specify a compiler name. The default is     ', &
+    ' --release    build in build/*_release instead of build/*_debug with   ', &
+    '              high optimization instead of full debug options.         ', &
+    ' --compiler   COMPILER_NAME  Specify a compiler name. The default is   ', &
     '                           "gfortran" unless set by the environment    ', &
     '                           variable FPM_COMPILER.                      ', &
-    ' --list     list candidates instead of building or running them        ', &
-    ' --help     print this help and exit                                   ', &
-    ' --version  print program version information and exit                 ', &
+    ' --list       list candidates instead of building or running them      ', &
+    ' --show-model show the model and exit (do not build)                   ', &
+    ' --help       print this help and exit                                 ', &
+    ' --version    print program version information and exit               ', &
     '                                                                       ', &
     'EXAMPLES                                                               ', &
     ' Sample commands:                                                      ', &
diff --git a/fpm/src/fpm_model.f90 b/fpm/src/fpm_model.f90
index b7d97db..72c0b04 100644
--- a/fpm/src/fpm_model.f90
+++ b/fpm/src/fpm_model.f90
@@ -26,12 +26,13 @@
 !>
 module fpm_model
 use iso_fortran_env, only: int64
-use fpm_strings, only: string_t
+use fpm_strings, only: string_t, str
 use fpm_dependency, only: dependency_tree_t
 implicit none
 
 private
-public :: fpm_model_t, srcfile_t, build_target_t, build_target_ptr
+public :: fpm_model_t, srcfile_t, build_target_t, build_target_ptr, &
+    show_model
 
 public :: FPM_UNIT_UNKNOWN, FPM_UNIT_PROGRAM, FPM_UNIT_MODULE, &
           FPM_UNIT_SUBMODULE, FPM_UNIT_SUBPROGRAM, FPM_UNIT_CSOURCE, &
@@ -194,4 +195,171 @@ type :: fpm_model_t
 
 end type fpm_model_t
 
+contains
+
+recursive function info_build_target(t) result(s)
+type(build_target_t), intent(in) :: t
+character(:), allocatable :: s
+integer :: i
+!type build_target_t
+s = "build_target_t("
+!    character(:), allocatable :: output_file
+s = s // 'output_file="' // t%output_file // '"'
+!    type(srcfile_t), allocatable :: source
+if (allocated(t%source)) then
+    s = s // ", source=" // info_srcfile(t%source)
+else
+    s = s // ", source=()"
+end if
+!    type(build_target_ptr), allocatable :: dependencies(:)
+s = s // ", dependencies=["
+if (allocated(t%dependencies)) then
+    do i = 1, size(t%dependencies)
+        ! TODO: This compiles, but it hangs at runtime due to infinite
+        !       recursion, so for now we just print "..."
+        !s = s // info_build_target(t%dependencies(i)%ptr)
+        s = s // "build_target_t(...)"
+        if (i < size(t%dependencies)) s = s // ", "
+    end do
+end if
+s = s // "]"
+!    integer :: target_type = FPM_TARGET_UNKNOWN
+s = s // ", target_type=" // str(t%target_type)
+!    type(string_t), allocatable :: link_libraries(:)
+s = s // ", link_libraries=["
+if (allocated(t%link_libraries)) then
+    do i = 1, size(t%link_libraries)
+        s = s // '"' // t%link_libraries(i)%s // '"'
+        if (i < size(t%link_libraries)) s = s // ", "
+    end do
+end if
+s = s // "]"
+!    type(string_t), allocatable :: link_objects(:)
+s = s // ", link_objects=["
+if (allocated(t%link_objects)) then
+    do i = 1, size(t%link_objects)
+        s = s // '"' // t%link_objects(i)%s // '"'
+        if (i < size(t%link_objects)) s = s // ", "
+    end do
+end if
+s = s // "]"
+!    logical :: touched = .false.
+s = s // ", touched=" // str(t%touched)
+!    logical :: sorted = .false.
+s = s // ", sorted=" // str(t%sorted)
+!    logical :: skip = .false.
+s = s // ", skip=" // str(t%skip)
+!    integer :: schedule = -1
+s = s // ", schedule=" // str(t%schedule)
+!    integer(int64), allocatable :: digest_cached
+if (allocated(t%digest_cached)) then
+    s = s // ", digest_cached=" // str(t%digest_cached)
+else
+    s = s // ", digest_cached=()"
+end if
+!end type build_target_t
+s = s // ")"
+end function
+
+function info_srcfile(source) result(s)
+type(srcfile_t), intent(in) :: source
+character(:), allocatable :: s
+integer :: i
+!type srcfile_t
+s = "srcfile_t("
+!    character(:), allocatable :: file_name
+s = s // 'file_name="' // source%file_name // '"'
+!    character(:), allocatable :: exe_name
+s = s // ', exe_name="' // source%exe_name // '"'
+!    integer :: unit_scope = FPM_SCOPE_UNKNOWN
+s = s // ", unit_scope=" // str(source%unit_scope)
+!    type(string_t), allocatable :: modules_provided(:)
+s = s // ", modules_provided=["
+do i = 1, size(source%modules_provided)
+    s = s // '"' // source%modules_provided(i)%s // '"'
+    if (i < size(source%modules_provided)) s = s // ", "
+end do
+s = s // "]"
+!    integer :: unit_type = FPM_UNIT_UNKNOWN
+s = s // ", unit_type=" // str(source%unit_type)
+!    type(string_t), allocatable :: modules_used(:)
+s = s // ", modules_used=["
+do i = 1, size(source%modules_used)
+    s = s // '"' // source%modules_used(i)%s // '"'
+    if (i < size(source%modules_used)) s = s // ", "
+end do
+s = s // "]"
+!    type(string_t), allocatable :: include_dependencies(:)
+s = s // ", include_dependencies=["
+do i = 1, size(source%include_dependencies)
+    s = s // '"' // source%include_dependencies(i)%s // '"'
+    if (i < size(source%include_dependencies)) s = s // ", "
+end do
+s = s // "]"
+!    type(string_t), allocatable :: link_libraries(:)
+s = s // ", link_libraries=["
+do i = 1, size(source%link_libraries)
+    s = s // '"' // source%link_libraries(i)%s // '"'
+    if (i < size(source%link_libraries)) s = s // ", "
+end do
+s = s // "]"
+!    integer(int64) :: digest
+s = s // ", digest=" // str(source%digest)
+!end type srcfile_t
+s = s // ")"
+end function
+
+function info_model(model) result(s)
+type(fpm_model_t), intent(in) :: model
+character(:), allocatable :: s
+integer :: i
+!type :: fpm_model_t
+s = "fpm_model_t("
+!    character(:), allocatable :: package_name
+s = s // 'package_name="' // model%package_name // '"'
+!    type(srcfile_t), allocatable :: sources(:)
+s = s // ", sources=["
+do i = 1, size(model%sources)
+    s = s // info_srcfile(model%sources(i))
+    if (i < size(model%sources)) s = s // ", "
+end do
+s = s // "]"
+!    type(build_target_ptr), allocatable :: targets(:)
+s = s // ", targets=["
+do i = 1, size(model%targets)
+    s = s // info_build_target(model%targets(i)%ptr)
+    if (i < size(model%targets)) s = s // ", "
+end do
+s = s // "]"
+!    character(:), allocatable :: fortran_compiler
+s = s // ', fortran_compiler="' // model%fortran_compiler // '"'
+!    character(:), allocatable :: fortran_compile_flags
+s = s // ', fortran_compile_flags="' // model%fortran_compile_flags // '"'
+!    character(:), allocatable :: link_flags
+s = s // ', link_flags="' // model%link_flags // '"'
+!    character(:), allocatable :: library_file
+s = s // ', library_file="' // model%library_file // '"'
+!    character(:), allocatable :: output_directory
+s = s // ', output_directory="' // model%output_directory // '"'
+!    type(string_t), allocatable :: link_libraries(:)
+s = s // ", link_libraries=["
+do i = 1, size(model%link_libraries)
+    s = s // '"' // model%link_libraries(i)%s // '"'
+    if (i < size(model%link_libraries)) s = s // ", "
+end do
+s = s // "]"
+!    type(dependency_tree_t) :: deps
+! TODO: print `dependency_tree_t` properly, which should become part of the
+!       model, not imported from another file
+s = s // ", deps=dependency_tree_t(...)"
+!end type fpm_model_t
+s = s // ")"
+end function
+
+subroutine show_model(model)
+! Prints a human readable representation of the Model
+type(fpm_model_t), intent(in) :: model
+print *, info_model(model)
+end subroutine
+
 end module fpm_model