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 { "h" "c" } member? ;
  92 : c-files ( paths -- paths' ) [ c-file? ] filter ;
  93
  94 : cpp-file? ( path -- ? )
  95     >lower file-extension { "h" "hh" "hpp" "cc" "cpp" } member? ;
  96 : cpp-files ( paths -- paths' ) [ cpp-file? ] filter ;
  97
  98 : python-file? ( path -- ? )
  99     >lower file-extension {
 100         "py" "py3" "pyc" "pyo" "pyw" "pyx" "pyd"
 101         "pxd" "pxi" "pyd" "pxi" "pyi" "pyz" "pwxz" "pth"
 102     } member? ;
 103 : python-files ( paths -- paths' ) [ python-file? ] filter ;
 104
 105 : markdown-file? ( path -- ? ) { [ ".md" tail? ] [ ".markdown" tail? ] } 1|| ;
 106 : markdown-files ( paths -- paths' ) [ markdown-file? ] filter ;
 107
 108 : dot-file? ( path -- ? ) file-name "." head? ;
 109 : dot-files ( paths -- paths' ) [ dot-file? ] filter ;
 110
 111 : txt-file? ( path -- ? )
 112     {
 113         [ { [ ".txt" tail? ] [ ".TXT" tail? ] } 1|| ]
 114         [ "CMakeLists.txt" tail? not ]
 115     } 1&& ;
 116 : txt-files ( paths -- paths' ) [ txt-file? ] filter ;
 117
 118 : license-file? ( path -- ? )
 119     >lower { [ file-stem "license" = ] [ "license-mit" tail? ] } 1|| ;
 120 : license-files ( paths -- paths' ) [ license-file? ] filter ;
 121
 122 : readme-file? ( path -- ? )
 123     >lower file-stem "readme" = ;
 124 : readme-files ( paths -- paths' ) [ readme-file? ] filter ;
 125
 126 : owners-file? ( path -- ? )
 127     >lower file-stem "owners" = ;
 128 : owners-files ( paths -- paths' ) [ owners-file? ] filter ;
 129
 130 : codenotify-file? ( path -- ? )
 131     >lower file-stem "codenotify" = ;
 132 : codenotify-files ( paths -- paths' ) [ codenotify-file? ] filter ;
 133
 134 : contributing-file? ( path -- ? )
 135     >lower file-stem "contributing" = ;
 136 : contributing-files ( paths -- paths' ) [ contributing-file? ] filter ;
 137
 138 : changelog-file? ( path -- ? )
 139     >lower file-stem "changelog" = ;
 140 : changelog-files ( paths -- paths' ) [ changelog-file? ] filter ;
 141
 142 : security-file? ( path -- ? )
 143     >lower file-stem "security" = ;
 144 : security-files ( paths -- paths' ) [ security-file? ] filter ;
 145
 146 : notice-file? ( path -- ? )
 147     >lower file-stem "notice" = ;
 148 : notice-files ( paths -- paths' ) [ notice-file? ] filter ;
 149
 150 : version-file? ( path -- ? )
 151     >lower file-stem "version" = ;
 152 : version-files ( paths -- paths' ) [ version-file? ] filter ;
 153
 154 : json-file? ( path -- ? )
 155     >lower file-extension
 156     { "json" "jsonc" } member? ;
 157
 158 : json-files ( paths -- paths' ) [ json-file? ] filter ;
 159
 160 : yaml-file? ( path -- ? ) { [ ".yaml" tail? ] [ ".yml" tail? ] } 1|| ;
 161 : yaml-files ( paths -- paths' ) [ yaml-file? ] filter ;
 162 : uses-yaml? ( paths -- ? ) [ yaml-file? ] any? ;
 163
 164 : docker-file? ( path -- ? ) >lower file-name { "dockerfile" ".dockerignore" "docker-compose.yaml" } member? ;
 165 : docker-files ( paths -- paths' ) [ docker-file? ] filter ;
 166 : uses-docker? ( paths -- ? ) [ docker-file? ] any? ;
 167
 168 : automake-file? ( path -- ? )
 169     >lower file-name
 170     {
 171         [ "makefile.am" tail? ]
 172         [ "makefile.am.inc" tail? ]
 173     } 1|| ;
 174 : automake-files ( paths -- paths' ) [ automake-file? ] filter ;
 175 : uses-automake? ( paths -- ? ) [ automake-file? ] any? ;
 176
 177 : make-file? ( path -- ? )
 178     >lower file-name { "gnumakefile" "makefile" } member? ;
 179 : make-files ( paths -- paths' ) [ make-file? ] filter ;
 180 : uses-make? ( paths -- ? ) [ make-file? ] any? ;
 181
 182 : nmake-file? ( path -- ? ) >lower file-name "nmakefile" = ;
 183 : nmake-files ( paths -- paths' ) [ nmake-file? ] filter ;
 184 : uses-nmake? ( paths -- ? ) [ nmake-file? ] any? ;
 185
 186 : gradle-file? ( path -- ? ) >lower { [ "gradle" head? ] [ ".gradle" tail? ] } 1|| ;
 187 : gradle-files ( paths -- paths' ) [ gradle-file? ] filter ;
 188 : uses-gradle? ( paths -- ? ) [ gradle-file? ] any? ;
 189
 190 : github-file? ( path -- ? ) >lower ".github" swap subseq? ;
 191 : github-files ( paths -- paths' ) [ github-file? ] filter ;
 192 : has-github-files? ( paths -- ? ) [ github-file? ] any? ;
 193
 194 : cargo-file? ( path -- ? ) file-name { "Cargo.toml" "Cargo.lock" } member? ;
 195 : cargo-files ( paths -- paths' ) [ cargo-file? ] filter ;
 196 : has-cargo-files? ( paths -- ? ) [ cargo-file? ] any? ;
 197
 198 : julia-project-file? ( path -- ? ) file-name { "Project.toml" } member? ;
 199 : julia-project-files ( paths -- paths' ) [ julia-project-file? ] filter ;
 200 : has-julia-project-files? ( paths -- ? ) [ julia-project-file? ] any? ;
 201
 202 : rust-project-dir? ( path -- ? ) file-name "Cargo.toml" = ;
 203
 204 : rust-source-file? ( path -- ? )
 205     {
 206         [ ".rs" tail? ]
 207     } 1|| ;
 208
 209 : rust-source-files ( path -- paths ) [ rust-source-file? ] filter ;
 210
 211 : rust-build-system-files ( path -- ? )
 212     {
 213         [ "Carg.toml" tail? ]
 214         [ "Carg.lock" tail? ]
 215     } 1|| ;
 216
 217 : rust-intermediate-build-files ( path -- ? )
 218     {
 219         [ ".rlib" tail? ]
 220         [ ".rmeta" tail? ]
 221         [ ".o" tail? ]
 222     } 1|| ;
 223
 224 : rust-output-files ( path -- ? )
 225     {
 226         [ ".dll" tail? ]
 227         [ ".dylib" tail? ]
 228         [ ".a" tail? ]
 229         [ ".so" tail? ]
 230     } 1|| ;
 231
 232 : print-rust-package ( assoc -- )
 233     {
 234         [ "name" of [ "  name: %s" sprintf print ] when* ]
 235         [ "version" of [ "  version: %s" sprintf print ] when* ]
 236         [ "license" of [ "  license: %s" sprintf print ] when* ]
 237         [ "edition" of [ "  rust edition: %s" sprintf print ] when* ]
 238     } cleave ;
 239
 240 : analyze-rust-cargo-toml ( assoc -- )
 241     [ print-rust-package ] keep
 242     [ "workspace" of "members" of length [ "  %d member projects" sprintf print ] unless-zero ]
 243     [
 244         [ [ "package" of ] [ "workspace" of "package" of ] bi assoc-union ] keep
 245         "workspace" of "members" of [
 246             "package: " write print print-rust-package
 247         ] with each
 248     ] bi ;
 249
 250 : analyze-rust-project ( path -- )
 251     [ "Analyzing rust project at %s" sprintf print ]
 252     [ path>toml analyze-rust-cargo-toml ]
 253     [ containing-directory recursive-directory-files ] tri
 254     {
 255         [ rust-source-files length "  %d rust source files" sprintf print ]
 256     } cleave ;
 257
 258 : web-file? ( path -- ? )
 259     >lower file-extension
 260     {
 261         "css" "scss" "js" "jsx" "ejs" "mjs" "ts" "tsx" "json" "html"
 262         "less" "mustache" "snap" "wasm"
 263     } member? ;
 264 : web-files ( paths -- paths' ) [ web-file? ] filter ;
 265
 266 : rc-file? ( path -- ? ) >lower file-name { [ "." head? ] [ "rc" tail? ] } 1&& ;
 267 : rc-files ( paths -- paths' ) [ rc-file? ] filter ;
 268
 269 : env-file? ( path -- ? ) >lower ".env" tail? ;
 270 : env-files ( paths -- paths' ) [ env-file? ] filter ;
 271
 272 : image-file? ( path -- ? ) >lower file-extension { "png" "jpg" "jpeg" "ico" } member? ;
 273 : image-files ( paths -- paths' ) [ image-file? ] filter ;
 274
 275 : ignore-file? ( path -- ? ) >lower file-name { [ "." head? ] [ "ignore" tail? ] } 1&& ;
 276 : ignore-files ( paths -- paths' ) [ ignore-file? ] filter ;
 277
 278 : has-package-json? ( path -- ? ) "package.json" append-path file-exists? ;
 279 : uses-git? ( path -- ? ) ".git" append-path file-exists? ;
 280
 281 : diff-paths ( paths quot -- paths' )
 282     keep swap [ [ normalize-path ] map ] bi@ diff ; inline
 283
 284 : assoc. ( assoc -- )
 285     [ commas ] map-values simple-table. ;
 286
 287 : analyze-codebase-path ( path -- )
 288     {
 289         [ normalize-path "project at path `%s`" sprintf print nl ]
 290         [ uses-git? [ "uses git" print ] when ]
 291         [ has-package-json? [ "has a package.json file" print ] when ]
 292     } cleave ;
 293
 294 : analyze-codebase-paths ( paths -- )
 295     {
 296         [
 297             partition-binary
 298             [ length "%d binary files" sprintf print ]
 299             [ length "%d text files" sprintf print ] bi*
 300         ]
 301         [ github-files [ sort "has .github files" print ... ] unless-empty ]
 302         [ license-files [ sort [ length "has %d license files" sprintf print ] [ ... ] bi ] unless-empty ]
 303         [ readme-files [ sort "has readme files" print ... ] unless-empty ]
 304         [ owners-files [ sort "has owners files" print ... ] unless-empty ]
 305         [ codenotify-files [ sort "has codenotify files" print ... ] unless-empty ]
 306         [ contributing-files [ sort "has contributing files" print ... ] unless-empty ]
 307         [ changelog-files [ sort "has changelog files" print ... ] unless-empty ]
 308         [ security-files [ sort "has security files" print ... ] unless-empty ]
 309         [ notice-files [ sort "has notice files" print ... ] unless-empty ]
 310         [ version-files [ sort "has version files" print ... ] unless-empty ]
 311         [
 312             { [ dot-files ] [ rc-files diff ] [ ignore-files diff ] } cleave
 313             [ sort "has dot files" print ... ] unless-empty
 314         ]
 315         [ rc-files [ sort [ length "has %d rc files" sprintf print ] [ ... ] bi ] unless-empty ]
 316         [ configure-files [ sort "uses configure files" print ... ] unless-empty ]
 317         [ automake-files [ sort "uses automake" print ... ] unless-empty ]
 318         [ make-files [ sort "uses make" print ... ] unless-empty ]
 319         [ nmake-files [ sort "uses nmake" print ... ] unless-empty ]
 320         [ cmake-files [ sort "uses cmake" print ... ] unless-empty ]
 321         [ gradle-files [ sort "uses gradle" print ... ] unless-empty ]
 322         [ cargo-files [ sort "uses rust/cargo" print ... ] unless-empty ]
 323         [ julia-project-files [ sort "uses julia Project.toml" print ... ] unless-empty ]
 324         [ in-files [ sort "uses 'in' files" print ... ] unless-empty ]
 325         [ ignore-files [ sort [ length "has %d ignore files" sprintf print ] [ ... ] bi ] unless-empty nl ]
 326         [ [ rust-project-dir? ] filter [ [ "rust projects at " print . ] [ [ analyze-rust-project ] each ] bi ] unless-empty nl ]
 327         [
 328             [ upper-files ] keep
 329             {
 330                 [ github-files diff ]
 331                 [ license-files diff ]
 332                 [ readme-files diff ]
 333                 [ owners-files diff ]
 334                 [ codenotify-files diff ]
 335                 [ contributing-files diff ]
 336                 [ changelog-files diff ]
 337                 [ security-files diff ]
 338                 [ notice-files diff ]
 339                 [ version-files diff ]
 340             } cleave
 341             [ sort [ length "has %d UPPER files (minus github,license,readme,owner,codenotify,contributing,changelog,security,notice,version)" sprintf print ] [ ... ] bi ] unless-empty nl
 342         ]
 343         [ "Top 20 largest files" print file-sizes sort-values 20 index-or-length tail* [ normalize-path ] map-keys reverse assoc. nl ]
 344         [ "Top 10 file extension sizes" print sum-sizes-by-extension 10 index-or-length tail* reverse assoc. nl ]
 345         [ "Top 10 text file line counts" print sum-line-counts-by-extension 10 index-or-length tail* reverse assoc. nl ]
 346         [ "Top 10 file extension counts" print count-by-file-extension 10 index-or-length tail* reverse assoc. nl ]
 347     } cleave ;
 348
 349 : analyze-codebase ( path -- )
 350     [ analyze-codebase-path ]
 351     [ codebase-paths analyze-codebase-paths ] bi ;
 352
 353 : analyze-codebases ( path -- )
 354     [ directory-files ] keep [ prepend-path ] curry map
 355     [ file-info directory? ] filter
 356     [ analyze-codebase ] each ;