Added dependency graph to documentation.
This commit is contained in:
Georges Dupéron
parent
965669da60
commit
a0f71dc18a
34
graph-lib/index.scrbl
Normal file
34
graph-lib/index.scrbl
Normal file
|
|
@ -0,0 +1,34 @@
|
|||
#lang scribble/manual
|
||||
@(require "lib/doc.rkt")
|
||||
@doc-lib-setup
|
||||
|
||||
@;(require scribble/core
|
||||
@; scribble/html-properties)
|
||||
|
||||
@title[#:style manual-doc-style]{Ph.C}
|
||||
|
||||
@hyperlink["https://travis-ci.org/jsmaniac/phc"]{
|
||||
@remote-image["https://travis-ci.org/jsmaniac/phc.png?branch=master"]{
|
||||
Build Status}}
|
||||
@hyperlink["https://coveralls.io/github/jsmaniac/cover?branch=master"]{
|
||||
@remote-image[(string-append "https://coveralls.io/repos/jsmaniac/cover/"
|
||||
"badge.svg?branch=master")]{
|
||||
Coverage Status}}
|
||||
|
||||
@;@(table-of-contents)
|
||||
|
||||
@section{Introduction}
|
||||
|
||||
@section{Documentation}
|
||||
|
||||
@itemlist[
|
||||
@item{@hyperlink["docs/"]{Documentation}}
|
||||
@item{@hyperlink["coverage/"]{Coverage info}}]
|
||||
|
||||
@section{Dependency diagram}
|
||||
|
||||
A @hyperlink["deps.png"]{PNG version} and a @hyperlink["deps.pdf"]{PDF version}
|
||||
are available.
|
||||
|
||||
@hyperlink["deps.svg"]{
|
||||
@image["docs/deps" #:suffixes '(".pdf" ".svg")]{Dependency diagram}}
|
||||
|
|
@ -19,6 +19,18 @@
|
|||
(require (for-label (only-meta-in 0 typed/racket)))
|
||||
(provide (for-label (all-from-out typed/racket)))
|
||||
|
||||
;; ==== remote images ====
|
||||
(provide remote-image)
|
||||
(require (only-in scribble/core make-style)
|
||||
(only-in scribble/html-properties alt-tag attributes))
|
||||
(define (remote-image src alt)
|
||||
(elem
|
||||
#:style
|
||||
(make-style #f
|
||||
(list (alt-tag "img")
|
||||
(attributes
|
||||
`((src . ,src)
|
||||
(alt . ,alt)))))))
|
||||
|
||||
;; ==== hybrid footnotes/margin-note ====
|
||||
(provide note)
|
||||
|
|
|
|||
245
graph-lib/make/dependency-graph.rkt
Normal file
245
graph-lib/make/dependency-graph.rkt
Normal file
|
|
@ -0,0 +1,245 @@
|
|||
#lang racket
|
||||
|
||||
(require macro-debugger/analysis/show-dependencies)
|
||||
|
||||
(provide print-dep-graph
|
||||
get-dep-graph)
|
||||
|
||||
(define (categorize x)
|
||||
(match x
|
||||
[(? symbol?) 'lib]
|
||||
[(list 'quote (? symbol?
|
||||
(? (λ (x) (regexp-match #rx"^#%" (symbol->string x))))))
|
||||
'lib]
|
||||
[(list 'submod (? symbol?) _ ...) 'lib]
|
||||
[(list (? symbol? s) _ ...) s]
|
||||
[_ #f]))
|
||||
|
||||
(define (lib? x)
|
||||
(equal? (categorize x) 'lib))
|
||||
|
||||
(define (categorize-main-module x)
|
||||
(match x
|
||||
[(? symbol? s) s]
|
||||
[(list 'file (? string? s)) s]
|
||||
[(list 'submod s _ ...) (categorize-main-module s)]
|
||||
[(list (? symbol? s) _ ...) s]
|
||||
[_ x]))
|
||||
|
||||
(define (simplify x)
|
||||
(match x
|
||||
[(list 'file (? string? s)) s]
|
||||
[_ x]))
|
||||
|
||||
(define (deps->graphviz dep-pairs [show-inner #f])
|
||||
(define (show m)
|
||||
(parameterize ([pretty-print-columns 'infinity])
|
||||
(write (pretty-format ((or show-inner identity) m)))))
|
||||
|
||||
(define all-modules
|
||||
(remove-duplicates (append (map car dep-pairs)
|
||||
(map cdr dep-pairs))))
|
||||
|
||||
(printf "digraph deps {\n")
|
||||
(for ([mg (in-list (group-by categorize-main-module all-modules))]
|
||||
[i (in-naturals)])
|
||||
(when (> (length mg) 1)
|
||||
(printf " subgraph cluster_~a {\n" i)
|
||||
(printf " style=filled;\n")
|
||||
(printf " color=lightgrey;\n")
|
||||
(for ([m (in-list mg)])
|
||||
(printf " ")
|
||||
(show m)
|
||||
(printf ";\n"))
|
||||
(printf " }\n")))
|
||||
(for ([dep (in-list dep-pairs)])
|
||||
(printf " ")
|
||||
(show (car dep))
|
||||
(printf " -> ")
|
||||
(show (cdr dep))
|
||||
(printf ";\n"))
|
||||
(printf "}\n"))
|
||||
|
||||
(define excluded
|
||||
'(typed/racket
|
||||
racket/base
|
||||
racket
|
||||
scribble/lp/lang/lang2))
|
||||
|
||||
(define (print-dep-graph source-file)
|
||||
(define rdeps
|
||||
(get-dependencies `(file ,source-file)
|
||||
#:exclude-deps excluded))
|
||||
|
||||
(define dep-pairs
|
||||
(append-map (λ (rdep)
|
||||
(let ([mod (car rdep)]
|
||||
[direct-requirers (cadr rdep)])
|
||||
(for/list ([direct-requirer (in-list direct-requirers)])
|
||||
(cons direct-requirer mod))))
|
||||
rdeps))
|
||||
|
||||
(define deps
|
||||
(map (λ (g)
|
||||
(cons (caar g) (append-map cdr g)))
|
||||
(group-by car
|
||||
(append (map (λ (dep) (list (car dep) (cdr dep))) dep-pairs)
|
||||
(map (compose list cdr) dep-pairs)))))
|
||||
|
||||
(define grouped-deps
|
||||
(map (λ (g)
|
||||
(list (categorize-main-module (caar g))
|
||||
(map car g)
|
||||
(remove-duplicates (append-map cdr g))))
|
||||
(group-by (compose categorize-main-module car) deps)))
|
||||
|
||||
(define (get-tags grouped-dep)
|
||||
(append
|
||||
(if (> (length (cadr grouped-dep)) 1) '(submodule) '())
|
||||
(if (member 'typed/racket (caddr grouped-dep))
|
||||
'(typed/racket)
|
||||
(if (ormap lib? (cadr grouped-dep))
|
||||
'()
|
||||
'(untyped)))
|
||||
(if (member 'scribble/lp/lang/lang2 (caddr grouped-dep)) '(scribble) '())))
|
||||
|
||||
(define tagged-mods
|
||||
(map (λ (grouped-dep) ; (req dep …) …
|
||||
(let* ([tags (get-tags grouped-dep)])
|
||||
(cons (car grouped-dep)
|
||||
tags)))
|
||||
grouped-deps))
|
||||
|
||||
(define (typed-racket-internals m)
|
||||
(define (rx sym) (regexp-match #rx"^typed-racket/" (symbol->string sym)))
|
||||
(match m
|
||||
[(? symbol? s) (rx s)]
|
||||
[(list 'submod (? symbol? s) _ ...) (rx s)]
|
||||
[_ #f]))
|
||||
|
||||
(define (tag-pair dep)
|
||||
(append (if (equal? (cdr dep) "lib/low.rkt") '(lib/low) '())
|
||||
(if (equal? (cdr dep) "lib/low-untyped.rkt") '(lib/low) '())
|
||||
(if (equal? (categorize-main-module (car dep))
|
||||
(categorize-main-module (cdr dep))) '(submodule) '())
|
||||
(if (lib? (cdr dep)) '(lib) '())))
|
||||
|
||||
(define tagged-dep-pairs
|
||||
(map (λ (dep)
|
||||
(cons dep (tag-pair dep)))
|
||||
dep-pairs))
|
||||
|
||||
(define filtered-tagged-dep-pairs
|
||||
(filter-map (λ (dep)
|
||||
(and (not (lib? (caar dep)))
|
||||
(not (typed-racket-internals (cdar dep)))
|
||||
(not (member (cdar dep) excluded))
|
||||
dep))
|
||||
tagged-dep-pairs))
|
||||
|
||||
(define categorized-tagged-dep-pairs
|
||||
(map (λ (deps) (cons (caar deps) (remove-duplicates (append-map cdr deps))))
|
||||
(group-by car
|
||||
(map (λ (dep)
|
||||
(cons (cons (categorize-main-module (caar dep))
|
||||
(categorize-main-module (cdar dep)))
|
||||
(cdr dep)))
|
||||
filtered-tagged-dep-pairs))))
|
||||
|
||||
(define filtered-tagged-mods
|
||||
(filter-map (λ (m) (assoc m tagged-mods))
|
||||
(remove-duplicates
|
||||
(append (map caar categorized-tagged-dep-pairs)
|
||||
(map cdar categorized-tagged-dep-pairs)))))
|
||||
|
||||
#;(define (mod-tags->styles ts)
|
||||
(define kv
|
||||
(for/fold ([h (hash)])
|
||||
([t (in-list ts)])
|
||||
(case t
|
||||
[(submodule) '(hash-set* h
|
||||
"style" "filled"
|
||||
"line-style" "double")]
|
||||
[(typed/racket) (hash-set* h
|
||||
"color" "green")]
|
||||
[(scribble) (hash-set* h
|
||||
"shape" "box"
|
||||
"style" "rounded")]
|
||||
[else h])))
|
||||
(filter identity
|
||||
(for/list ([(key value) (in-hash kv)])
|
||||
(case key
|
||||
[("line-style") (let ([c (hash-ref kv "color"
|
||||
(λ () "black"))])
|
||||
(if (equal? value "double")
|
||||
(format "color=\"~a:invis:~a\"" c c)
|
||||
c))]
|
||||
[("color") (if (hash-has-key? kv "line-style")
|
||||
#f
|
||||
(format "~a=~a" key value))]
|
||||
[else (format "~a=~a" key value)]))))
|
||||
|
||||
(define (mod-tag->style t)
|
||||
(case t
|
||||
[(submodule) "peripheries=2"]
|
||||
[(typed/racket) "color=\"#44cc44\""]
|
||||
[(scribble) "shape=box, style=rounded"]
|
||||
[(untyped) "color=\"#bb2222\""]
|
||||
[(()) ""]
|
||||
[else #f]))
|
||||
|
||||
(define (dep-tag->style t)
|
||||
(case t
|
||||
[(lib/low) "color=grey,style=dotted"]
|
||||
[(submodule) "color=grey"]
|
||||
[(lib) "style=dashed"]
|
||||
[else #f]))
|
||||
|
||||
(define (deps->graphviz2 tagged-mods tagged-dep-pairs)
|
||||
(define (show m)
|
||||
(parameterize ([pretty-print-columns 'infinity])
|
||||
(write (pretty-format m))))
|
||||
|
||||
(printf "digraph deps {\n")
|
||||
(printf " nodesep=0.1\n")
|
||||
(printf " node[shape=box]\n")
|
||||
(for ([mod (in-list tagged-mods)])
|
||||
(printf " ")
|
||||
(show (car mod))
|
||||
(printf " [~a]"
|
||||
(if (null? (cdr mod))
|
||||
(mod-tag->style '())
|
||||
(string-join (filter-map mod-tag->style (cdr mod)) ", ")))
|
||||
(printf ";\n"))
|
||||
(for ([dep (in-list tagged-dep-pairs)])
|
||||
(printf " ")
|
||||
(show (caar dep))
|
||||
(printf " -> ")
|
||||
(show (cdar dep))
|
||||
(printf " [~a]" (string-join (filter-map dep-tag->style (cdr dep)) ", "))
|
||||
(printf ";\n"))
|
||||
(printf "}\n"))
|
||||
|
||||
(deps->graphviz2 filtered-tagged-mods categorized-tagged-dep-pairs))
|
||||
|
||||
(define (get-dep-graph source-file)
|
||||
(let ((o (open-output-string "graph.dot")))
|
||||
(parameterize ([current-output-port o])
|
||||
(print-dep-graph source-file)
|
||||
(get-output-string o))))
|
||||
|
||||
(module* main racket
|
||||
(require (submod ".."))
|
||||
|
||||
(let ([argv (current-command-line-arguments)])
|
||||
(if (not (= (vector-length argv) 2))
|
||||
#;(error (format "Got ~a arguments but expected 2: ~a"
|
||||
(vector-length argv)
|
||||
"source and output files"))
|
||||
(void)
|
||||
(let ()
|
||||
(define source-file (vector-ref argv 0))
|
||||
(define output-file (vector-ref argv 1))
|
||||
(parameterize ([current-output-port
|
||||
(open-output-file output-file #:exists 'replace)])
|
||||
(print-dep-graph source-file))))))
|
||||
|
|
@ -2,14 +2,37 @@
|
|||
<html>
|
||||
<head>
|
||||
<title>Ph.C</title>
|
||||
<link rel="stylesheet" type="text/css" href="docs/graph/scribble.css" title="default"/>
|
||||
<link rel="stylesheet" type="text/css" href="docs/graph/racket.css" title="default"/>
|
||||
<link rel="stylesheet" type="text/css" href="docs/graph/manual-style.css" title="default"/>
|
||||
<link rel="stylesheet" type="text/css" href="docs/graph/manual-racket.css" title="default"/>
|
||||
<script type="text/javascript" src="docs/graph/scribble-common.js"></script>
|
||||
<script type="text/javascript" src="docs/graph/manual-racket.js"></script>
|
||||
<!--[if IE 6]><style type="text/css">.SIEHidden { overflow: hidden; }</style><![endif]-->
|
||||
</head>
|
||||
<body>
|
||||
<body id="scribble-racket-lang-org">
|
||||
<div class="tocset">
|
||||
<div class="tocview">
|
||||
<div class="tocviewlist tocviewlisttopspace">
|
||||
<div class="tocviewtitle">
|
||||
<table cellspacing="0" cellpadding="0"><tr><td style="width: 1em;"><a href="javascript:void(0);" title="Expand/Collapse" class="tocviewtoggle" onclick="TocviewToggle(this,"tocview_0");">►</a></td><td></td><td><a href="" class="tocviewselflink" data-pltdoc="x">Ph.C</a></td></tr></table>
|
||||
</div>
|
||||
</div>
|
||||
</div>
|
||||
</div>
|
||||
<div class="maincolumn">
|
||||
<h1>Ph.C</h1>
|
||||
<h2>Documentation</h2>
|
||||
<a href="https://travis-ci.org/jsmaniac/phc"><img alt="Build Status" src="https://travis-ci.org/jsmaniac/phc.png?branch=master" /></a>
|
||||
<a href="https://coveralls.io/github/jsmaniac/cover?branch=master"><img alt="Coverage Status" src="https://coveralls.io/repos/jsmaniac/cover/badge.svg?branch=master&service=github" /></a>
|
||||
<ul>
|
||||
<li><a href="coverage/">coverage/</a></li>
|
||||
<li><a href="docs/">docs/</a></li>
|
||||
</ul>
|
||||
<h2>Dependency diagram</h2>
|
||||
<a href="docs/deps.pdf">PDF version</a>
|
||||
<a href="docs/deps.png"><img src="docs/deps.png" /></a>
|
||||
</div>
|
||||
</body>
|
||||
</html>
|
||||
|
||||
|
|
|
|||
|
|
@ -3,38 +3,9 @@
|
|||
(require "lib.rkt")
|
||||
|
||||
(displayln "Make started")
|
||||
|
||||
;(current-directory "..")
|
||||
|
||||
; TODO:
|
||||
;raco pkg install alexis-util
|
||||
;And some other collections too.
|
||||
;
|
||||
;cat graph/structure.lp2.rkt \
|
||||
;| awk '{if (length > 80) print NR "\t" length "\t" $0}' \
|
||||
;| sed -e 's/^\([0-9]*\t[0-9]*\t.\{80\}\)\(.*\)$/\1\x1b[0;30;41m\2\x1b[m/'
|
||||
;
|
||||
;for i in `find \( -path ./lib/doc/bracket -prune -and -false \) \
|
||||
; -or \( -name compiled -prune -and -false \) \
|
||||
; -or -name '*.rkt'`;
|
||||
; do
|
||||
; x=`cat "$i" \
|
||||
; | awk '{if (length > 80) print NR "\t" length "\t" $0}' \
|
||||
; | sed -e 's/^\([0-9]*\t[0-9]*\t.\{80\}\)\(.*\)$/\1\x1b[0;30;41m\2\x1b[m/'`
|
||||
; [ -n "$x" ] && echo -e "\033[1;31m$i:\033[m" && echo $x
|
||||
; done
|
||||
|
||||
#|
|
||||
"for i in `find \( -path ./lib/doc/bracket -prune -and -false \) \
|
||||
-or \( -name compiled -prune -and -false \) \
|
||||
-or -name '*.rkt'`;
|
||||
do
|
||||
x=`cat "$i" \
|
||||
| awk '{if (length > 80) print NR "\t" length "\t" $0}' \
|
||||
| sed -e 's/^\([0-9]*\t[0-9]*\t.\{80\}\)\(.*\)$/\1\x1b[0;30;41m\2\x1b[m/'`
|
||||
[ -n "$x" ] && echo -e "\033[1;31m$i:\033[m" && echo $x
|
||||
done"
|
||||
|#
|
||||
|
||||
(run! (list (find-executable-path-or-fail "sh")
|
||||
"-c"
|
||||
@string-append{
|
||||
|
|
@ -146,7 +117,7 @@
|
|||
|
||||
;; make-collection doesn't handle dependencies due to (require), so if a.rkt
|
||||
;; requires b.rkt, and b.rkt is changed, a.rkt won't be rebuilt.
|
||||
;; Yhis re-compiles each-time, even when nothing was changed.
|
||||
;; This re-compiles each-time, even when nothing was changed.
|
||||
;((compile-zos #f) rkt-files 'auto)
|
||||
|
||||
;; This does not work, because it tries to create the following directory:
|
||||
|
|
@ -213,3 +184,56 @@
|
|||
(run! `(,(find-executable-path-or-fail "bash")
|
||||
"make/make-indexes.sh"
|
||||
"docs/"))
|
||||
|
||||
;; Old dependency graph
|
||||
#|
|
||||
(run! (list (find-executable-path-or-fail "bash")
|
||||
"-c"
|
||||
#<<EOF
|
||||
(
|
||||
echo "digraph g {";
|
||||
(
|
||||
echo "(";
|
||||
raco show-dependencies \
|
||||
-x typed/racket -x racket/base -x racket \
|
||||
-g graph/__DEBUG_graph__.rkt;
|
||||
echo ")"
|
||||
) \
|
||||
| racket -e '
|
||||
(require racket/format)
|
||||
(define (p l)
|
||||
(if (null? l)
|
||||
(void)
|
||||
(begin
|
||||
(for ([from (in-list (caddr l))])
|
||||
(displayln (format "\"~a\" -> \"~a\"" from (car l))))
|
||||
(p (cdddr l)))))
|
||||
(p (read))
|
||||
';
|
||||
echo "}") \
|
||||
| dot -Tpdf -o docs/deps.pdf
|
||||
EOF
|
||||
))
|
||||
|#
|
||||
|
||||
(run! (list (find-executable-path-or-fail "racket")
|
||||
"make/dependency-graph.rkt"
|
||||
"graph/__DEBUG_graph__.rkt"
|
||||
"docs/deps.dot"))
|
||||
|
||||
(run! (list (find-executable-path-or-fail "dot")
|
||||
"docs/deps.dot"
|
||||
"-Tpng"
|
||||
"-Nfontsize=12"
|
||||
"-o" "docs/deps.png"))
|
||||
|
||||
(run! (list (find-executable-path-or-fail "dot")
|
||||
"docs/deps.dot"
|
||||
"-Tsvg"
|
||||
"-Nfontsize=12"
|
||||
"-o" "docs/deps.svg"))
|
||||
|
||||
(run! (list (find-executable-path-or-fail "dot")
|
||||
"docs/deps.dot"
|
||||
"-Tpdf"
|
||||
"-o" "docs/deps.pdf"))
|
||||
Loading…
Reference in New Issue
Block a user