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' ) [ docker-file? ] filter ;
 174 : uses-docker? ( paths -- ? ) [ docker-file? ] any? ;
 175
 176 : automake-file? ( path -- ? )
 177     >lower file-name
 178     {
 179         [ "makefile.am" tail? ]
 180         [ "makefile.am.inc" tail? ]
 181     } 1|| ;
 182 : automake-files ( paths -- paths' ) [ automake-file? ] filter ;
 183 : uses-automake? ( paths -- ? ) [ automake-file? ] any? ;
 184
 185 : make-file? ( path -- ? )
 186     >lower file-name { "gnumakefile" "makefile" } member? ;
 187 : make-files ( paths -- paths' ) [ make-file? ] filter ;
 188 : uses-make? ( paths -- ? ) [ make-file? ] any? ;
 189
 190 : nmake-file? ( path -- ? ) >lower file-name "nmakefile" = ;
 191 : nmake-files ( paths -- paths' ) [ nmake-file? ] filter ;
 192 : uses-nmake? ( paths -- ? ) [ nmake-file? ] any? ;
 193
 194 : gradle-file? ( path -- ? ) >lower { [ "gradle" head? ] [ ".gradle" tail? ] } 1|| ;
 195 : gradle-files ( paths -- paths' ) [ gradle-file? ] filter ;
 196 : uses-gradle? ( paths -- ? ) [ gradle-file? ] any? ;
 197
 198 : github-file? ( path -- ? ) >lower ".github" swap subseq? ;
 199 : github-files ( paths -- paths' ) [ github-file? ] filter ;
 200 : has-github-files? ( paths -- ? ) [ github-file? ] any? ;
 201
 202 : cargo-file? ( path -- ? ) file-name { "Cargo.toml" "Cargo.lock" } member? ;
 203 : cargo-files ( paths -- paths' ) [ cargo-file? ] filter ;
 204 : has-cargo-files? ( paths -- ? ) [ cargo-file? ] any? ;
 205
 206 : julia-project-file? ( path -- ? ) file-name { "Project.toml" } member? ;
 207 : julia-project-files ( paths -- paths' ) [ julia-project-file? ] filter ;
 208 : has-julia-project-files? ( paths -- ? ) [ julia-project-file? ] any? ;
 209
 210 : rust-project-dir? ( path -- ? ) file-name "Cargo.toml" = ;
 211
 212 : rust-source-file? ( path -- ? )
 213     {
 214         [ ".rs" tail? ]
 215     } 1|| ;
 216
 217 : rust-source-files ( path -- paths ) [ rust-source-file? ] filter ;
 218
 219 : rust-build-system-files ( path -- ? )
 220     {
 221         [ "Carg.toml" tail? ]
 222         [ "Carg.lock" tail? ]
 223     } 1|| ;
 224
 225 : rust-intermediate-build-files ( path -- ? )
 226     {
 227         [ ".rlib" tail? ]
 228         [ ".rmeta" tail? ]
 229         [ ".o" tail? ]
 230     } 1|| ;
 231
 232 : rust-output-files ( path -- ? )
 233     {
 234         [ ".dll" tail? ]
 235         [ ".dylib" tail? ]
 236         [ ".a" tail? ]
 237         [ ".so" tail? ]
 238     } 1|| ;
 239
 240 : print-rust-package ( assoc -- )
 241     {
 242         [ "name" of [ "  name: %s" sprintf print ] when* ]
 243         [ "version" of [ "  version: %s" sprintf print ] when* ]
 244         [ "license" of [ "  license: %s" sprintf print ] when* ]
 245         [ "edition" of [ "  rust edition: %s" sprintf print ] when* ]
 246     } cleave ;
 247
 248 : analyze-rust-cargo-toml ( assoc -- )
 249     [ print-rust-package ] keep
 250     [ "workspace" of "members" of length [ "  %d member projects" sprintf print ] unless-zero ]
 251     [
 252         [ [ "package" of ] [ "workspace" of "package" of ] bi assoc-union ] keep
 253         "workspace" of "members" of [
 254             "package: " write print print-rust-package
 255         ] with each
 256     ] bi ;
 257
 258 : analyze-rust-project ( path -- )
 259     [ "Analyzing rust project at %s" sprintf print ]
 260     [ path>toml analyze-rust-cargo-toml ]
 261     [ containing-directory recursive-directory-files ] tri
 262     {
 263         [ rust-source-files length "  %d rust source files" sprintf print ]
 264     } cleave ;
 265
 266 : web-file? ( path -- ? )
 267     >lower file-extension
 268     {
 269         "css" "scss" "js" "jsx" "ejs" "mjs" "ts" "tsx" "json" "html"
 270         "less" "mustache" "snap" "wasm"
 271     } member? ;
 272 : web-files ( paths -- paths' ) [ web-file? ] filter ;
 273
 274 : rc-file? ( path -- ? ) >lower file-name { [ "." head? ] [ "rc" tail? ] } 1&& ;
 275 : rc-files ( paths -- paths' ) [ rc-file? ] filter ;
 276
 277 : env-file? ( path -- ? ) >lower ".env" tail? ;
 278 : env-files ( paths -- paths' ) [ env-file? ] filter ;
 279
 280 : image-file? ( path -- ? ) >lower file-extension { "png" "jpg" "jpeg" "ico" } member? ;
 281 : image-files ( paths -- paths' ) [ image-file? ] filter ;
 282
 283 : ignore-file? ( path -- ? ) >lower file-name { [ "." head? ] [ "ignore" tail? ] } 1&& ;
 284 : ignore-files ( paths -- paths' ) [ ignore-file? ] filter ;
 285
 286 : has-package-json? ( path -- ? ) "package.json" append-path file-exists? ;
 287 : uses-git? ( path -- ? ) ".git" append-path file-exists? ;
 288
 289 : diff-paths ( paths quot -- paths' )
 290     keep swap [ [ normalize-path ] map ] bi@ diff ; inline
 291
 292 : assoc. ( assoc -- )
 293     [ commas ] map-values simple-table. ;
 294
 295 : analyze-codebase-path ( path -- )
 296     {
 297         [ normalize-path "project at path `%s`" sprintf print nl ]
 298         [ uses-git? [ "uses git" print ] when ]
 299         [ has-package-json? [ "has a package.json file" print ] when ]
 300     } cleave ;
 301
 302 : analyze-codebase-paths ( paths -- )
 303     {
 304         [
 305             partition-binary
 306             [ length "%d binary files" sprintf print ]
 307             [ length "%d text files" sprintf print ] bi*
 308         ]
 309         [ github-files [ sort "has .github files" print ... ] unless-empty ]
 310         [ license-files [ sort [ length "has %d license files" sprintf print ] [ ... ] bi ] unless-empty ]
 311         [ readme-files [ sort "has readme files" print ... ] unless-empty ]
 312         [ owners-files [ sort "has owners files" print ... ] unless-empty ]
 313         [ codenotify-files [ sort "has codenotify files" print ... ] unless-empty ]
 314         [ contributing-files [ sort "has contributing files" print ... ] unless-empty ]
 315         [ changelog-files [ sort "has changelog files" print ... ] unless-empty ]
 316         [ security-files [ sort "has security files" print ... ] unless-empty ]
 317         [ notice-files [ sort "has notice files" print ... ] unless-empty ]
 318         [ version-files [ sort "has version files" print ... ] unless-empty ]
 319         [
 320             { [ dot-files ] [ rc-files diff ] [ ignore-files diff ] } cleave
 321             [ sort "has dot files" print ... ] unless-empty
 322         ]
 323         [ rc-files [ sort [ length "has %d rc files" sprintf print ] [ ... ] bi ] unless-empty ]
 324         [ configure-files [ sort "uses configure files" print ... ] unless-empty ]
 325         [ automake-files [ sort "uses automake" print ... ] unless-empty ]
 326         [ make-files [ sort "uses make" print ... ] unless-empty ]
 327         [ nmake-files [ sort "uses nmake" print ... ] unless-empty ]
 328         [ cmake-files [ sort "uses cmake" print ... ] unless-empty ]
 329         [ gradle-files [ sort "uses gradle" print ... ] unless-empty ]
 330         [ cargo-files [ sort "uses rust/cargo" print ... ] unless-empty ]
 331         [ julia-project-files [ sort "uses julia Project.toml" print ... ] unless-empty ]
 332         [ in-files [ sort "uses 'in' files" print ... ] unless-empty ]
 333         [ ignore-files [ sort [ length "has %d ignore files" sprintf print ] [ ... ] bi ] unless-empty nl ]
 334         [ [ rust-project-dir? ] filter [ [ "rust projects at " print . ] [ [ analyze-rust-project ] each ] bi ] unless-empty nl ]
 335         [
 336             [ upper-files ] keep
 337             {
 338                 [ github-files diff ]
 339                 [ license-files diff ]
 340                 [ readme-files diff ]
 341                 [ owners-files diff ]
 342                 [ codenotify-files diff ]
 343                 [ contributing-files diff ]
 344                 [ changelog-files diff ]
 345                 [ security-files diff ]
 346                 [ notice-files diff ]
 347                 [ version-files diff ]
 348             } cleave
 349             [ sort [ length "has %d UPPER files (minus github,license,readme,owner,codenotify,contributing,changelog,security,notice,version)" sprintf print ] [ ... ] bi ] unless-empty nl
 350         ]
 351         [ "Top 20 largest files" print file-sizes sort-values 20 index-or-length tail* [ normalize-path ] map-keys reverse assoc. nl ]
 352         [ "Top 10 file extension sizes" print sum-sizes-by-extension 10 index-or-length tail* reverse assoc. nl ]
 353         [ "Top 10 text file line counts" print sum-line-counts-by-extension 10 index-or-length tail* reverse assoc. nl ]
 354         [ "Top 10 file extension counts" print count-by-file-extension 10 index-or-length tail* reverse assoc. nl ]
 355     } cleave ;
 356
 357 : analyze-codebase ( path -- )
 358     [ analyze-codebase-path ]
 359     [ codebase-paths analyze-codebase-paths ] bi ;
 360
 361 : analyze-codebases ( path -- )
 362     [ directory-files ] keep [ prepend-path ] curry map
 363     [ file-info directory? ] filter
 364     [ analyze-codebase ] each ;