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 : version-file? ( path -- ? )
 131     >lower file-stem "version" = ;
 132 : version-files ( paths -- paths' ) [ version-file? ] filter ;
 133
 134 : json-file? ( path -- ? )
 135     >lower file-extension
 136     { "json" "jsonc" } member? ;
 137
 138 : json-files ( paths -- paths' ) [ json-file? ] filter ;
 139
 140 : yaml-file? ( path -- ? ) { [ ".yaml" tail? ] [ ".yml" tail? ] } 1|| ;
 141 : yaml-files ( paths -- paths' ) [ yaml-file? ] filter ;
 142 : uses-yaml? ( paths -- ? ) [ yaml-file? ] any? ;
 143
 144 : docker-file? ( path -- ? ) >lower file-name { "dockerfile" ".dockerignore" "docker-compose.yaml" } member? ;
 145 : docker-files ( paths -- paths' ) [ docker-file? ] filter ;
 146 : uses-docker? ( paths -- ? ) [ docker-file? ] any? ;
 147
 148 : automake-file? ( path -- ? )
 149     >lower file-name
 150     {
 151         [ "makefile.am" tail? ]
 152         [ "makefile.am.inc" tail? ]
 153     } 1|| ;
 154 : automake-files ( paths -- paths' ) [ automake-file? ] filter ;
 155 : uses-automake? ( paths -- ? ) [ automake-file? ] any? ;
 156
 157 : make-file? ( path -- ? )
 158     >lower file-name { "gnumakefile" "makefile" } member? ;
 159 : make-files ( paths -- paths' ) [ make-file? ] filter ;
 160 : uses-make? ( paths -- ? ) [ make-file? ] any? ;
 161
 162 : nmake-file? ( path -- ? ) >lower file-name "nmakefile" = ;
 163 : nmake-files ( paths -- paths' ) [ nmake-file? ] filter ;
 164 : uses-nmake? ( paths -- ? ) [ nmake-file? ] any? ;
 165
 166 : gradle-file? ( path -- ? ) >lower { [ "gradle" head? ] [ ".gradle" tail? ] } 1|| ;
 167 : gradle-files ( paths -- paths' ) [ gradle-file? ] filter ;
 168 : uses-gradle? ( paths -- ? ) [ gradle-file? ] any? ;
 169
 170 : github-file? ( path -- ? ) >lower ".github" swap subseq? ;
 171 : github-files ( paths -- paths' ) [ github-file? ] filter ;
 172 : has-github-files? ( paths -- ? ) [ github-file? ] any? ;
 173
 174 : cargo-file? ( path -- ? ) file-name { "Cargo.toml" "Cargo.lock" } member? ;
 175 : cargo-files ( paths -- paths' ) [ cargo-file? ] filter ;
 176 : has-cargo-files? ( paths -- ? ) [ cargo-file? ] any? ;
 177
 178 : julia-project-file? ( path -- ? ) file-name { "Project.toml" } member? ;
 179 : julia-project-files ( paths -- paths' ) [ julia-project-file? ] filter ;
 180 : has-julia-project-files? ( paths -- ? ) [ julia-project-file? ] any? ;
 181
 182 : rust-project-dir? ( path -- ? ) file-name "Cargo.toml" = ;
 183
 184 : rust-source-file? ( path -- ? )
 185     {
 186         [ ".rs" tail? ]
 187     } 1|| ;
 188
 189 : rust-source-files ( path -- paths ) [ rust-source-file? ] filter ;
 190
 191 : rust-build-system-files ( path -- ? )
 192     {
 193         [ "Carg.toml" tail? ]
 194         [ "Carg.lock" tail? ]
 195     } 1|| ;
 196
 197 : rust-intermediate-build-files ( path -- ? )
 198     {
 199         [ ".rlib" tail? ]
 200         [ ".rmeta" tail? ]
 201         [ ".o" tail? ]
 202     } 1|| ;
 203
 204 : rust-output-files ( path -- ? )
 205     {
 206         [ ".dll" tail? ]
 207         [ ".dylib" tail? ]
 208         [ ".a" tail? ]
 209         [ ".so" tail? ]
 210     } 1|| ;
 211
 212 : print-rust-package ( assoc -- )
 213     {
 214         [ "name" of [ "  name: %s" sprintf print ] when* ]
 215         [ "version" of [ "  version: %s" sprintf print ] when* ]
 216         [ "license" of [ "  license: %s" sprintf print ] when* ]
 217         [ "edition" of [ "  rust edition: %s" sprintf print ] when* ]
 218     } cleave ;
 219
 220 : analyze-rust-cargo-toml ( assoc -- )
 221     [ print-rust-package ] keep
 222     [ "workspace" of "members" of length [ "  %d member projects" sprintf print ] unless-zero ]
 223     [
 224         [ [ "package" of ] [ "workspace" of "package" of ] bi assoc-union ] keep
 225         "workspace" of "members" of [
 226             "package: " write print print-rust-package
 227         ] with each
 228     ] bi ;
 229
 230 : analyze-rust-project ( path -- )
 231     [ "Analyzing rust project at %s" sprintf print ]
 232     [ path>toml analyze-rust-cargo-toml ]
 233     [ containing-directory recursive-directory-files ] tri
 234     {
 235         [ rust-source-files length "  %d rust source files" sprintf print ]
 236     } cleave ;
 237
 238 : web-file? ( path -- ? )
 239     >lower file-extension
 240     {
 241         "css" "scss" "js" "jsx" "ejs" "mjs" "ts" "tsx" "json" "html"
 242         "less" "mustache" "snap" "wasm"
 243     } member? ;
 244 : web-files ( paths -- paths' ) [ web-file? ] filter ;
 245
 246 : rc-file? ( path -- ? ) >lower file-name { [ "." head? ] [ "rc" tail? ] } 1&& ;
 247 : rc-files ( paths -- paths' ) [ rc-file? ] filter ;
 248
 249 : env-file? ( path -- ? ) >lower ".env" tail? ;
 250 : env-files ( paths -- paths' ) [ env-file? ] filter ;
 251
 252 : image-file? ( path -- ? ) >lower file-extension { "png" "jpg" "jpeg" "ico" } member? ;
 253 : image-files ( paths -- paths' ) [ image-file? ] filter ;
 254
 255 : ignore-file? ( path -- ? ) >lower file-name { [ "." head? ] [ "ignore" tail? ] } 1&& ;
 256 : ignore-files ( paths -- paths' ) [ ignore-file? ] filter ;
 257
 258 : has-package-json? ( path -- ? ) "package.json" append-path file-exists? ;
 259 : uses-git? ( path -- ? ) ".git" append-path file-exists? ;
 260
 261 : diff-paths ( paths quot -- paths' )
 262     keep swap [ [ normalize-path ] map ] bi@ diff ; inline
 263
 264 : assoc. ( assoc -- )
 265     [ commas ] map-values simple-table. ;
 266
 267 : analyze-codebase-path ( path -- )
 268     {
 269         [ normalize-path "project at path `%s`" sprintf print nl ]
 270         [ uses-git? [ "uses git" print ] when ]
 271         [ has-package-json? [ "has a package.json file" print ] when ]
 272     } cleave ;
 273
 274 : analyze-codebase-paths ( paths -- )
 275     {
 276         [
 277             partition-binary
 278             [ length "%d binary files" sprintf print ]
 279             [ length "%d text files" sprintf print ] bi*
 280         ]
 281         [ github-files [ sort "has .github files" print ... ] unless-empty ]
 282         [ license-files [ sort [ length "has %d license files" sprintf print ] [ ... ] bi ] unless-empty ]
 283         [ readme-files [ sort "has readme files" print ... ] unless-empty ]
 284         [ owners-files [ sort "has owners files" print ... ] unless-empty ]
 285         [ version-files [ sort "has version files" print ... ] unless-empty ]
 286         [
 287             { [ dot-files ] [ rc-files diff ] [ ignore-files diff ] } cleave
 288             [ sort "has dot files" print ... ] unless-empty
 289         ]
 290         [ rc-files [ sort [ length "has %d rc files" sprintf print ] [ ... ] bi ] unless-empty ]
 291         [ configure-files [ sort "uses configure files" print ... ] unless-empty ]
 292         [ automake-files [ sort "uses automake" print ... ] unless-empty ]
 293         [ make-files [ sort "uses make" print ... ] unless-empty ]
 294         [ nmake-files [ sort "uses nmake" print ... ] unless-empty ]
 295         [ cmake-files [ sort "uses cmake" print ... ] unless-empty ]
 296         [ gradle-files [ sort "uses gradle" print ... ] unless-empty ]
 297         [ cargo-files [ sort "uses rust/cargo" print ... ] unless-empty ]
 298         [ julia-project-files [ sort "uses julia Project.toml" print ... ] unless-empty ]
 299         [ in-files [ sort "uses 'in' files" print ... ] unless-empty ]
 300         [ ignore-files [ sort [ length "has %d ignore files" sprintf print ] [ ... ] bi ] unless-empty nl ]
 301         [ [ rust-project-dir? ] filter [ [ "rust projects at " print . ] [ [ analyze-rust-project ] each ] bi ] unless-empty nl ]
 302         [
 303             [ upper-files ] keep
 304             {
 305                 [ license-files diff ]
 306                 [ readme-files diff ]
 307                 [ owners-files diff ]
 308                 [ version-files diff ]
 309             } cleave
 310             [ sort [ length "has %d UPPER files (minus license,readme,owner,version)" sprintf print ] [ ... ] bi ] unless-empty nl
 311         ]
 312         [ "Top 20 largest files" print file-sizes sort-values 20 index-or-length tail* [ normalize-path ] map-keys reverse assoc. nl ]
 313         [ "Top 10 file extension sizes" print sum-sizes-by-extension 10 index-or-length tail* reverse assoc. nl ]
 314         [ "Top 10 text file line counts" print sum-line-counts-by-extension 10 index-or-length tail* reverse assoc. nl ]
 315         [ "Top 10 file extension counts" print count-by-file-extension 10 index-or-length tail* reverse assoc. nl ]
 316     } cleave ;
 317
 318 : analyze-codebase ( path -- )
 319     [ analyze-codebase-path ]
 320     [ codebase-paths analyze-codebase-paths ] bi ;
 321
 322 : analyze-codebases ( path -- )
 323     [ directory-files ] keep [ prepend-path ] curry map
 324     [ file-info directory? ] filter
 325     [ analyze-codebase ] each ;