extra/codebase-analyzer/codebase-analyzer.factor

   1 ! Copyright (C) 2022 Doug Coleman.
   2 ! See https://factorcode.org/license.txt for BSD license.
   3 USING: accessors assocs assocs.extras combinators
   4 combinators.short-circuit formatting hashtables io io.backend
   5 io.directories io.encodings.binary io.files io.files.info
   6 io.files.types io.pathnames kernel math math.statistics
   7 prettyprint sequences sets sorting splitting toml
   8 tools.memory.private tools.wc unicode ;
   9 IN: codebase-analyzer
  10
  11 : file-sizes ( paths -- assoc )
  12     [ dup file-info size>> ] { } map>assoc ;
  13
  14 : binary-file? ( path -- ? )
  15     binary [ 1024 read ] with-file-reader [ 0 = ] any? ;
  16
  17 : binary-files ( paths -- ? ) [ binary-file? ] filter ;
  18
  19 : partition-binary ( paths -- binary text )
  20     [ binary-file? ] partition ;
  21
  22 : with-file-extensions ( paths -- paths' )
  23     [ has-file-extension? ] filter ;
  24
  25 : without-git-paths ( paths -- paths' )
  26     [ "/.git/" subseq-of? ] reject ;
  27
  28 : without-node-modules-paths ( paths -- paths' )
  29     [ "/node_modules/" subseq-of? ] reject ;
  30
  31 : regular-directory-files ( path -- seq )
  32     recursive-directory-files
  33     [ link-info type>> +regular-file+ = ] filter ;
  34
  35 : codebase-paths ( path -- seq )
  36     regular-directory-files
  37     without-git-paths
  38     without-node-modules-paths ;
  39
  40 : count-by-file-extension ( paths -- assoc )
  41     with-file-extensions
  42     [ file-extension ] histogram-by
  43     sort-values ;
  44
  45 : collect-extensions-by-line-count ( paths -- assoc )
  46     with-file-extensions
  47     [ wc ] collect-by
  48     sort-values ;
  49
  50 : collect-by-file-extension ( paths -- assoc )
  51     with-file-extensions
  52     [ file-extension ] collect-by ;
  53
  54 : sum-line-counts-by-extension ( paths -- assoc )
  55     [ binary-file? ] reject
  56     collect-by-file-extension
  57     [ [ wc ] map-sum ] assoc-map
  58     sort-values ;
  59
  60 : sum-sizes-by-extension ( paths -- assoc )
  61     collect-by-file-extension
  62     [ [ file-info size>> ] map-sum ] assoc-map
  63     sort-values ;
  64
  65 : upper-file? ( path -- ? )
  66     {
  67         [ { [ file-stem length 4 > ] [ file-extension length 3 <= ] } 1&& ]
  68         [ file-stem upper? ]
  69         [ file-stem [ { [ digit? ] [ "-." member? ] } 1|| ] all? not ]
  70     } 1&& ;
  71 : upper-files ( paths -- seq ) [ upper-file? ] filter ;
  72
  73 : configure-file? ( path -- ? ) file-name >lower { [ "configure" = ] [ "configure." head? ] } 1|| ;
  74 : configure-files ( paths -- paths' ) [ configure-file? ] filter ;
  75
  76 : cmake-file? ( path -- ? ) { [ "CMakeLists.txt" tail? ] [ ".cmake" tail? ] } 1|| ;
  77 : cmake-files ( paths -- paths' ) [ cmake-file? ] filter ;
  78 : uses-cmake? ( paths -- ? ) [ cmake-file? ] any? ;
  79
  80 : in-file? ( paths -- ? ) ".in" tail? ;
  81 : in-files ( paths -- seq ) [ in-file? ] filter ;
  82 : uses-in-files? ( paths -- ? ) [ in-file? ] any? ;
  83
  84 : shell-file? ( path -- ? ) >lower file-extension { "sh" "zsh" } member? ;
  85 : shell-files ( paths -- paths' ) [ shell-file? ] filter ;
  86 : uses-shell? ( paths -- ? ) [ shell-file? ] any? ;
  87
  88 : swift-files ( paths -- paths' ) [ ".swift" tail? ] filter ;
  89
  90 : c-file? ( path -- ? )
  91     >lower file-extension { "c" } member? ;
  92 : c-files ( paths -- paths' ) [ c-file? ] filter ;
  93
  94 : c-header-file? ( path -- ? )
  95     >lower file-extension { "h" } member? ;
  96 : c-header-files ( paths -- paths' ) [ c-header-file? ] filter ;
  97
  98 : cpp-file? ( path -- ? )
  99     >lower file-extension { "cc" "cpp" } member? ;
 100 : cpp-files ( paths -- paths' ) [ cpp-file? ] filter ;
 101
 102 : cpp-header-file? ( path -- ? )
 103     >lower file-extension { "h" "hh" "hpp" } member? ;
 104 : cpp-header-files ( paths -- paths' ) [ cpp-header-file? ] filter ;
 105
 106 : python-file? ( path -- ? )
 107     >lower file-extension {
 108         "py" "py3" "pyc" "pyo" "pyw" "pyx" "pyd"
 109         "pxd" "pxi" "pyd" "pxi" "pyi" "pyz" "pwxz" "pth"
 110     } member? ;
 111 : python-files ( paths -- paths' ) [ python-file? ] filter ;
 112
 113 : markdown-file? ( path -- ? ) { [ ".md" tail? ] [ ".markdown" tail? ] } 1|| ;
 114 : markdown-files ( paths -- paths' ) [ markdown-file? ] filter ;
 115
 116 : dot-file? ( path -- ? ) file-name "." head? ;
 117 : dot-files ( paths -- paths' ) [ dot-file? ] filter ;
 118
 119 : txt-file? ( path -- ? )
 120     {
 121         [ { [ ".txt" tail? ] [ ".TXT" tail? ] } 1|| ]
 122         [ "CMakeLists.txt" tail? not ]
 123     } 1&& ;
 124 : txt-files ( paths -- paths' ) [ txt-file? ] filter ;
 125
 126 : license-file? ( path -- ? )
 127     >lower { [ file-stem "license" = ] [ "license-mit" tail? ] } 1|| ;
 128 : license-files ( paths -- paths' ) [ license-file? ] filter ;
 129
 130 : readme-file? ( path -- ? )
 131     >lower file-stem "readme" = ;
 132 : readme-files ( paths -- paths' ) [ readme-file? ] filter ;
 133
 134 : owners-file? ( path -- ? )
 135     >lower file-stem "owners" = ;
 136 : owners-files ( paths -- paths' ) [ owners-file? ] filter ;
 137
 138 : codenotify-file? ( path -- ? )
 139     >lower file-stem "codenotify" = ;
 140 : codenotify-files ( paths -- paths' ) [ codenotify-file? ] filter ;
 141
 142 : contributing-file? ( path -- ? )
 143     >lower file-stem "contributing" = ;
 144 : contributing-files ( paths -- paths' ) [ contributing-file? ] filter ;
 145
 146 : changelog-file? ( path -- ? )
 147     >lower file-stem "changelog" = ;
 148 : changelog-files ( paths -- paths' ) [ changelog-file? ] filter ;
 149
 150 : security-file? ( path -- ? )
 151     >lower file-stem "security" = ;
 152 : security-files ( paths -- paths' ) [ security-file? ] filter ;
 153
 154 : notice-file? ( path -- ? )
 155     >lower file-stem "notice" = ;
 156 : notice-files ( paths -- paths' ) [ notice-file? ] filter ;
 157
 158 : version-file? ( path -- ? )
 159     >lower file-stem "version" = ;
 160 : version-files ( paths -- paths' ) [ version-file? ] filter ;
 161
 162 : json-file? ( path -- ? )
 163     >lower file-extension
 164     { "json" "jsonc" } member? ;
 165
 166 : json-files ( paths -- paths' ) [ json-file? ] filter ;
 167
 168 : yaml-file? ( path -- ? ) { [ ".yaml" tail? ] [ ".yml" tail? ] } 1|| ;
 169 : yaml-files ( paths -- paths' ) [ yaml-file? ] filter ;
 170 : uses-yaml? ( paths -- ? ) [ yaml-file? ] any? ;
 171
 172 : docker-file? ( path -- ? ) >lower file-name { "dockerfile" ".dockerignore" "docker-compose.yaml" } member? ;
 173 : docker-files ( paths -- paths' )
 174     [ [ docker-file? ] filter ]
 175     [ [ >lower "dockerfile" subseq-of? ] filter ] bi
 176     append members ;
 177 : uses-docker? ( paths -- ? ) [ docker-file? ] any? ;
 178
 179 : automake-file? ( path -- ? )
 180     >lower file-name
 181     {
 182         [ "makefile.am" tail? ]
 183         [ "makefile.am.inc" tail? ]
 184     } 1|| ;
 185 : automake-files ( paths -- paths' ) [ automake-file? ] filter ;
 186 : uses-automake? ( paths -- ? ) [ automake-file? ] any? ;
 187
 188 : make-file? ( path -- ? )
 189     >lower file-name { "gnumakefile" "makefile" } member? ;
 190 : make-files ( paths -- paths' ) [ make-file? ] filter ;
 191 : uses-make? ( paths -- ? ) [ make-file? ] any? ;
 192
 193 : nmake-file? ( path -- ? ) >lower file-name "nmakefile" = ;
 194 : nmake-files ( paths -- paths' ) [ nmake-file? ] filter ;
 195 : uses-nmake? ( paths -- ? ) [ nmake-file? ] any? ;
 196
 197 : gradle-file? ( path -- ? ) >lower { [ "gradle" head? ] [ ".gradle" tail? ] } 1|| ;
 198 : gradle-files ( paths -- paths' ) [ gradle-file? ] filter ;
 199 : uses-gradle? ( paths -- ? ) [ gradle-file? ] any? ;
 200
 201 : github-file? ( path -- ? ) >lower ".github" swap subseq? ;
 202 : github-files ( paths -- paths' ) [ github-file? ] filter ;
 203 : has-github-files? ( paths -- ? ) [ github-file? ] any? ;
 204
 205 : cargo-file? ( path -- ? ) file-name { "Cargo.toml" "Cargo.lock" } member? ;
 206 : cargo-files ( paths -- paths' ) [ cargo-file? ] filter ;
 207 : has-cargo-files? ( paths -- ? ) [ cargo-file? ] any? ;
 208
 209 : julia-project-file? ( path -- ? ) file-name { "Project.toml" } member? ;
 210 : julia-project-files ( paths -- paths' ) [ julia-project-file? ] filter ;
 211 : has-julia-project-files? ( paths -- ? ) [ julia-project-file? ] any? ;
 212
 213 : rust-project-dir? ( path -- ? ) file-name "Cargo.toml" = ;
 214
 215 : rust-source-file? ( path -- ? )
 216     {
 217         [ ".rs" tail? ]
 218     } 1|| ;
 219
 220 : rust-source-files ( path -- paths ) [ rust-source-file? ] filter ;
 221
 222 : rust-build-system-files ( path -- ? )
 223     {
 224         [ "Carg.toml" tail? ]
 225         [ "Carg.lock" tail? ]
 226     } 1|| ;
 227
 228 : rust-intermediate-build-files ( path -- ? )
 229     {
 230         [ ".rlib" tail? ]
 231         [ ".rmeta" tail? ]
 232         [ ".o" tail? ]
 233     } 1|| ;
 234
 235 : rust-output-files ( path -- ? )
 236     {
 237         [ ".dll" tail? ]
 238         [ ".dylib" tail? ]
 239         [ ".a" tail? ]
 240         [ ".so" tail? ]
 241     } 1|| ;
 242
 243 : print-rust-package ( assoc -- )
 244     {
 245         [ "name" of [ "  name: %s" sprintf print ] when* ]
 246         [ "version" of [ "  version: %s" sprintf print ] when* ]
 247         [ "license" of [ "  license: %s" sprintf print ] when* ]
 248         [ "edition" of [ "  rust edition: %s" sprintf print ] when* ]
 249     } cleave ;
 250
 251 : analyze-rust-cargo-toml ( assoc -- )
 252     [ print-rust-package ] keep
 253     [ "workspace" of "members" of length [ "  %d member projects" sprintf print ] unless-zero ]
 254     [
 255         [ [ "package" of ] [ "workspace" of "package" of ] bi assoc-union ] keep
 256         "workspace" of "members" of [
 257             "package: " write print print-rust-package
 258         ] with each
 259     ] bi ;
 260
 261 : analyze-rust-project ( path -- )
 262     [ "Analyzing rust project at %s" sprintf print ]
 263     [ path>toml analyze-rust-cargo-toml ]
 264     [ containing-directory recursive-directory-files ] tri
 265     {
 266         [ rust-source-files length "  %d rust source files" sprintf print ]
 267     } cleave ;
 268
 269 : web-file? ( path -- ? )
 270     >lower file-extension
 271     {
 272         "css" "scss" "js" "jsx" "ejs" "mjs" "ts" "tsx" "json" "html"
 273         "less" "mustache" "snap" "wasm"
 274     } member? ;
 275 : web-files ( paths -- paths' ) [ web-file? ] filter ;
 276
 277 : rc-file? ( path -- ? ) >lower file-name { [ "." head? ] [ "rc" tail? ] } 1&& ;
 278 : rc-files ( paths -- paths' ) [ rc-file? ] filter ;
 279
 280 : env-file? ( path -- ? ) >lower ".env" tail? ;
 281 : env-files ( paths -- paths' ) [ env-file? ] filter ;
 282
 283 : image-file? ( path -- ? ) >lower file-extension { "png" "jpg" "jpeg" "ico" } member? ;
 284 : image-files ( paths -- paths' ) [ image-file? ] filter ;
 285
 286 : ignore-file? ( path -- ? ) >lower file-name { [ "." head? ] [ "ignore" tail? ] } 1&& ;
 287 : ignore-files ( paths -- paths' ) [ ignore-file? ] filter ;
 288
 289 : has-package-json? ( path -- ? ) "package.json" append-path file-exists? ;
 290 : uses-git? ( path -- ? ) ".git" append-path file-exists? ;
 291
 292 : diff-paths ( paths quot -- paths' )
 293     keep swap [ [ normalize-path ] map ] bi@ diff ; inline
 294
 295 : assoc. ( assoc -- )
 296     [ commas ] map-values simple-table. ;
 297
 298 : analyze-codebase-path ( path -- )
 299     {
 300         [ normalize-path "project at path `%s`" sprintf print ]
 301         [ uses-git? [ "uses git" print ] when ]
 302         [ has-package-json? [ "has a package.json file" print ] when ]
 303     } cleave ;
 304
 305 : file. ( path -- ) >pathname ... ;
 306 : files. ( paths -- ) [ file. ] each ;
 307
 308 : analyze-codebase-paths ( paths -- )
 309     {
 310         [
 311             partition-binary
 312             [ length "%d binary files" sprintf print ]
 313             [ length "%d text files" sprintf print ] bi*
 314         ]
 315         [ github-files [ sort "has .github files" print files. ] unless-empty ]
 316         [ license-files [ sort [ length "has %d license files" sprintf print ] [ files. ] bi ] unless-empty ]
 317         [ readme-files [ sort "has readme files" print files. ] unless-empty ]
 318         [ owners-files [ sort "has owners files" print files. ] unless-empty ]
 319         [ codenotify-files [ sort "has codenotify files" print files. ] unless-empty ]
 320         [ contributing-files [ sort "has contributing files" print files. ] unless-empty ]
 321         [ changelog-files [ sort "has changelog files" print files. ] unless-empty ]
 322         [ security-files [ sort "has security files" print files. ] unless-empty ]
 323         [ notice-files [ sort "has notice files" print files. ] unless-empty ]
 324         [ version-files [ sort "has version files" print files. ] unless-empty ]
 325         [
 326             { [ dot-files ] [ rc-files diff ] [ ignore-files diff ] } cleave
 327             [ sort "has dot files" print files. ] unless-empty
 328         ]
 329         [ rc-files [ sort [ length "has %d rc files" sprintf print ] [ files. ] bi ] unless-empty ]
 330         [ configure-files [ sort "uses configure files" print files. ] unless-empty ]
 331         [ automake-files [ sort "uses automake" print files. ] unless-empty ]
 332         [ make-files [ sort "uses make" print files. ] unless-empty ]
 333         [ nmake-files [ sort "uses nmake" print files. ] unless-empty ]
 334         [ cmake-files [ sort "uses cmake" print files. ] unless-empty ]
 335         [ docker-files [ sort "uses docker" print files. ] unless-empty ]
 336         [ gradle-files [ sort "uses gradle" print files. ] unless-empty ]
 337         [ cargo-files [ sort "uses rust/cargo" print files. ] unless-empty ]
 338         [ julia-project-files [ sort "uses julia Project.toml" print files. ] unless-empty ]
 339         [ in-files [ sort "uses 'in' files" print files. ] unless-empty ]
 340         [ ignore-files [ sort [ length "has %d ignore files" sprintf print ] [ files. ] bi ] unless-empty ]
 341         [ [ rust-project-dir? ] filter [ [ "rust projects at " print file. ] [ [ analyze-rust-project ] each ] bi ] unless-empty ]
 342         [
 343             [ upper-files ] keep
 344             {
 345                 [ github-files diff ]
 346                 [ license-files diff ]
 347                 [ readme-files diff ]
 348                 [ owners-files diff ]
 349                 [ codenotify-files diff ]
 350                 [ contributing-files diff ]
 351                 [ changelog-files diff ]
 352                 [ security-files diff ]
 353                 [ notice-files diff ]
 354                 [ version-files diff ]
 355             } cleave
 356             [ sort [ length "has %d UPPER files (minus github,license,readme,owner,codenotify,contributing,changelog,security,notice,version)" sprintf print ] [ files. ] bi ] unless-empty
 357         ]
 358         [ "Top 20 largest files" print file-sizes sort-values 20 index-or-length tail* [ normalize-path ] map-keys reverse assoc. ]
 359         [ "Top 10 file extension sizes" print sum-sizes-by-extension 10 index-or-length tail* reverse assoc. ]
 360         [ "Top 10 text file line counts" print sum-line-counts-by-extension 10 index-or-length tail* reverse assoc. ]
 361         [ "Top 10 file extension counts" print count-by-file-extension 10 index-or-length tail* reverse assoc. ]
 362     } cleave ;
 363
 364 : analyze-codebase ( path -- )
 365     [ analyze-codebase-path ]
 366     [ codebase-paths analyze-codebase-paths ] bi ;
 367
 368 : analyze-codebases ( path -- )
 369     [ directory-files ] keep [ prepend-path ] curry map
 370     [ file-info directory? ] filter
 371     [ analyze-codebase ] each ;