├── .github └── workflows │ └── haskell-ci.yml ├── .gitignore ├── CHANGELOG.md ├── LICENSE ├── README.md ├── Setup.hs ├── driver └── Main.hs ├── graphmod.cabal ├── nix ├── nixpkgs.nix └── stack.nix ├── screenshots ├── aeson1.dot ├── aeson1.dot.png ├── aeson1.dot.svg ├── aeson1.txt ├── cryptol-1.dot ├── cryptol-1.dot.png ├── cryptol-1.dot.svg ├── cryptol-1.txt ├── cryptol-2.dot ├── cryptol-2.dot.png ├── cryptol-2.dot.svg ├── cryptol-2.txt ├── ghc-typechecker.dot ├── ghc-typechecker.dot.png ├── ghc-typechecker.dot.svg ├── ghc-typechecker.txt ├── lens-1.dot ├── lens-1.dot.png ├── lens-1.dot.svg ├── lens-1.txt ├── lens-2.dot ├── lens-2.dot.png ├── lens-2.dot.svg └── lens-2.txt ├── shell.nix ├── src ├── Graphmod.hs └── Graphmod │ ├── CabalSupport.hs │ ├── Trie.hs │ └── Utils.hs ├── stack.yaml ├── stack.yaml.lock └── tests └── T1 ├── A.hs ├── B.hs ├── C.hs ├── D.hs └── D ├── X.hs └── Y.hs /.github/workflows/haskell-ci.yml: -------------------------------------------------------------------------------- 1 | # This GitHub workflow config has been generated by a script via 2 | # 3 | # haskell-ci 'github' 'graphmod.cabal' 4 | # 5 | # To regenerate the script (for example after adjusting tested-with) run 6 | # 7 | # haskell-ci regenerate 8 | # 9 | # For more information, see https://github.com/haskell-CI/haskell-ci 10 | # 11 | # version: 0.15.20220920 12 | # 13 | # REGENDATA ("0.15.20220920",["github","graphmod.cabal"]) 14 | # 15 | name: Haskell-CI 16 | on: 17 | - push 18 | - pull_request 19 | jobs: 20 | linux: 21 | name: Haskell-CI - Linux - ${{ matrix.compiler }} 22 | runs-on: ubuntu-20.04 23 | timeout-minutes: 24 | 60 25 | container: 26 | image: buildpack-deps:bionic 27 | continue-on-error: ${{ matrix.allow-failure }} 28 | strategy: 29 | matrix: 30 | include: 31 | - compiler: ghc-9.2.4 32 | compilerKind: ghc 33 | compilerVersion: 9.2.4 34 | setup-method: ghcup 35 | allow-failure: false 36 | - compiler: ghc-8.10.3 37 | compilerKind: ghc 38 | compilerVersion: 8.10.3 39 | setup-method: hvr-ppa 40 | allow-failure: false 41 | - compiler: ghc-8.8.4 42 | compilerKind: ghc 43 | compilerVersion: 8.8.4 44 | setup-method: hvr-ppa 45 | allow-failure: false 46 | - compiler: ghc-8.6.5 47 | compilerKind: ghc 48 | compilerVersion: 8.6.5 49 | setup-method: hvr-ppa 50 | allow-failure: false 51 | fail-fast: false 52 | steps: 53 | - name: apt 54 | run: | 55 | apt-get update 56 | apt-get install -y --no-install-recommends gnupg ca-certificates dirmngr curl git software-properties-common libtinfo5 57 | if [ "${{ matrix.setup-method }}" = ghcup ]; then 58 | mkdir -p "$HOME/.ghcup/bin" 59 | curl -sL https://downloads.haskell.org/ghcup/0.1.18.0/x86_64-linux-ghcup-0.1.18.0 > "$HOME/.ghcup/bin/ghcup" 60 | chmod a+x "$HOME/.ghcup/bin/ghcup" 61 | "$HOME/.ghcup/bin/ghcup" install ghc "$HCVER" || (cat "$HOME"/.ghcup/logs/*.* && false) 62 | "$HOME/.ghcup/bin/ghcup" install cabal 3.6.2.0 || (cat "$HOME"/.ghcup/logs/*.* && false) 63 | else 64 | apt-add-repository -y 'ppa:hvr/ghc' 65 | apt-get update 66 | apt-get install -y "$HCNAME" 67 | mkdir -p "$HOME/.ghcup/bin" 68 | curl -sL https://downloads.haskell.org/ghcup/0.1.18.0/x86_64-linux-ghcup-0.1.18.0 > "$HOME/.ghcup/bin/ghcup" 69 | chmod a+x "$HOME/.ghcup/bin/ghcup" 70 | "$HOME/.ghcup/bin/ghcup" install cabal 3.6.2.0 || (cat "$HOME"/.ghcup/logs/*.* && false) 71 | fi 72 | env: 73 | HCKIND: ${{ matrix.compilerKind }} 74 | HCNAME: ${{ matrix.compiler }} 75 | HCVER: ${{ matrix.compilerVersion }} 76 | - name: Set PATH and environment variables 77 | run: | 78 | echo "$HOME/.cabal/bin" >> $GITHUB_PATH 79 | echo "LANG=C.UTF-8" >> "$GITHUB_ENV" 80 | echo "CABAL_DIR=$HOME/.cabal" >> "$GITHUB_ENV" 81 | echo "CABAL_CONFIG=$HOME/.cabal/config" >> "$GITHUB_ENV" 82 | HCDIR=/opt/$HCKIND/$HCVER 83 | if [ "${{ matrix.setup-method }}" = ghcup ]; then 84 | HC=$HOME/.ghcup/bin/$HCKIND-$HCVER 85 | echo "HC=$HC" >> "$GITHUB_ENV" 86 | echo "HCPKG=$HOME/.ghcup/bin/$HCKIND-pkg-$HCVER" >> "$GITHUB_ENV" 87 | echo "HADDOCK=$HOME/.ghcup/bin/haddock-$HCVER" >> "$GITHUB_ENV" 88 | echo "CABAL=$HOME/.ghcup/bin/cabal-3.6.2.0 -vnormal+nowrap" >> "$GITHUB_ENV" 89 | else 90 | HC=$HCDIR/bin/$HCKIND 91 | echo "HC=$HC" >> "$GITHUB_ENV" 92 | echo "HCPKG=$HCDIR/bin/$HCKIND-pkg" >> "$GITHUB_ENV" 93 | echo "HADDOCK=$HCDIR/bin/haddock" >> "$GITHUB_ENV" 94 | echo "CABAL=$HOME/.ghcup/bin/cabal-3.6.2.0 -vnormal+nowrap" >> "$GITHUB_ENV" 95 | fi 96 | 97 | HCNUMVER=$(${HC} --numeric-version|perl -ne '/^(\d+)\.(\d+)\.(\d+)(\.(\d+))?$/; print(10000 * $1 + 100 * $2 + ($3 == 0 ? $5 != 1 : $3))') 98 | echo "HCNUMVER=$HCNUMVER" >> "$GITHUB_ENV" 99 | echo "ARG_TESTS=--enable-tests" >> "$GITHUB_ENV" 100 | echo "ARG_BENCH=--enable-benchmarks" >> "$GITHUB_ENV" 101 | echo "HEADHACKAGE=false" >> "$GITHUB_ENV" 102 | echo "ARG_COMPILER=--$HCKIND --with-compiler=$HC" >> "$GITHUB_ENV" 103 | echo "GHCJSARITH=0" >> "$GITHUB_ENV" 104 | env: 105 | HCKIND: ${{ matrix.compilerKind }} 106 | HCNAME: ${{ matrix.compiler }} 107 | HCVER: ${{ matrix.compilerVersion }} 108 | - name: env 109 | run: | 110 | env 111 | - name: write cabal config 112 | run: | 113 | mkdir -p $CABAL_DIR 114 | cat >> $CABAL_CONFIG <> $CABAL_CONFIG < cabal-plan.xz 147 | echo 'de73600b1836d3f55e32d80385acc055fd97f60eaa0ab68a755302685f5d81bc cabal-plan.xz' | sha256sum -c - 148 | xz -d < cabal-plan.xz > $HOME/.cabal/bin/cabal-plan 149 | rm -f cabal-plan.xz 150 | chmod a+x $HOME/.cabal/bin/cabal-plan 151 | cabal-plan --version 152 | - name: checkout 153 | uses: actions/checkout@v2 154 | with: 155 | path: source 156 | - name: initial cabal.project for sdist 157 | run: | 158 | touch cabal.project 159 | echo "packages: $GITHUB_WORKSPACE/source/." >> cabal.project 160 | cat cabal.project 161 | - name: sdist 162 | run: | 163 | mkdir -p sdist 164 | $CABAL sdist all --output-dir $GITHUB_WORKSPACE/sdist 165 | - name: unpack 166 | run: | 167 | mkdir -p unpacked 168 | find sdist -maxdepth 1 -type f -name '*.tar.gz' -exec tar -C $GITHUB_WORKSPACE/unpacked -xzvf {} \; 169 | - name: generate cabal.project 170 | run: | 171 | PKGDIR_graphmod="$(find "$GITHUB_WORKSPACE/unpacked" -maxdepth 1 -type d -regex '.*/graphmod-[0-9.]*')" 172 | echo "PKGDIR_graphmod=${PKGDIR_graphmod}" >> "$GITHUB_ENV" 173 | rm -f cabal.project cabal.project.local 174 | touch cabal.project 175 | touch cabal.project.local 176 | echo "packages: ${PKGDIR_graphmod}" >> cabal.project 177 | echo "package graphmod" >> cabal.project 178 | echo " ghc-options: -Werror=missing-methods" >> cabal.project 179 | cat >> cabal.project <> cabal.project.local 182 | cat cabal.project 183 | cat cabal.project.local 184 | - name: dump install plan 185 | run: | 186 | $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH --dry-run all 187 | cabal-plan 188 | - name: cache 189 | uses: actions/cache@v2 190 | with: 191 | key: ${{ runner.os }}-${{ matrix.compiler }}-${{ github.sha }} 192 | path: ~/.cabal/store 193 | restore-keys: ${{ runner.os }}-${{ matrix.compiler }}- 194 | - name: install dependencies 195 | run: | 196 | $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks --dependencies-only -j2 all 197 | $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH --dependencies-only -j2 all 198 | - name: build w/o tests 199 | run: | 200 | $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks all 201 | - name: build 202 | run: | 203 | $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH all --write-ghc-environment-files=always 204 | - name: cabal check 205 | run: | 206 | cd ${PKGDIR_graphmod} || false 207 | ${CABAL} -vnormal check 208 | - name: haddock 209 | run: | 210 | $CABAL v2-haddock --haddock-all $ARG_COMPILER --with-haddock $HADDOCK $ARG_TESTS $ARG_BENCH all 211 | - name: unconstrained build 212 | run: | 213 | rm -f cabal.project.local 214 | $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks all 215 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | /dist 2 | /dist-newstyle 3 | .stack-work 4 | .ghc.environment.* 5 | -------------------------------------------------------------------------------- /CHANGELOG.md: -------------------------------------------------------------------------------- 1 | * 1.4.5.1 2 | - Support for Cabal 3.6 3 | 4 | * 1.4.5 5 | Several Main modules in one package are disambiguated 6 | as follows (see https://github.com/yav/graphmod/issues/28). 7 | When the module name is Main and there are no qualifiers 8 | (Cabal does not allow any) 9 | Then the qualifiers are the directories leading up to the 10 | source file and the module name is replaced by the file's 11 | basename. 12 | E.g. when the Main module resides in 13 | app/Program/Main.hs 14 | then the node in the graph is labelled 15 | app.Program.Main 16 | 17 | * Version 1.4.1 18 | - Support for Cabal 2 19 | - Updates to build infrastructure 20 | - Fixes memory leak 21 | 22 | * Version 1.3 23 | - Corrects collapsing logic. 24 | - Change node coloring in clusters: 25 | * Clusters are displayed with various shades of gray 26 | * Nodes in a cluster are all the same color 27 | - Change to clustering logic: by default, a module that has the same 28 | name as a cluster will be rendered inside the cluster. One can tell 29 | that the module is different because it will still have the color of 30 | modules from the cluster "above". Also, the module has a border to 31 | empahsize the difference. 32 | This behavior may be disabled using `--no-module-in-cluster` 33 | 34 | * Version 1.2.9 35 | - Support for Cabal: if we find a cabal file, we add all modules in it 36 | - Render `{-# SOURCE #-}` imports specially. 37 | 38 | * Version 1.2.7 39 | Correct the prunning logic. 40 | 41 | * Version 1.2.6 42 | 43 | Add support for parsing GHC's `.import` files. These may be produced 44 | by running GHC with `-ddump-minimal-imports` 45 | 46 | * Version 1.2.5 47 | 48 | Add support for pruning the dependecy graph. 49 | 50 | * Version 1.2.3 51 | 52 | [Collapse Modules] 53 | The flag `--collapse-module` (`-C` for short) adds a new mode of collapsing 54 | multiples nodes into a single one. This is similar to `--collapse` except 55 | that the parameter can refer either to a module name, or to a module prefix. 56 | So, for example, `--collapse-module=A.B` will use a single node for the 57 | module A.B (if there is one), as well as for any module that starts with 58 | the prefix A.B (e.g., A.B.C). 59 | 60 | "Collapsed" nodes are represented with a box. 61 | 62 | Collapsed nodes corresponding to modules have a border, while ones which 63 | correspond to just a prefix do not have a border. 64 | 65 | 66 | [Color Schemes] 67 | The flag `--colors` (`-s` for short) enables users to choose from 68 | a set of predefined color schemes. 69 | 70 | 71 | * Version 1.2.2 72 | 73 | [Show Version] 74 | The flag `--version` (`-v` for short) shows graphmod's version. 75 | 76 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2008 Iavor S. Diatchki, Thomas Hallgren 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions 7 | are met: 8 | 9 | 1. Redistributions of source code must retain the above copyright 10 | notice, this list of conditions and the following disclaimer. 11 | 12 | 2. Redistributions in binary form must reproduce the above copyright 13 | notice, this list of conditions and the following disclaimer in the 14 | documentation and/or other materials provided with the distribution. 15 | 16 | 3. Neither the name of the author nor the names of his contributors 17 | may be used to endorse or promote products derived from this software 18 | without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR 21 | IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 22 | WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 23 | DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR 24 | ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 25 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS 26 | OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) 27 | HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, 28 | STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 29 | ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 30 | POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # graphmod 2 | 3 | Generate a graph of the module dependencies in the "dot" format, suitable as input to the graphviz tools. 4 | 5 | Similar to `ghc-pkg dot`, but on modules instead of packages. 6 | 7 | See the [wiki](https://github.com/yav/graphmod/wiki) for more documentation and examples. 8 | 9 | ## Simple quickstart for cabal users 10 | 11 | $ cabal install graphmod 12 | $ ~/.cabal/bin/graphmod --help 13 | $ ~/.cabal/bin/graphmod | tred | dot -Tpdf > modules.pdf 14 | 15 | ## Simple quickstart for stack users 16 | 17 | $ stack build --copy-compiler-tool graphmod 18 | $ stack exec graphmod -- --help 19 | $ stack exec graphmod | tred | dot -Tpdf > modules.pdf 20 | -------------------------------------------------------------------------------- /Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | 3 | main = defaultMain 4 | -------------------------------------------------------------------------------- /driver/Main.hs: -------------------------------------------------------------------------------- 1 | module Main (main) where 2 | 3 | import Graphmod (graphmod) 4 | import System.Environment (getArgs) 5 | 6 | main :: IO () 7 | main = getArgs >>= graphmod 8 | -------------------------------------------------------------------------------- /graphmod.cabal: -------------------------------------------------------------------------------- 1 | name: graphmod 2 | version: 1.4.5.1 3 | license: BSD3 4 | license-file: LICENSE 5 | author: Iavor S. Diatchki 6 | maintainer: iavor.diatchki@gmail.com 7 | homepage: http://github.com/yav/graphmod/wiki 8 | build-type: Simple 9 | cabal-version: >= 1.10 10 | synopsis: Present the module dependencies of a program as a "dot" graph. 11 | description: This package contains a program that computes "dot" graphs 12 | from the dependencies of a number of Haskell modules. 13 | category: Development 14 | 15 | tested-with: GHC==8.6.5, 16 | GHC==8.8.4, 17 | GHC==8.10.3, 18 | GHC==9.2.4 19 | 20 | extra-source-files: CHANGELOG.md 21 | 22 | executable graphmod 23 | main-is: Main.hs 24 | hs-source-dirs: driver 25 | ghc-options: -Wall -O2 26 | build-depends: 27 | base < 5 28 | , graphmod 29 | default-language: Haskell2010 30 | 31 | library 32 | exposed-modules: Graphmod, Graphmod.Utils 33 | other-modules: Graphmod.Trie, Graphmod.CabalSupport, Paths_graphmod 34 | build-depends: base < 5, directory, filepath, dotgen >= 0.2 && < 0.5, 35 | haskell-lexer >= 1.0.2, containers, Cabal, pretty 36 | hs-source-dirs: src 37 | ghc-options: -Wall -O2 38 | default-language: Haskell2010 39 | 40 | source-repository head 41 | type: git 42 | location: git://github.com/yav/graphmod 43 | -------------------------------------------------------------------------------- /nix/nixpkgs.nix: -------------------------------------------------------------------------------- 1 | import (builtins.fetchTarball { 2 | url = "https://github.com/NixOS/nixpkgs/archive/20.09.tar.gz"; 3 | sha256 = "sha256:1wg61h4gndm3vcprdcg7rc4s1v3jkm5xd7lw8r2f67w502y94gcy"; 4 | }) 5 | -------------------------------------------------------------------------------- /nix/stack.nix: -------------------------------------------------------------------------------- 1 | { ghc }: 2 | 3 | with import ./nixpkgs.nix { }; 4 | 5 | haskell.lib.buildStackProject { 6 | inherit ghc; 7 | name = "graphmod-stack-env"; 8 | buildInputs = [ ]; 9 | } 10 | -------------------------------------------------------------------------------- /screenshots/aeson1.dot: -------------------------------------------------------------------------------- 1 | digraph G { 2 | size="6,4"; 3 | ratio="fill"; 4 | subgraph cluster_0 { 5 | label="Data"; 6 | color="#ccffcc"; 7 | style="filled"; 8 | u1[label="Aeson"]; 9 | subgraph cluster_1 { 10 | label="Aeson"; 11 | color="#99ff99"; 12 | style="filled"; 13 | u11[label="Parser"]; 14 | u10[label="Generic"]; 15 | u5[label="Functions"]; 16 | u3[label="Types"]; 17 | u2[label="Encode"]; 18 | u0[label="TH"]; 19 | subgraph cluster_2 { 20 | label="Encode"; 21 | color="#66ff66"; 22 | style="filled"; 23 | u8[label="ByteString"]; 24 | 25 | } 26 | subgraph cluster_3 { 27 | label="Parser"; 28 | color="#66ff66"; 29 | style="filled"; 30 | u9[label="Internal"]; 31 | 32 | } 33 | subgraph cluster_4 { 34 | label="Types"; 35 | color="#66ff66"; 36 | style="filled"; 37 | u12[label="Generic"]; 38 | u7[label="Internal"]; 39 | u6[label="Class"]; 40 | u4[label="Instances"]; 41 | 42 | } 43 | 44 | } 45 | 46 | } 47 | u0 -> u1; 48 | u0 -> u3; 49 | u1 -> u2; 50 | u1 -> u3; 51 | u1 -> u9; 52 | u2 -> u3; 53 | u2 -> u8; 54 | u3 -> u4; 55 | u3 -> u7; 56 | u4 -> u5; 57 | u4 -> u6; 58 | u4 -> u7; 59 | u6 -> u7; 60 | u8 -> u3; 61 | u9 -> u3; 62 | u10 -> u2; 63 | u10 -> u3; 64 | u10 -> u5; 65 | u10 -> u9; 66 | u11 -> u9; 67 | u12 -> u4; 68 | u12 -> u7; 69 | 70 | } 71 | 72 | -------------------------------------------------------------------------------- /screenshots/aeson1.dot.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/yav/graphmod/983c38f73d3d6d232c954416fd1ab019f24c9fc5/screenshots/aeson1.dot.png -------------------------------------------------------------------------------- /screenshots/aeson1.dot.svg: -------------------------------------------------------------------------------- 1 | 2 | 4 | 6 | 7 | 9 | 10 | G 11 | 12 | cluster_0 13 | 14 | Data 15 | 16 | cluster_1 17 | 18 | Aeson 19 | 20 | cluster_2 21 | 22 | Encode 23 | 24 | cluster_3 25 | 26 | Parser 27 | 28 | cluster_4 29 | 30 | Types 31 | 32 | 33 | u1 34 | 35 | Aeson 36 | 37 | 38 | u3 39 | 40 | Types 41 | 42 | 43 | u1->u3 44 | 45 | 46 | 47 | 48 | u2 49 | 50 | Encode 51 | 52 | 53 | u1->u2 54 | 55 | 56 | 57 | 58 | u9 59 | 60 | Internal 61 | 62 | 63 | u1->u9 64 | 65 | 66 | 67 | 68 | u11 69 | 70 | Parser 71 | 72 | 73 | u11->u9 74 | 75 | 76 | 77 | 78 | u10 79 | 80 | Generic 81 | 82 | 83 | u5 84 | 85 | Functions 86 | 87 | 88 | u10->u5 89 | 90 | 91 | 92 | 93 | u10->u3 94 | 95 | 96 | 97 | 98 | u10->u2 99 | 100 | 101 | 102 | 103 | u10->u9 104 | 105 | 106 | 107 | 108 | u7 109 | 110 | Internal 111 | 112 | 113 | u3->u7 114 | 115 | 116 | 117 | 118 | u4 119 | 120 | Instances 121 | 122 | 123 | u3->u4 124 | 125 | 126 | 127 | 128 | u2->u3 129 | 130 | 131 | 132 | 133 | u8 134 | 135 | ByteString 136 | 137 | 138 | u2->u8 139 | 140 | 141 | 142 | 143 | u0 144 | 145 | TH 146 | 147 | 148 | u0->u1 149 | 150 | 151 | 152 | 153 | u0->u3 154 | 155 | 156 | 157 | 158 | u8->u3 159 | 160 | 161 | 162 | 163 | u9->u3 164 | 165 | 166 | 167 | 168 | u12 169 | 170 | Generic 171 | 172 | 173 | u12->u7 174 | 175 | 176 | 177 | 178 | u12->u4 179 | 180 | 181 | 182 | 183 | u6 184 | 185 | Class 186 | 187 | 188 | u6->u7 189 | 190 | 191 | 192 | 193 | u4->u5 194 | 195 | 196 | 197 | 198 | u4->u7 199 | 200 | 201 | 202 | 203 | u4->u6 204 | 205 | 206 | 207 | 208 | 209 | -------------------------------------------------------------------------------- /screenshots/aeson1.txt: -------------------------------------------------------------------------------- 1 | find Data -name '*.hs' | xargs graphmod -q > ~/tmp/examples/aeson1.dot 2 | -------------------------------------------------------------------------------- /screenshots/cryptol-1.dot: -------------------------------------------------------------------------------- 1 | digraph G { 2 | size="6,4"; 3 | ratio="fill"; 4 | u0[label="GitRev"]; 5 | subgraph cluster_0 { 6 | label="Cryptol"; 7 | color="#ccffcc"; 8 | style="filled"; 9 | u33[label="Symbolic"]; 10 | u32[label="TypeCheck"]; 11 | u31[label="ModuleSystem"]; 12 | u17[label="Version"]; 13 | u16[label="Eval"]; 14 | subgraph cluster_1 { 15 | label="Eval"; 16 | color="#99ff99"; 17 | style="filled"; 18 | u21[label="Env"]; 19 | u20[label="Type"]; 20 | u19[label="Value"]; 21 | u18[label="Error"]; 22 | 23 | } 24 | subgraph cluster_2 { 25 | label="ModuleSystem"; 26 | color="#99ff99"; 27 | style="filled"; 28 | u13[label="Env"]; 29 | u12[label="Interface"]; 30 | u11[label="Renamer"]; 31 | u10[label="NamingEnv"]; 32 | u9[label="Base"]; 33 | u8[label="Monad"]; 34 | 35 | } 36 | subgraph cluster_3 { 37 | label="Parser"; 38 | color="#99ff99"; 39 | style="filled"; 40 | u30[label="Utils"]; 41 | u29[label="Names"]; 42 | u28[label="NoInclude"]; 43 | u27[label="LexerUtils"]; 44 | u26[label="NoPat"]; 45 | u25[label="AST"]; 46 | u24[label="Position"]; 47 | u23[label="Unlit"]; 48 | u22[label="ParserUtils"]; 49 | 50 | } 51 | subgraph cluster_4 { 52 | label="Prims"; 53 | color="#99ff99"; 54 | style="filled"; 55 | u4[label="Types"]; 56 | u3[label="Doc"]; 57 | u2[label="Eval"]; 58 | u1[label="Syntax"]; 59 | 60 | } 61 | subgraph cluster_5 { 62 | label="Symbolic"; 63 | color="#99ff99"; 64 | style="filled"; 65 | u38[label="BitVector"]; 66 | u37[label="Value"]; 67 | u36[label="Prims"]; 68 | 69 | } 70 | subgraph cluster_6 { 71 | label="Testing"; 72 | color="#99ff99"; 73 | style="filled"; 74 | u35[label="Random"]; 75 | u34[label="Exhaust"]; 76 | 77 | } 78 | subgraph cluster_7 { 79 | label="Transform"; 80 | color="#99ff99"; 81 | style="filled"; 82 | u15[label="Specialize"]; 83 | u14[label="MonoValues"]; 84 | 85 | } 86 | subgraph cluster_8 { 87 | label="TypeCheck"; 88 | color="#99ff99"; 89 | style="filled"; 90 | u63[label="Defaulting"]; 91 | u62[label="Instantiate"]; 92 | u61[label="Unify"]; 93 | u60[label="Subst"]; 94 | u59[label="Depends"]; 95 | u58[label="InferTypes"]; 96 | u57[label="TypeOf"]; 97 | u56[label="Kind"]; 98 | u44[label="AST"]; 99 | u43[label="TypeMap"]; 100 | u42[label="Infer"]; 101 | u41[label="Monad"]; 102 | u40[label="Solve"]; 103 | u39[label="PP"]; 104 | subgraph cluster_9 { 105 | label="Solver"; 106 | color="#66ff66"; 107 | style="filled"; 108 | u55[label="Utils"]; 109 | u54[label="CrySAT"]; 110 | u53[label="Class"]; 111 | u52[label="Numeric"]; 112 | u51[label="Selector"]; 113 | u50[label="CrySAT1"]; 114 | u49[label="Eval"]; 115 | u48[label="Interval"]; 116 | u47[label="InfNat"]; 117 | u46[label="Smtlib"]; 118 | u45[label="FinOrd"]; 119 | 120 | } 121 | 122 | } 123 | subgraph cluster_10 { 124 | label="Utils"; 125 | color="#99ff99"; 126 | style="filled"; 127 | u7[label="Panic"]; 128 | u6[label="Debug"]; 129 | u5[label="PP"]; 130 | 131 | } 132 | 133 | } 134 | u1 -> u5; 135 | u2 -> u20; 136 | u2 -> u35; 137 | u3 -> u4; 138 | u4 -> u44; 139 | u6 -> u5; 140 | u7 -> u17; 141 | u8 -> u11; 142 | u8 -> u13; 143 | u8 -> u26; 144 | u8 -> u28; 145 | u9 -> u8; 146 | u9 -> u14; 147 | u10 -> u12; 148 | u10 -> u29; 149 | u11 -> u10; 150 | u12 -> u44; 151 | u13 -> u10; 152 | u13 -> u16; 153 | u13 -> u32; 154 | u14 -> u43; 155 | u15 -> u31; 156 | u16 -> u2; 157 | u17 -> u0; 158 | u18 -> u44; 159 | u19 -> u18; 160 | u19 -> u47; 161 | u20 -> u21; 162 | u21 -> u19; 163 | u22 -> u7; 164 | u22 -> u30; 165 | u23 -> u7; 166 | u24 -> u5; 167 | u25 -> u1; 168 | u25 -> u24; 169 | u26 -> u7; 170 | u26 -> u25; 171 | u27 -> u23; 172 | u27 -> u24; 173 | u28 -> u22; 174 | u28 -> u27; 175 | u29 -> u25; 176 | u30 -> u25; 177 | u31 -> u9; 178 | u32 -> u42; 179 | u33 -> u31; 180 | u33 -> u36; 181 | u34 -> u19; 182 | u35 -> u19; 183 | u36 -> u2; 184 | u36 -> u37; 185 | u37 -> u19; 186 | u37 -> u38; 187 | u38 -> u7; 188 | u39 -> u5; 189 | u40 -> u46; 190 | u40 -> u51; 191 | u40 -> u53; 192 | u40 -> u54; 193 | u40 -> u63; 194 | u41 -> u58; 195 | u41 -> u61; 196 | u42 -> u4; 197 | u42 -> u56; 198 | u42 -> u59; 199 | u42 -> u62; 200 | u43 -> u44; 201 | u44 -> u7; 202 | u44 -> u25; 203 | u44 -> u39; 204 | u45 -> u43; 205 | u45 -> u48; 206 | u45 -> u58; 207 | u46 -> u45; 208 | u47 -> u7; 209 | u48 -> u47; 210 | u49 -> u45; 211 | u49 -> u55; 212 | u50 -> u47; 213 | u51 -> u41; 214 | u52 -> u49; 215 | u52 -> u61; 216 | u53 -> u58; 217 | u54 -> u7; 218 | u55 -> u44; 219 | u56 -> u40; 220 | u57 -> u4; 221 | u57 -> u60; 222 | u58 -> u60; 223 | u59 -> u29; 224 | u59 -> u41; 225 | u60 -> u44; 226 | u61 -> u60; 227 | u62 -> u41; 228 | u63 -> u52; 229 | 230 | } 231 | 232 | -------------------------------------------------------------------------------- /screenshots/cryptol-1.dot.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/yav/graphmod/983c38f73d3d6d232c954416fd1ab019f24c9fc5/screenshots/cryptol-1.dot.png -------------------------------------------------------------------------------- /screenshots/cryptol-1.txt: -------------------------------------------------------------------------------- 1 | find src -name '*.hs' | xargs graphmod -q -p > ~/tmp/examples/cryptol-1.dot 2 | -------------------------------------------------------------------------------- /screenshots/cryptol-2.dot: -------------------------------------------------------------------------------- 1 | digraph G { 2 | size="6,4"; 3 | ratio="fill"; 4 | u0[fillcolor="#ccffcc",style="filled",label="GitRev"]; 5 | u33[fillcolor="#99ff99",style="filled",label="Cryptol.Symbolic"]; 6 | u32[fillcolor="#99ff99",style="filled",label="Cryptol.TypeCheck"]; 7 | u31[fillcolor="#99ff99",style="filled",label="Cryptol.ModuleSystem"]; 8 | u17[fillcolor="#99ff99",style="filled",label="Cryptol.Version"]; 9 | u16[fillcolor="#99ff99",style="filled",label="Cryptol.Eval"]; 10 | u21[fillcolor="#66ff66",style="filled",label="Cryptol.Eval.Env"]; 11 | u20[fillcolor="#66ff66",style="filled",label="Cryptol.Eval.Type"]; 12 | u19[fillcolor="#66ff66",style="filled",label="Cryptol.Eval.Value"]; 13 | u18[fillcolor="#66ff66",style="filled",label="Cryptol.Eval.Error"]; 14 | u13[fillcolor="#99cc99",style="filled",label="Cryptol.ModuleSystem.Env"]; 15 | u12[fillcolor="#99cc99",style="filled",label="Cryptol.ModuleSystem.Interface"]; 16 | u11[fillcolor="#99cc99",style="filled",label="Cryptol.ModuleSystem.Renamer"]; 17 | u10[fillcolor="#99cc99",style="filled",label="Cryptol.ModuleSystem.NamingEnv"]; 18 | u9[fillcolor="#99cc99",style="filled",label="Cryptol.ModuleSystem.Base"]; 19 | u8[fillcolor="#99cc99",style="filled",label="Cryptol.ModuleSystem.Monad"]; 20 | u30[fillcolor="#66cc66",style="filled",label="Cryptol.Parser.Utils"]; 21 | u29[fillcolor="#66cc66",style="filled",label="Cryptol.Parser.Names"]; 22 | u28[fillcolor="#66cc66",style="filled",label="Cryptol.Parser.NoInclude"]; 23 | u27[fillcolor="#66cc66",style="filled",label="Cryptol.Parser.LexerUtils"]; 24 | u26[fillcolor="#66cc66",style="filled",label="Cryptol.Parser.NoPat"]; 25 | u25[fillcolor="#66cc66",style="filled",label="Cryptol.Parser.AST"]; 26 | u24[fillcolor="#66cc66",style="filled",label="Cryptol.Parser.Position"]; 27 | u23[fillcolor="#66cc66",style="filled",label="Cryptol.Parser.Unlit"]; 28 | u22[fillcolor="#66cc66",style="filled",label="Cryptol.Parser.ParserUtils"]; 29 | u4[fillcolor="#669966",style="filled",label="Cryptol.Prims.Types"]; 30 | u3[fillcolor="#669966",style="filled",label="Cryptol.Prims.Doc"]; 31 | u2[fillcolor="#669966",style="filled",label="Cryptol.Prims.Eval"]; 32 | u1[fillcolor="#669966",style="filled",label="Cryptol.Prims.Syntax"]; 33 | u38[fillcolor="#669999",style="filled",label="Cryptol.Symbolic.BitVector"]; 34 | u37[fillcolor="#669999",style="filled",label="Cryptol.Symbolic.Value"]; 35 | u36[fillcolor="#669999",style="filled",label="Cryptol.Symbolic.Prims"]; 36 | u35[fillcolor="#66cccc",style="filled",label="Cryptol.Testing.Random"]; 37 | u34[fillcolor="#66cccc",style="filled",label="Cryptol.Testing.Exhaust"]; 38 | u15[fillcolor="#66ffff",style="filled",label="Cryptol.Transform.Specialize"]; 39 | u14[fillcolor="#66ffff",style="filled",label="Cryptol.Transform.MonoValues"]; 40 | u63[fillcolor="#99cccc",style="filled",label="Cryptol.TypeCheck.Defaulting"]; 41 | u62[fillcolor="#99cccc",style="filled",label="Cryptol.TypeCheck.Instantiate"]; 42 | u61[fillcolor="#99cccc",style="filled",label="Cryptol.TypeCheck.Unify"]; 43 | u60[fillcolor="#99cccc",style="filled",label="Cryptol.TypeCheck.Subst"]; 44 | u59[fillcolor="#99cccc",style="filled",label="Cryptol.TypeCheck.Depends"]; 45 | u58[fillcolor="#99cccc",style="filled",label="Cryptol.TypeCheck.InferTypes"]; 46 | u57[fillcolor="#99cccc",style="filled",label="Cryptol.TypeCheck.TypeOf"]; 47 | u56[fillcolor="#99cccc",style="filled",label="Cryptol.TypeCheck.Kind"]; 48 | u44[fillcolor="#99cccc",style="filled",label="Cryptol.TypeCheck.AST"]; 49 | u43[fillcolor="#99cccc",style="filled",label="Cryptol.TypeCheck.TypeMap"]; 50 | u42[fillcolor="#99cccc",style="filled",label="Cryptol.TypeCheck.Infer"]; 51 | u41[fillcolor="#99cccc",style="filled",label="Cryptol.TypeCheck.Monad"]; 52 | u40[fillcolor="#99cccc",style="filled",label="Cryptol.TypeCheck.Solve"]; 53 | u39[fillcolor="#99cccc",style="filled",label="Cryptol.TypeCheck.PP"]; 54 | u55[fillcolor="#99ffff",style="filled",label="Cryptol.TypeCheck.Solver.Utils"]; 55 | u54[fillcolor="#99ffff",style="filled",label="Cryptol.TypeCheck.Solver.CrySAT"]; 56 | u53[fillcolor="#99ffff",style="filled",label="Cryptol.TypeCheck.Solver.Class"]; 57 | u52[fillcolor="#99ffff",style="filled",label="Cryptol.TypeCheck.Solver.Numeric"]; 58 | u51[fillcolor="#99ffff",style="filled",label="Cryptol.TypeCheck.Solver.Selector"]; 59 | u50[fillcolor="#99ffff",style="filled",label="Cryptol.TypeCheck.Solver.CrySAT1"]; 60 | u49[fillcolor="#99ffff",style="filled",label="Cryptol.TypeCheck.Solver.Eval"]; 61 | u48[fillcolor="#99ffff",style="filled",label="Cryptol.TypeCheck.Solver.Interval"]; 62 | u47[fillcolor="#99ffff",style="filled",label="Cryptol.TypeCheck.Solver.InfNat"]; 63 | u46[fillcolor="#99ffff",style="filled",label="Cryptol.TypeCheck.Solver.Smtlib"]; 64 | u45[fillcolor="#99ffff",style="filled",label="Cryptol.TypeCheck.Solver.FinOrd"]; 65 | u7[fillcolor="#ccffff",style="filled",label="Cryptol.Utils.Panic"]; 66 | u6[fillcolor="#ccffff",style="filled",label="Cryptol.Utils.Debug"]; 67 | u5[fillcolor="#ccffff",style="filled",label="Cryptol.Utils.PP"]; 68 | u1 -> u5; 69 | u2 -> u20; 70 | u2 -> u35; 71 | u3 -> u4; 72 | u4 -> u44; 73 | u6 -> u5; 74 | u7 -> u17; 75 | u8 -> u11; 76 | u8 -> u13; 77 | u8 -> u26; 78 | u8 -> u28; 79 | u9 -> u8; 80 | u9 -> u14; 81 | u10 -> u12; 82 | u10 -> u29; 83 | u11 -> u10; 84 | u12 -> u44; 85 | u13 -> u10; 86 | u13 -> u16; 87 | u13 -> u32; 88 | u14 -> u43; 89 | u15 -> u31; 90 | u16 -> u2; 91 | u17 -> u0; 92 | u18 -> u44; 93 | u19 -> u18; 94 | u19 -> u47; 95 | u20 -> u21; 96 | u21 -> u19; 97 | u22 -> u7; 98 | u22 -> u30; 99 | u23 -> u7; 100 | u24 -> u5; 101 | u25 -> u1; 102 | u25 -> u24; 103 | u26 -> u7; 104 | u26 -> u25; 105 | u27 -> u23; 106 | u27 -> u24; 107 | u28 -> u22; 108 | u28 -> u27; 109 | u29 -> u25; 110 | u30 -> u25; 111 | u31 -> u9; 112 | u32 -> u42; 113 | u33 -> u31; 114 | u33 -> u36; 115 | u34 -> u19; 116 | u35 -> u19; 117 | u36 -> u2; 118 | u36 -> u37; 119 | u37 -> u19; 120 | u37 -> u38; 121 | u38 -> u7; 122 | u39 -> u5; 123 | u40 -> u46; 124 | u40 -> u51; 125 | u40 -> u53; 126 | u40 -> u54; 127 | u40 -> u63; 128 | u41 -> u58; 129 | u41 -> u61; 130 | u42 -> u4; 131 | u42 -> u56; 132 | u42 -> u59; 133 | u42 -> u62; 134 | u43 -> u44; 135 | u44 -> u7; 136 | u44 -> u25; 137 | u44 -> u39; 138 | u45 -> u43; 139 | u45 -> u48; 140 | u45 -> u58; 141 | u46 -> u45; 142 | u47 -> u7; 143 | u48 -> u47; 144 | u49 -> u45; 145 | u49 -> u55; 146 | u50 -> u47; 147 | u51 -> u41; 148 | u52 -> u49; 149 | u52 -> u61; 150 | u53 -> u58; 151 | u54 -> u7; 152 | u55 -> u44; 153 | u56 -> u40; 154 | u57 -> u4; 155 | u57 -> u60; 156 | u58 -> u60; 157 | u59 -> u29; 158 | u59 -> u41; 159 | u60 -> u44; 160 | u61 -> u60; 161 | u62 -> u41; 162 | u63 -> u52; 163 | 164 | } 165 | 166 | -------------------------------------------------------------------------------- /screenshots/cryptol-2.dot.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/yav/graphmod/983c38f73d3d6d232c954416fd1ab019f24c9fc5/screenshots/cryptol-2.dot.png -------------------------------------------------------------------------------- /screenshots/cryptol-2.dot.svg: -------------------------------------------------------------------------------- 1 | 2 | 4 | 6 | 7 | 9 | 10 | G 11 | 12 | 13 | u0 14 | 15 | GitRev 16 | 17 | 18 | u33 19 | 20 | Cryptol.Symbolic 21 | 22 | 23 | u31 24 | 25 | Cryptol.ModuleSystem 26 | 27 | 28 | u33->u31 29 | 30 | 31 | 32 | 33 | u36 34 | 35 | Cryptol.Symbolic.Prims 36 | 37 | 38 | u33->u36 39 | 40 | 41 | 42 | 43 | u32 44 | 45 | Cryptol.TypeCheck 46 | 47 | 48 | u42 49 | 50 | Cryptol.TypeCheck.Infer 51 | 52 | 53 | u32->u42 54 | 55 | 56 | 57 | 58 | u9 59 | 60 | Cryptol.ModuleSystem.Base 61 | 62 | 63 | u31->u9 64 | 65 | 66 | 67 | 68 | u17 69 | 70 | Cryptol.Version 71 | 72 | 73 | u17->u0 74 | 75 | 76 | 77 | 78 | u16 79 | 80 | Cryptol.Eval 81 | 82 | 83 | u2 84 | 85 | Cryptol.Prims.Eval 86 | 87 | 88 | u16->u2 89 | 90 | 91 | 92 | 93 | u21 94 | 95 | Cryptol.Eval.Env 96 | 97 | 98 | u19 99 | 100 | Cryptol.Eval.Value 101 | 102 | 103 | u21->u19 104 | 105 | 106 | 107 | 108 | u20 109 | 110 | Cryptol.Eval.Type 111 | 112 | 113 | u20->u21 114 | 115 | 116 | 117 | 118 | u18 119 | 120 | Cryptol.Eval.Error 121 | 122 | 123 | u19->u18 124 | 125 | 126 | 127 | 128 | u47 129 | 130 | Cryptol.TypeCheck.Solver.InfNat 131 | 132 | 133 | u19->u47 134 | 135 | 136 | 137 | 138 | u44 139 | 140 | Cryptol.TypeCheck.AST 141 | 142 | 143 | u18->u44 144 | 145 | 146 | 147 | 148 | u13 149 | 150 | Cryptol.ModuleSystem.Env 151 | 152 | 153 | u13->u32 154 | 155 | 156 | 157 | 158 | u13->u16 159 | 160 | 161 | 162 | 163 | u10 164 | 165 | Cryptol.ModuleSystem.NamingEnv 166 | 167 | 168 | u13->u10 169 | 170 | 171 | 172 | 173 | u12 174 | 175 | Cryptol.ModuleSystem.Interface 176 | 177 | 178 | u12->u44 179 | 180 | 181 | 182 | 183 | u11 184 | 185 | Cryptol.ModuleSystem.Renamer 186 | 187 | 188 | u11->u10 189 | 190 | 191 | 192 | 193 | u10->u12 194 | 195 | 196 | 197 | 198 | u29 199 | 200 | Cryptol.Parser.Names 201 | 202 | 203 | u10->u29 204 | 205 | 206 | 207 | 208 | u8 209 | 210 | Cryptol.ModuleSystem.Monad 211 | 212 | 213 | u9->u8 214 | 215 | 216 | 217 | 218 | u14 219 | 220 | Cryptol.Transform.MonoValues 221 | 222 | 223 | u9->u14 224 | 225 | 226 | 227 | 228 | u8->u13 229 | 230 | 231 | 232 | 233 | u8->u11 234 | 235 | 236 | 237 | 238 | u28 239 | 240 | Cryptol.Parser.NoInclude 241 | 242 | 243 | u8->u28 244 | 245 | 246 | 247 | 248 | u26 249 | 250 | Cryptol.Parser.NoPat 251 | 252 | 253 | u8->u26 254 | 255 | 256 | 257 | 258 | u30 259 | 260 | Cryptol.Parser.Utils 261 | 262 | 263 | u25 264 | 265 | Cryptol.Parser.AST 266 | 267 | 268 | u30->u25 269 | 270 | 271 | 272 | 273 | u29->u25 274 | 275 | 276 | 277 | 278 | u27 279 | 280 | Cryptol.Parser.LexerUtils 281 | 282 | 283 | u28->u27 284 | 285 | 286 | 287 | 288 | u22 289 | 290 | Cryptol.Parser.ParserUtils 291 | 292 | 293 | u28->u22 294 | 295 | 296 | 297 | 298 | u24 299 | 300 | Cryptol.Parser.Position 301 | 302 | 303 | u27->u24 304 | 305 | 306 | 307 | 308 | u23 309 | 310 | Cryptol.Parser.Unlit 311 | 312 | 313 | u27->u23 314 | 315 | 316 | 317 | 318 | u26->u25 319 | 320 | 321 | 322 | 323 | u7 324 | 325 | Cryptol.Utils.Panic 326 | 327 | 328 | u26->u7 329 | 330 | 331 | 332 | 333 | u25->u24 334 | 335 | 336 | 337 | 338 | u1 339 | 340 | Cryptol.Prims.Syntax 341 | 342 | 343 | u25->u1 344 | 345 | 346 | 347 | 348 | u5 349 | 350 | Cryptol.Utils.PP 351 | 352 | 353 | u24->u5 354 | 355 | 356 | 357 | 358 | u23->u7 359 | 360 | 361 | 362 | 363 | u22->u30 364 | 365 | 366 | 367 | 368 | u22->u7 369 | 370 | 371 | 372 | 373 | u4 374 | 375 | Cryptol.Prims.Types 376 | 377 | 378 | u4->u44 379 | 380 | 381 | 382 | 383 | u3 384 | 385 | Cryptol.Prims.Doc 386 | 387 | 388 | u3->u4 389 | 390 | 391 | 392 | 393 | u2->u20 394 | 395 | 396 | 397 | 398 | u35 399 | 400 | Cryptol.Testing.Random 401 | 402 | 403 | u2->u35 404 | 405 | 406 | 407 | 408 | u1->u5 409 | 410 | 411 | 412 | 413 | u38 414 | 415 | Cryptol.Symbolic.BitVector 416 | 417 | 418 | u38->u7 419 | 420 | 421 | 422 | 423 | u37 424 | 425 | Cryptol.Symbolic.Value 426 | 427 | 428 | u37->u19 429 | 430 | 431 | 432 | 433 | u37->u38 434 | 435 | 436 | 437 | 438 | u36->u2 439 | 440 | 441 | 442 | 443 | u36->u37 444 | 445 | 446 | 447 | 448 | u35->u19 449 | 450 | 451 | 452 | 453 | u34 454 | 455 | Cryptol.Testing.Exhaust 456 | 457 | 458 | u34->u19 459 | 460 | 461 | 462 | 463 | u15 464 | 465 | Cryptol.Transform.Specialize 466 | 467 | 468 | u15->u31 469 | 470 | 471 | 472 | 473 | u43 474 | 475 | Cryptol.TypeCheck.TypeMap 476 | 477 | 478 | u14->u43 479 | 480 | 481 | 482 | 483 | u63 484 | 485 | Cryptol.TypeCheck.Defaulting 486 | 487 | 488 | u52 489 | 490 | Cryptol.TypeCheck.Solver.Numeric 491 | 492 | 493 | u63->u52 494 | 495 | 496 | 497 | 498 | u62 499 | 500 | Cryptol.TypeCheck.Instantiate 501 | 502 | 503 | u41 504 | 505 | Cryptol.TypeCheck.Monad 506 | 507 | 508 | u62->u41 509 | 510 | 511 | 512 | 513 | u61 514 | 515 | Cryptol.TypeCheck.Unify 516 | 517 | 518 | u60 519 | 520 | Cryptol.TypeCheck.Subst 521 | 522 | 523 | u61->u60 524 | 525 | 526 | 527 | 528 | u60->u44 529 | 530 | 531 | 532 | 533 | u59 534 | 535 | Cryptol.TypeCheck.Depends 536 | 537 | 538 | u59->u29 539 | 540 | 541 | 542 | 543 | u59->u41 544 | 545 | 546 | 547 | 548 | u58 549 | 550 | Cryptol.TypeCheck.InferTypes 551 | 552 | 553 | u58->u60 554 | 555 | 556 | 557 | 558 | u57 559 | 560 | Cryptol.TypeCheck.TypeOf 561 | 562 | 563 | u57->u4 564 | 565 | 566 | 567 | 568 | u57->u60 569 | 570 | 571 | 572 | 573 | u56 574 | 575 | Cryptol.TypeCheck.Kind 576 | 577 | 578 | u40 579 | 580 | Cryptol.TypeCheck.Solve 581 | 582 | 583 | u56->u40 584 | 585 | 586 | 587 | 588 | u44->u25 589 | 590 | 591 | 592 | 593 | u39 594 | 595 | Cryptol.TypeCheck.PP 596 | 597 | 598 | u44->u39 599 | 600 | 601 | 602 | 603 | u44->u7 604 | 605 | 606 | 607 | 608 | u43->u44 609 | 610 | 611 | 612 | 613 | u42->u4 614 | 615 | 616 | 617 | 618 | u42->u62 619 | 620 | 621 | 622 | 623 | u42->u59 624 | 625 | 626 | 627 | 628 | u42->u56 629 | 630 | 631 | 632 | 633 | u41->u61 634 | 635 | 636 | 637 | 638 | u41->u58 639 | 640 | 641 | 642 | 643 | u40->u63 644 | 645 | 646 | 647 | 648 | u54 649 | 650 | Cryptol.TypeCheck.Solver.CrySAT 651 | 652 | 653 | u40->u54 654 | 655 | 656 | 657 | 658 | u53 659 | 660 | Cryptol.TypeCheck.Solver.Class 661 | 662 | 663 | u40->u53 664 | 665 | 666 | 667 | 668 | u51 669 | 670 | Cryptol.TypeCheck.Solver.Selector 671 | 672 | 673 | u40->u51 674 | 675 | 676 | 677 | 678 | u46 679 | 680 | Cryptol.TypeCheck.Solver.Smtlib 681 | 682 | 683 | u40->u46 684 | 685 | 686 | 687 | 688 | u39->u5 689 | 690 | 691 | 692 | 693 | u55 694 | 695 | Cryptol.TypeCheck.Solver.Utils 696 | 697 | 698 | u55->u44 699 | 700 | 701 | 702 | 703 | u54->u7 704 | 705 | 706 | 707 | 708 | u53->u58 709 | 710 | 711 | 712 | 713 | u52->u61 714 | 715 | 716 | 717 | 718 | u49 719 | 720 | Cryptol.TypeCheck.Solver.Eval 721 | 722 | 723 | u52->u49 724 | 725 | 726 | 727 | 728 | u51->u41 729 | 730 | 731 | 732 | 733 | u50 734 | 735 | Cryptol.TypeCheck.Solver.CrySAT1 736 | 737 | 738 | u50->u47 739 | 740 | 741 | 742 | 743 | u49->u55 744 | 745 | 746 | 747 | 748 | u45 749 | 750 | Cryptol.TypeCheck.Solver.FinOrd 751 | 752 | 753 | u49->u45 754 | 755 | 756 | 757 | 758 | u48 759 | 760 | Cryptol.TypeCheck.Solver.Interval 761 | 762 | 763 | u48->u47 764 | 765 | 766 | 767 | 768 | u47->u7 769 | 770 | 771 | 772 | 773 | u46->u45 774 | 775 | 776 | 777 | 778 | u45->u58 779 | 780 | 781 | 782 | 783 | u45->u43 784 | 785 | 786 | 787 | 788 | u45->u48 789 | 790 | 791 | 792 | 793 | u7->u17 794 | 795 | 796 | 797 | 798 | u6 799 | 800 | Cryptol.Utils.Debug 801 | 802 | 803 | u6->u5 804 | 805 | 806 | 807 | 808 | 809 | -------------------------------------------------------------------------------- /screenshots/cryptol-2.txt: -------------------------------------------------------------------------------- 1 | find src -name '*.hs' | xargs graphmod -q -p --no-cluster > ~/tmp/examples/cryptol-2.dot 2 | -------------------------------------------------------------------------------- /screenshots/ghc-typechecker.dot: -------------------------------------------------------------------------------- 1 | digraph G { 2 | size="6,4"; 3 | ratio="fill"; 4 | u36[label="TcDeriv"]; 5 | u35[label="TcInstDcls"]; 6 | u34[label="TcForeign"]; 7 | u33[label="TcAnnotations"]; 8 | u32[label="TcRnDriver"]; 9 | u31[label="TcGenDeriv"]; 10 | u30[label="TcGenGenerics"]; 11 | u29[label="TcClassDcl"]; 12 | u28[label="TcTyDecls"]; 13 | u27[label="TcTyClsDecls"]; 14 | u26[label="TcRules"]; 15 | u25[label="TcArrows"]; 16 | u24[label="FunDeps"]; 17 | u23[label="TcCanonical"]; 18 | u22[label="TcInteract"]; 19 | u21[label="FamInst"]; 20 | u20[label="TcSMonad"]; 21 | u19[label="TcErrors"]; 22 | u18[label="TcSimplify"]; 23 | u17[label="TcPatSyn"]; 24 | u16[label="TcPat"]; 25 | u15[label="TcMatches"]; 26 | u14[label="TcBinds"]; 27 | u13[label="TcHsSyn"]; 28 | u12[label="TcSplice"]; 29 | u11[label="TcExpr"]; 30 | u10[label="Inst"]; 31 | u9[label="TcUnify"]; 32 | u8[label="TcValidity"]; 33 | u7[label="TcHsType"]; 34 | u6[label="TcMType"]; 35 | u5[label="TcEnv"]; 36 | u4[label="TcType"]; 37 | u3[label="TcEvidence"]; 38 | u2[label="TcRnTypes"]; 39 | u1[label="TcRnMonad"]; 40 | u0[label="TcDefaults"]; 41 | u0 -> u18; 42 | u1 -> u2; 43 | u2 -> u3; 44 | u3 -> u4; 45 | u5 -> u6; 46 | u6 -> u1; 47 | u7 -> u9; 48 | u8 -> u18; 49 | u9 -> u10; 50 | u10 -> u11; 51 | u11 -> u25; 52 | u12 -> u1; 53 | u13 -> u6; 54 | u14 -> u18; 55 | u15 -> u16; 56 | u16 -> u11; 57 | u17 -> u18; 58 | u18 -> u22; 59 | u19 -> u10; 60 | u20 -> u10; 61 | u21 -> u6; 62 | u22 -> u23; 63 | u23 -> u20; 64 | u25 -> u16; 65 | u26 -> u18; 66 | u27 -> u28; 67 | u27 -> u29; 68 | u29 -> u16; 69 | u30 -> u21; 70 | u30 -> u31; 71 | u31 -> u5; 72 | u32 -> u0; 73 | u32 -> u26; 74 | u32 -> u33; 75 | u32 -> u34; 76 | u32 -> u35; 77 | u33 -> u1; 78 | u34 -> u11; 79 | u35 -> u36; 80 | u36 -> u27; 81 | u36 -> u30; 82 | 83 | } 84 | 85 | -------------------------------------------------------------------------------- /screenshots/ghc-typechecker.dot.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/yav/graphmod/983c38f73d3d6d232c954416fd1ab019f24c9fc5/screenshots/ghc-typechecker.dot.png -------------------------------------------------------------------------------- /screenshots/ghc-typechecker.dot.svg: -------------------------------------------------------------------------------- 1 | 2 | 4 | 6 | 7 | 9 | 10 | G 11 | 12 | 13 | u36 14 | 15 | TcDeriv 16 | 17 | 18 | u30 19 | 20 | TcGenGenerics 21 | 22 | 23 | u36->u30 24 | 25 | 26 | 27 | 28 | u27 29 | 30 | TcTyClsDecls 31 | 32 | 33 | u36->u27 34 | 35 | 36 | 37 | 38 | u35 39 | 40 | TcInstDcls 41 | 42 | 43 | u35->u36 44 | 45 | 46 | 47 | 48 | u34 49 | 50 | TcForeign 51 | 52 | 53 | u11 54 | 55 | TcExpr 56 | 57 | 58 | u34->u11 59 | 60 | 61 | 62 | 63 | u33 64 | 65 | TcAnnotations 66 | 67 | 68 | u1 69 | 70 | TcRnMonad 71 | 72 | 73 | u33->u1 74 | 75 | 76 | 77 | 78 | u32 79 | 80 | TcRnDriver 81 | 82 | 83 | u32->u35 84 | 85 | 86 | 87 | 88 | u32->u34 89 | 90 | 91 | 92 | 93 | u32->u33 94 | 95 | 96 | 97 | 98 | u26 99 | 100 | TcRules 101 | 102 | 103 | u32->u26 104 | 105 | 106 | 107 | 108 | u0 109 | 110 | TcDefaults 111 | 112 | 113 | u32->u0 114 | 115 | 116 | 117 | 118 | u31 119 | 120 | TcGenDeriv 121 | 122 | 123 | u5 124 | 125 | TcEnv 126 | 127 | 128 | u31->u5 129 | 130 | 131 | 132 | 133 | u30->u31 134 | 135 | 136 | 137 | 138 | u21 139 | 140 | FamInst 141 | 142 | 143 | u30->u21 144 | 145 | 146 | 147 | 148 | u29 149 | 150 | TcClassDcl 151 | 152 | 153 | u16 154 | 155 | TcPat 156 | 157 | 158 | u29->u16 159 | 160 | 161 | 162 | 163 | u28 164 | 165 | TcTyDecls 166 | 167 | 168 | u27->u29 169 | 170 | 171 | 172 | 173 | u27->u28 174 | 175 | 176 | 177 | 178 | u18 179 | 180 | TcSimplify 181 | 182 | 183 | u26->u18 184 | 185 | 186 | 187 | 188 | u25 189 | 190 | TcArrows 191 | 192 | 193 | u25->u16 194 | 195 | 196 | 197 | 198 | u24 199 | 200 | FunDeps 201 | 202 | 203 | u23 204 | 205 | TcCanonical 206 | 207 | 208 | u20 209 | 210 | TcSMonad 211 | 212 | 213 | u23->u20 214 | 215 | 216 | 217 | 218 | u22 219 | 220 | TcInteract 221 | 222 | 223 | u22->u23 224 | 225 | 226 | 227 | 228 | u6 229 | 230 | TcMType 231 | 232 | 233 | u21->u6 234 | 235 | 236 | 237 | 238 | u10 239 | 240 | Inst 241 | 242 | 243 | u20->u10 244 | 245 | 246 | 247 | 248 | u19 249 | 250 | TcErrors 251 | 252 | 253 | u19->u10 254 | 255 | 256 | 257 | 258 | u18->u22 259 | 260 | 261 | 262 | 263 | u17 264 | 265 | TcPatSyn 266 | 267 | 268 | u17->u18 269 | 270 | 271 | 272 | 273 | u16->u11 274 | 275 | 276 | 277 | 278 | u15 279 | 280 | TcMatches 281 | 282 | 283 | u15->u16 284 | 285 | 286 | 287 | 288 | u14 289 | 290 | TcBinds 291 | 292 | 293 | u14->u18 294 | 295 | 296 | 297 | 298 | u13 299 | 300 | TcHsSyn 301 | 302 | 303 | u13->u6 304 | 305 | 306 | 307 | 308 | u12 309 | 310 | TcSplice 311 | 312 | 313 | u12->u1 314 | 315 | 316 | 317 | 318 | u11->u25 319 | 320 | 321 | 322 | 323 | u10->u11 324 | 325 | 326 | 327 | 328 | u9 329 | 330 | TcUnify 331 | 332 | 333 | u9->u10 334 | 335 | 336 | 337 | 338 | u8 339 | 340 | TcValidity 341 | 342 | 343 | u8->u18 344 | 345 | 346 | 347 | 348 | u7 349 | 350 | TcHsType 351 | 352 | 353 | u7->u9 354 | 355 | 356 | 357 | 358 | u6->u1 359 | 360 | 361 | 362 | 363 | u5->u6 364 | 365 | 366 | 367 | 368 | u4 369 | 370 | TcType 371 | 372 | 373 | u3 374 | 375 | TcEvidence 376 | 377 | 378 | u3->u4 379 | 380 | 381 | 382 | 383 | u2 384 | 385 | TcRnTypes 386 | 387 | 388 | u2->u3 389 | 390 | 391 | 392 | 393 | u1->u2 394 | 395 | 396 | 397 | 398 | u0->u18 399 | 400 | 401 | 402 | 403 | 404 | -------------------------------------------------------------------------------- /screenshots/ghc-typechecker.txt: -------------------------------------------------------------------------------- 1 | find . -name '*.lhs' | xargs graphmod -q -p > ~/tmp/examples/ghc-typechecker.dot 2 | -------------------------------------------------------------------------------- /screenshots/lens-1.dot: -------------------------------------------------------------------------------- 1 | digraph G { 2 | size="6,4"; 3 | ratio="fill"; 4 | subgraph cluster_0 { 5 | label="Codec"; 6 | color="#ccffcc"; 7 | style="filled"; 8 | subgraph cluster_1 { 9 | label="Compression"; 10 | color="#99ff99"; 11 | style="filled"; 12 | subgraph cluster_2 { 13 | label="Zlib"; 14 | color="#66ff66"; 15 | style="filled"; 16 | u29[label="Lens"]; 17 | 18 | } 19 | 20 | } 21 | 22 | } 23 | subgraph cluster_3 { 24 | label="Control"; 25 | color="#ccffcc"; 26 | style="filled"; 27 | u84[label="Lens"]; 28 | subgraph cluster_4 { 29 | label="Exception"; 30 | color="#99ff99"; 31 | style="filled"; 32 | u30[label="Lens"]; 33 | 34 | } 35 | subgraph cluster_5 { 36 | label="Lens"; 37 | color="#99ff99"; 38 | style="filled"; 39 | u79[label="Setter"]; 40 | u78[label="Indexed"]; 41 | u77[label="Lens"]; 42 | u76[label="At"]; 43 | u75[label="Iso"]; 44 | u74[label="Fold"]; 45 | u73[label="Tuple"]; 46 | u72[label="Action"]; 47 | u71[label="Extras"]; 48 | u70[label="Review"]; 49 | u48[label="Each"]; 50 | u47[label="Equality"]; 51 | u46[label="Type"]; 52 | u45[label="Combinators"]; 53 | u44[label="Loupe"]; 54 | u43[label="Wrapped"]; 55 | u42[label="Level"]; 56 | u41[label="Reified"]; 57 | u40[label="Prism"]; 58 | u39[label="Internal"]; 59 | u38[label="Operators"]; 60 | u37[label="Empty"]; 61 | u36[label="Traversal"]; 62 | u35[label="TH"]; 63 | u34[label="Plated"]; 64 | u33[label="Cons"]; 65 | u32[label="Zoom"]; 66 | u31[label="Getter"]; 67 | subgraph cluster_6 { 68 | label="Internal"; 69 | color="#66ff66"; 70 | style="filled"; 71 | u69[label="Setter"]; 72 | u68[label="Bazaar"]; 73 | u67[label="Indexed"]; 74 | u66[label="Iso"]; 75 | u65[label="Fold"]; 76 | u64[label="Reflection"]; 77 | u63[label="Action"]; 78 | u62[label="Deque"]; 79 | u61[label="Instances"]; 80 | u60[label="Magma"]; 81 | u59[label="Review"]; 82 | u58[label="Context"]; 83 | u57[label="Exception"]; 84 | u56[label="PrismTH"]; 85 | u55[label="FieldTH"]; 86 | u54[label="Level"]; 87 | u53[label="Prism"]; 88 | u52[label="TH"]; 89 | u51[label="ByteString"]; 90 | u50[label="Zoom"]; 91 | u49[label="Getter"]; 92 | 93 | } 94 | 95 | } 96 | subgraph cluster_7 { 97 | label="Monad"; 98 | color="#99ff99"; 99 | style="filled"; 100 | subgraph cluster_8 { 101 | label="Error"; 102 | color="#66ff66"; 103 | style="filled"; 104 | u82[label="Lens"]; 105 | 106 | } 107 | subgraph cluster_9 { 108 | label="Primitive"; 109 | color="#66ff66"; 110 | style="filled"; 111 | u81[label="Lens"]; 112 | 113 | } 114 | 115 | } 116 | subgraph cluster_10 { 117 | label="Parallel"; 118 | color="#99ff99"; 119 | style="filled"; 120 | subgraph cluster_11 { 121 | label="Strategies"; 122 | color="#66ff66"; 123 | style="filled"; 124 | u80[label="Lens"]; 125 | 126 | } 127 | 128 | } 129 | subgraph cluster_12 { 130 | label="Seq"; 131 | color="#99ff99"; 132 | style="filled"; 133 | u83[label="Lens"]; 134 | 135 | } 136 | 137 | } 138 | subgraph cluster_13 { 139 | label="Data"; 140 | color="#ccffcc"; 141 | style="filled"; 142 | subgraph cluster_14 { 143 | label="Array"; 144 | color="#99ff99"; 145 | style="filled"; 146 | u23[label="Lens"]; 147 | 148 | } 149 | subgraph cluster_15 { 150 | label="Bits"; 151 | color="#99ff99"; 152 | style="filled"; 153 | u11[label="Lens"]; 154 | 155 | } 156 | subgraph cluster_16 { 157 | label="ByteString"; 158 | color="#99ff99"; 159 | style="filled"; 160 | u22[label="Lens"]; 161 | subgraph cluster_17 { 162 | label="Lazy"; 163 | color="#66ff66"; 164 | style="filled"; 165 | u21[label="Lens"]; 166 | 167 | } 168 | subgraph cluster_18 { 169 | label="Strict"; 170 | color="#66ff66"; 171 | style="filled"; 172 | u20[label="Lens"]; 173 | 174 | } 175 | 176 | } 177 | subgraph cluster_19 { 178 | label="Complex"; 179 | color="#99ff99"; 180 | style="filled"; 181 | u12[label="Lens"]; 182 | 183 | } 184 | subgraph cluster_20 { 185 | label="Data"; 186 | color="#99ff99"; 187 | style="filled"; 188 | u5[label="Lens"]; 189 | 190 | } 191 | subgraph cluster_21 { 192 | label="Dynamic"; 193 | color="#99ff99"; 194 | style="filled"; 195 | u15[label="Lens"]; 196 | 197 | } 198 | subgraph cluster_22 { 199 | label="HashSet"; 200 | color="#99ff99"; 201 | style="filled"; 202 | u14[label="Lens"]; 203 | 204 | } 205 | subgraph cluster_23 { 206 | label="IntSet"; 207 | color="#99ff99"; 208 | style="filled"; 209 | u24[label="Lens"]; 210 | 211 | } 212 | subgraph cluster_24 { 213 | label="List"; 214 | color="#99ff99"; 215 | style="filled"; 216 | u4[label="Lens"]; 217 | subgraph cluster_25 { 218 | label="Split"; 219 | color="#66ff66"; 220 | style="filled"; 221 | u3[label="Lens"]; 222 | 223 | } 224 | 225 | } 226 | subgraph cluster_26 { 227 | label="Map"; 228 | color="#99ff99"; 229 | style="filled"; 230 | u16[label="Lens"]; 231 | 232 | } 233 | subgraph cluster_27 { 234 | label="Sequence"; 235 | color="#99ff99"; 236 | style="filled"; 237 | u13[label="Lens"]; 238 | 239 | } 240 | subgraph cluster_28 { 241 | label="Set"; 242 | color="#99ff99"; 243 | style="filled"; 244 | u17[label="Lens"]; 245 | 246 | } 247 | subgraph cluster_29 { 248 | label="Text"; 249 | color="#99ff99"; 250 | style="filled"; 251 | u10[label="Lens"]; 252 | subgraph cluster_30 { 253 | label="Lazy"; 254 | color="#66ff66"; 255 | style="filled"; 256 | u9[label="Lens"]; 257 | 258 | } 259 | subgraph cluster_31 { 260 | label="Strict"; 261 | color="#66ff66"; 262 | style="filled"; 263 | u8[label="Lens"]; 264 | 265 | } 266 | 267 | } 268 | subgraph cluster_32 { 269 | label="Tree"; 270 | color="#99ff99"; 271 | style="filled"; 272 | u19[label="Lens"]; 273 | 274 | } 275 | subgraph cluster_33 { 276 | label="Typeable"; 277 | color="#99ff99"; 278 | style="filled"; 279 | u18[label="Lens"]; 280 | 281 | } 282 | subgraph cluster_34 { 283 | label="Vector"; 284 | color="#99ff99"; 285 | style="filled"; 286 | u7[label="Lens"]; 287 | subgraph cluster_35 { 288 | label="Generic"; 289 | color="#66ff66"; 290 | style="filled"; 291 | u6[label="Lens"]; 292 | 293 | } 294 | 295 | } 296 | 297 | } 298 | subgraph cluster_36 { 299 | label="GHC"; 300 | color="#ccffcc"; 301 | style="filled"; 302 | subgraph cluster_37 { 303 | label="Generics"; 304 | color="#99ff99"; 305 | style="filled"; 306 | u0[label="Lens"]; 307 | 308 | } 309 | 310 | } 311 | subgraph cluster_38 { 312 | label="Generics"; 313 | color="#ccffcc"; 314 | style="filled"; 315 | subgraph cluster_39 { 316 | label="Deriving"; 317 | color="#99ff99"; 318 | style="filled"; 319 | u1[label="Lens"]; 320 | 321 | } 322 | 323 | } 324 | subgraph cluster_40 { 325 | label="Language"; 326 | color="#ccffcc"; 327 | style="filled"; 328 | subgraph cluster_41 { 329 | label="Haskell"; 330 | color="#99ff99"; 331 | style="filled"; 332 | subgraph cluster_42 { 333 | label="TH"; 334 | color="#66ff66"; 335 | style="filled"; 336 | u25[label="Lens"]; 337 | 338 | } 339 | 340 | } 341 | 342 | } 343 | subgraph cluster_43 { 344 | label="Numeric"; 345 | color="#ccffcc"; 346 | style="filled"; 347 | u2[label="Lens"]; 348 | 349 | } 350 | subgraph cluster_44 { 351 | label="System"; 352 | color="#ccffcc"; 353 | style="filled"; 354 | subgraph cluster_45 { 355 | label="Exit"; 356 | color="#99ff99"; 357 | style="filled"; 358 | u28[label="Lens"]; 359 | 360 | } 361 | subgraph cluster_46 { 362 | label="FilePath"; 363 | color="#99ff99"; 364 | style="filled"; 365 | u27[label="Lens"]; 366 | 367 | } 368 | subgraph cluster_47 { 369 | label="IO"; 370 | color="#99ff99"; 371 | style="filled"; 372 | subgraph cluster_48 { 373 | label="Error"; 374 | color="#66ff66"; 375 | style="filled"; 376 | u26[label="Lens"]; 377 | 378 | } 379 | 380 | } 381 | 382 | } 383 | u0 -> u1; 384 | u1 -> u84; 385 | u2 -> u84; 386 | u3 -> u84; 387 | u4 -> u84; 388 | u5 -> u36; 389 | u5 -> u79; 390 | u6 -> u84; 391 | u7 -> u84; 392 | u8 -> u84; 393 | u9 -> u84; 394 | u10 -> u8; 395 | u10 -> u9; 396 | u11 -> u84; 397 | u12 -> u84; 398 | u13 -> u84; 399 | u14 -> u31; 400 | u14 -> u79; 401 | u15 -> u30; 402 | u17 -> u31; 403 | u17 -> u79; 404 | u18 -> u84; 405 | u19 -> u84; 406 | u20 -> u51; 407 | u21 -> u51; 408 | u22 -> u20; 409 | u22 -> u21; 410 | u23 -> u84; 411 | u24 -> u84; 412 | u25 -> u17; 413 | u25 -> u73; 414 | u25 -> u76; 415 | u26 -> u84; 416 | u27 -> u84; 417 | u28 -> u30; 418 | u29 -> u84; 419 | u30 -> u57; 420 | u30 -> u84; 421 | u31 -> u46; 422 | u31 -> u49; 423 | u32 -> u31; 424 | u32 -> u50; 425 | u33 -> u40; 426 | u33 -> u47; 427 | u33 -> u73; 428 | u33 -> u74; 429 | u34 -> u5; 430 | u34 -> u78; 431 | u35 -> u55; 432 | u35 -> u56; 433 | u36 -> u74; 434 | u36 -> u77; 435 | u37 -> u75; 436 | u38 -> u84; 437 | u39 -> u50; 438 | u39 -> u53; 439 | u39 -> u54; 440 | u39 -> u59; 441 | u39 -> u60; 442 | u39 -> u65; 443 | u39 -> u66; 444 | u39 -> u69; 445 | u40 -> u53; 446 | u40 -> u70; 447 | u40 -> u77; 448 | u41 -> u36; 449 | u41 -> u72; 450 | u42 -> u36; 451 | u42 -> u54; 452 | u43 -> u75; 453 | u44 -> u77; 454 | u45 -> u84; 455 | u46 -> u63; 456 | u46 -> u67; 457 | u46 -> u69; 458 | u47 -> u46; 459 | u48 -> u36; 460 | u48 -> u75; 461 | u49 -> u63; 462 | u50 -> u63; 463 | u51 -> u84; 464 | u55 -> u25; 465 | u55 -> u34; 466 | u55 -> u52; 467 | u56 -> u25; 468 | u56 -> u52; 469 | u57 -> u64; 470 | u57 -> u74; 471 | u58 -> u67; 472 | u60 -> u68; 473 | u62 -> u33; 474 | u62 -> u75; 475 | u62 -> u78; 476 | u65 -> u49; 477 | u67 -> u61; 478 | u68 -> u58; 479 | u70 -> u31; 480 | u70 -> u59; 481 | u71 -> u84; 482 | u72 -> u46; 483 | u72 -> u65; 484 | u73 -> u77; 485 | u74 -> u31; 486 | u74 -> u60; 487 | u74 -> u65; 488 | u75 -> u40; 489 | u75 -> u47; 490 | u75 -> u66; 491 | u75 -> u74; 492 | u76 -> u48; 493 | u76 -> u79; 494 | u77 -> u46; 495 | u77 -> u49; 496 | u77 -> u58; 497 | u78 -> u36; 498 | u78 -> u54; 499 | u78 -> u79; 500 | u79 -> u46; 501 | u80 -> u84; 502 | u81 -> u84; 503 | u82 -> u57; 504 | u82 -> u84; 505 | u83 -> u84; 506 | u84 -> u32; 507 | u84 -> u33; 508 | u84 -> u34; 509 | u84 -> u37; 510 | u84 -> u41; 511 | u84 -> u42; 512 | u84 -> u43; 513 | u84 -> u44; 514 | u84 -> u76; 515 | 516 | } 517 | 518 | -------------------------------------------------------------------------------- /screenshots/lens-1.dot.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/yav/graphmod/983c38f73d3d6d232c954416fd1ab019f24c9fc5/screenshots/lens-1.dot.png -------------------------------------------------------------------------------- /screenshots/lens-1.txt: -------------------------------------------------------------------------------- 1 | find src -name '*.hs' | xargs graphmod -q -p > ~/tmp/examples/lens-1.dot 2 | -------------------------------------------------------------------------------- /screenshots/lens-2.dot: -------------------------------------------------------------------------------- 1 | digraph G { 2 | size="6,4"; 3 | ratio="fill"; 4 | u29[fillcolor="#ccffcc",style="filled",label="Codec.Compression.Zlib.Lens"]; 5 | u84[fillcolor="#99ff99",style="filled",label="Control.Lens"]; 6 | u30[fillcolor="#66ff66",style="filled",label="Control.Exception.Lens"]; 7 | u79[fillcolor="#99cc99",style="filled",label="Control.Lens.Setter"]; 8 | u78[fillcolor="#99cc99",style="filled",label="Control.Lens.Indexed"]; 9 | u77[fillcolor="#99cc99",style="filled",label="Control.Lens.Lens"]; 10 | u76[fillcolor="#99cc99",style="filled",label="Control.Lens.At"]; 11 | u75[fillcolor="#99cc99",style="filled",label="Control.Lens.Iso"]; 12 | u74[fillcolor="#99cc99",style="filled",label="Control.Lens.Fold"]; 13 | u73[fillcolor="#99cc99",style="filled",label="Control.Lens.Tuple"]; 14 | u72[fillcolor="#99cc99",style="filled",label="Control.Lens.Action"]; 15 | u71[fillcolor="#99cc99",style="filled",label="Control.Lens.Extras"]; 16 | u70[fillcolor="#99cc99",style="filled",label="Control.Lens.Review"]; 17 | u48[fillcolor="#99cc99",style="filled",label="Control.Lens.Each"]; 18 | u47[fillcolor="#99cc99",style="filled",label="Control.Lens.Equality"]; 19 | u46[fillcolor="#99cc99",style="filled",label="Control.Lens.Type"]; 20 | u45[fillcolor="#99cc99",style="filled",label="Control.Lens.Combinators"]; 21 | u44[fillcolor="#99cc99",style="filled",label="Control.Lens.Loupe"]; 22 | u43[fillcolor="#99cc99",style="filled",label="Control.Lens.Wrapped"]; 23 | u42[fillcolor="#99cc99",style="filled",label="Control.Lens.Level"]; 24 | u41[fillcolor="#99cc99",style="filled",label="Control.Lens.Reified"]; 25 | u40[fillcolor="#99cc99",style="filled",label="Control.Lens.Prism"]; 26 | u39[fillcolor="#99cc99",style="filled",label="Control.Lens.Internal"]; 27 | u38[fillcolor="#99cc99",style="filled",label="Control.Lens.Operators"]; 28 | u37[fillcolor="#99cc99",style="filled",label="Control.Lens.Empty"]; 29 | u36[fillcolor="#99cc99",style="filled",label="Control.Lens.Traversal"]; 30 | u35[fillcolor="#99cc99",style="filled",label="Control.Lens.TH"]; 31 | u34[fillcolor="#99cc99",style="filled",label="Control.Lens.Plated"]; 32 | u33[fillcolor="#99cc99",style="filled",label="Control.Lens.Cons"]; 33 | u32[fillcolor="#99cc99",style="filled",label="Control.Lens.Zoom"]; 34 | u31[fillcolor="#99cc99",style="filled",label="Control.Lens.Getter"]; 35 | u69[fillcolor="#66cc66",style="filled",label="Control.Lens.Internal.Setter"]; 36 | u68[fillcolor="#66cc66",style="filled",label="Control.Lens.Internal.Bazaar"]; 37 | u67[fillcolor="#66cc66",style="filled",label="Control.Lens.Internal.Indexed"]; 38 | u66[fillcolor="#66cc66",style="filled",label="Control.Lens.Internal.Iso"]; 39 | u65[fillcolor="#66cc66",style="filled",label="Control.Lens.Internal.Fold"]; 40 | u64[fillcolor="#66cc66",style="filled",label="Control.Lens.Internal.Reflection"]; 41 | u63[fillcolor="#66cc66",style="filled",label="Control.Lens.Internal.Action"]; 42 | u62[fillcolor="#66cc66",style="filled",label="Control.Lens.Internal.Deque"]; 43 | u61[fillcolor="#66cc66",style="filled",label="Control.Lens.Internal.Instances"]; 44 | u60[fillcolor="#66cc66",style="filled",label="Control.Lens.Internal.Magma"]; 45 | u59[fillcolor="#66cc66",style="filled",label="Control.Lens.Internal.Review"]; 46 | u58[fillcolor="#66cc66",style="filled",label="Control.Lens.Internal.Context"]; 47 | u57[fillcolor="#66cc66",style="filled",label="Control.Lens.Internal.Exception"]; 48 | u56[fillcolor="#66cc66",style="filled",label="Control.Lens.Internal.PrismTH"]; 49 | u55[fillcolor="#66cc66",style="filled",label="Control.Lens.Internal.FieldTH"]; 50 | u54[fillcolor="#66cc66",style="filled",label="Control.Lens.Internal.Level"]; 51 | u53[fillcolor="#66cc66",style="filled",label="Control.Lens.Internal.Prism"]; 52 | u52[fillcolor="#66cc66",style="filled",label="Control.Lens.Internal.TH"]; 53 | u51[fillcolor="#66cc66",style="filled",label="Control.Lens.Internal.ByteString"]; 54 | u50[fillcolor="#66cc66",style="filled",label="Control.Lens.Internal.Zoom"]; 55 | u49[fillcolor="#66cc66",style="filled",label="Control.Lens.Internal.Getter"]; 56 | u82[fillcolor="#669966",style="filled",label="Control.Monad.Error.Lens"]; 57 | u81[fillcolor="#669999",style="filled",label="Control.Monad.Primitive.Lens"]; 58 | u80[fillcolor="#66cccc",style="filled",label="Control.Parallel.Strategies.Lens"]; 59 | u83[fillcolor="#66ffff",style="filled",label="Control.Seq.Lens"]; 60 | u23[fillcolor="#99cccc",style="filled",label="Data.Array.Lens"]; 61 | u11[fillcolor="#99ffff",style="filled",label="Data.Bits.Lens"]; 62 | u22[fillcolor="#ccffff",style="filled",label="Data.ByteString.Lens"]; 63 | u21[fillcolor="#ccccff",style="filled",label="Data.ByteString.Lazy.Lens"]; 64 | u20[fillcolor="#9999ff",style="filled",label="Data.ByteString.Strict.Lens"]; 65 | u12[fillcolor="#6666ff",style="filled",label="Data.Complex.Lens"]; 66 | u5[fillcolor="#9999cc",style="filled",label="Data.Data.Lens"]; 67 | u15[fillcolor="#6666cc",style="filled",label="Data.Dynamic.Lens"]; 68 | u14[fillcolor="#666699",style="filled",label="Data.HashSet.Lens"]; 69 | u24[fillcolor="#996699",style="filled",label="Data.IntSet.Lens"]; 70 | u4[fillcolor="#cc66cc",style="filled",label="Data.List.Lens"]; 71 | u3[fillcolor="#ff66ff",style="filled",label="Data.List.Split.Lens"]; 72 | u16[fillcolor="#cc99cc",style="filled",label="Data.Map.Lens"]; 73 | u13[fillcolor="#ff99ff",style="filled",label="Data.Sequence.Lens"]; 74 | u17[fillcolor="#ffccff",style="filled",label="Data.Set.Lens"]; 75 | u10[fillcolor="#ffcccc",style="filled",label="Data.Text.Lens"]; 76 | u9[fillcolor="#ff9999",style="filled",label="Data.Text.Lazy.Lens"]; 77 | u8[fillcolor="#ff6666",style="filled",label="Data.Text.Strict.Lens"]; 78 | u19[fillcolor="#cc9999",style="filled",label="Data.Tree.Lens"]; 79 | u18[fillcolor="#cc6666",style="filled",label="Data.Typeable.Lens"]; 80 | u7[fillcolor="#996666",style="filled",label="Data.Vector.Lens"]; 81 | u6[fillcolor="#999966",style="filled",label="Data.Vector.Generic.Lens"]; 82 | u0[fillcolor="#cccc66",style="filled",label="GHC.Generics.Lens"]; 83 | u1[fillcolor="#ffff66",style="filled",label="Generics.Deriving.Lens"]; 84 | u25[fillcolor="#cccc99",style="filled",label="Language.Haskell.TH.Lens"]; 85 | u2[fillcolor="#ffff99",style="filled",label="Numeric.Lens"]; 86 | u28[fillcolor="#ffffcc",style="filled",label="System.Exit.Lens"]; 87 | u27[fillcolor="#ccffcc",style="filled",label="System.FilePath.Lens"]; 88 | u26[fillcolor="#99ff99",style="filled",label="System.IO.Error.Lens"]; 89 | u0 -> u1; 90 | u1 -> u84; 91 | u2 -> u84; 92 | u3 -> u84; 93 | u4 -> u84; 94 | u5 -> u36; 95 | u5 -> u79; 96 | u6 -> u84; 97 | u7 -> u84; 98 | u8 -> u84; 99 | u9 -> u84; 100 | u10 -> u8; 101 | u10 -> u9; 102 | u11 -> u84; 103 | u12 -> u84; 104 | u13 -> u84; 105 | u14 -> u31; 106 | u14 -> u79; 107 | u15 -> u30; 108 | u17 -> u31; 109 | u17 -> u79; 110 | u18 -> u84; 111 | u19 -> u84; 112 | u20 -> u51; 113 | u21 -> u51; 114 | u22 -> u20; 115 | u22 -> u21; 116 | u23 -> u84; 117 | u24 -> u84; 118 | u25 -> u17; 119 | u25 -> u73; 120 | u25 -> u76; 121 | u26 -> u84; 122 | u27 -> u84; 123 | u28 -> u30; 124 | u29 -> u84; 125 | u30 -> u57; 126 | u30 -> u84; 127 | u31 -> u46; 128 | u31 -> u49; 129 | u32 -> u31; 130 | u32 -> u50; 131 | u33 -> u40; 132 | u33 -> u47; 133 | u33 -> u73; 134 | u33 -> u74; 135 | u34 -> u5; 136 | u34 -> u78; 137 | u35 -> u55; 138 | u35 -> u56; 139 | u36 -> u74; 140 | u36 -> u77; 141 | u37 -> u75; 142 | u38 -> u84; 143 | u39 -> u50; 144 | u39 -> u53; 145 | u39 -> u54; 146 | u39 -> u59; 147 | u39 -> u60; 148 | u39 -> u65; 149 | u39 -> u66; 150 | u39 -> u69; 151 | u40 -> u53; 152 | u40 -> u70; 153 | u40 -> u77; 154 | u41 -> u36; 155 | u41 -> u72; 156 | u42 -> u36; 157 | u42 -> u54; 158 | u43 -> u75; 159 | u44 -> u77; 160 | u45 -> u84; 161 | u46 -> u63; 162 | u46 -> u67; 163 | u46 -> u69; 164 | u47 -> u46; 165 | u48 -> u36; 166 | u48 -> u75; 167 | u49 -> u63; 168 | u50 -> u63; 169 | u51 -> u84; 170 | u55 -> u25; 171 | u55 -> u34; 172 | u55 -> u52; 173 | u56 -> u25; 174 | u56 -> u52; 175 | u57 -> u64; 176 | u57 -> u74; 177 | u58 -> u67; 178 | u60 -> u68; 179 | u62 -> u33; 180 | u62 -> u75; 181 | u62 -> u78; 182 | u65 -> u49; 183 | u67 -> u61; 184 | u68 -> u58; 185 | u70 -> u31; 186 | u70 -> u59; 187 | u71 -> u84; 188 | u72 -> u46; 189 | u72 -> u65; 190 | u73 -> u77; 191 | u74 -> u31; 192 | u74 -> u60; 193 | u74 -> u65; 194 | u75 -> u40; 195 | u75 -> u47; 196 | u75 -> u66; 197 | u75 -> u74; 198 | u76 -> u48; 199 | u76 -> u79; 200 | u77 -> u46; 201 | u77 -> u49; 202 | u77 -> u58; 203 | u78 -> u36; 204 | u78 -> u54; 205 | u78 -> u79; 206 | u79 -> u46; 207 | u80 -> u84; 208 | u81 -> u84; 209 | u82 -> u57; 210 | u82 -> u84; 211 | u83 -> u84; 212 | u84 -> u32; 213 | u84 -> u33; 214 | u84 -> u34; 215 | u84 -> u37; 216 | u84 -> u41; 217 | u84 -> u42; 218 | u84 -> u43; 219 | u84 -> u44; 220 | u84 -> u76; 221 | 222 | } 223 | 224 | -------------------------------------------------------------------------------- /screenshots/lens-2.dot.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/yav/graphmod/983c38f73d3d6d232c954416fd1ab019f24c9fc5/screenshots/lens-2.dot.png -------------------------------------------------------------------------------- /screenshots/lens-2.txt: -------------------------------------------------------------------------------- 1 | find src -name '*.hs' | xargs graphmod -q -p --no-cluster > ~/tmp/examples/lens-2.dot 2 | -------------------------------------------------------------------------------- /shell.nix: -------------------------------------------------------------------------------- 1 | { pkgs ? import ./nix/nixpkgs.nix { } }: 2 | 3 | pkgs.mkShell { buildInputs = [ pkgs.stack ]; } 4 | -------------------------------------------------------------------------------- /src/Graphmod.hs: -------------------------------------------------------------------------------- 1 | module Graphmod (graphmod) where 2 | 3 | import Graphmod.Utils 4 | import qualified Graphmod.Trie as Trie 5 | import Graphmod.CabalSupport(parseCabalFile,Unit(..)) 6 | import Text.Dot 7 | 8 | import Control.Monad(forM_,msum,guard,unless) 9 | import Control.Monad.Fix(mfix) 10 | import Control.Exception (SomeException(..)) 11 | import qualified Control.Exception as X (catch) 12 | import Data.List(intercalate,transpose) 13 | import Data.Maybe(isJust,fromMaybe,listToMaybe) 14 | import qualified Data.IntMap as IMap 15 | import qualified Data.Map as Map 16 | import qualified Data.IntSet as ISet 17 | import System.IO(hPutStrLn,stderr) 18 | import System.FilePath (takeExtension) 19 | import System.Console.GetOpt 20 | import System.Directory(getDirectoryContents) 21 | import Numeric(showHex) 22 | 23 | import Paths_graphmod (version) 24 | import Data.Version (showVersion) 25 | 26 | graphmod :: [String] -> IO () 27 | graphmod xs = do 28 | let (fs, ms, errs) = getOpt Permute options xs 29 | case errs of 30 | [] | show_version opts -> 31 | putStrLn ("graphmod " ++ showVersion version) 32 | 33 | | otherwise -> 34 | do (incs,inps) <- fromCabal (use_cabal opts) 35 | g <- graph (foldr add_inc (add_current opts) incs) 36 | (inps ++ map to_input ms) 37 | putStr (make_dot opts g) 38 | where opts = foldr ($) default_opts fs 39 | 40 | _ -> hPutStrLn stderr $ 41 | usageInfo "usage: graphmod MODULES/PATHS" options 42 | 43 | data Input = File FilePath | Module ModName 44 | deriving Show 45 | 46 | -- | Guess if we have a file or a module name 47 | to_input :: String -> Input 48 | to_input m 49 | | takeExtension m `elem` suffixes = File m 50 | | otherwise = Module (splitModName m) 51 | 52 | 53 | 54 | type Nodes = Trie.Trie String [((NodeT,String),Int)] 55 | -- Maps a path to: ((node, label), nodeId) 56 | 57 | type Edges = IMap.IntMap ISet.IntSet 58 | 59 | data NodeT = ModuleNode 60 | 61 | | ModuleInItsCluster 62 | -- ^ A module that has been relocated to its cluster 63 | 64 | | Redirect 65 | -- ^ This is not rendered. It is there to support replacing 66 | -- one node with another (e.g., when collapsing) 67 | 68 | | Deleted 69 | -- ^ This is not rendered, and edges to/from it are also 70 | -- not rendered. 71 | 72 | | CollapsedNode Bool 73 | -- ^ indicates if it contains module too. 74 | deriving (Show,Eq,Ord) 75 | 76 | data AllEdges = AllEdges 77 | { normalEdges :: Edges 78 | , sourceEdges :: Edges 79 | } 80 | 81 | noEdges :: AllEdges 82 | noEdges = AllEdges { normalEdges = IMap.empty 83 | , sourceEdges = IMap.empty 84 | } 85 | 86 | graph :: Opts -> [Input] -> IO (AllEdges, Nodes) 87 | graph opts inputs = fmap maybePrune $ mfix $ \ ~(_,mods) -> 88 | -- NOTE: 'mods' is the final value of 'done' in the funciton 'loop'. 89 | 90 | let nodeFor x = lookupMod x mods -- Recursion happens here! 91 | 92 | loop :: Nodes -> 93 | AllEdges {- all kinds of edges -} -> 94 | Int {- size -} -> 95 | [Input] {- root files/modules -} -> 96 | IO (AllEdges, Nodes) 97 | 98 | loop done es _ [] = 99 | return (es, collapseAll opts done (collapse_quals opts)) 100 | 101 | loop done es size (Module m : todo) 102 | | ignore done m = loop done es size todo 103 | | otherwise = 104 | do fs <- modToFile (inc_dirs opts) m 105 | case fs of 106 | [] -> do warn opts (notFoundMsg m) 107 | if with_missing opts 108 | then add done es size m [] todo 109 | else loop done es size todo 110 | f : gs -> do unless (null gs) (warn opts (ambigMsg m fs)) 111 | (x,imps) <- parseFile f 112 | add done es size x imps todo 113 | 114 | loop done es size (File f : todo) = 115 | do (m,is) <- parseFile f 116 | if ignore done m 117 | then loop done es size todo 118 | else add done es size m is todo 119 | 120 | add done es size m imps ms = size1 `seq` loop done1 es1 size1 ms1 121 | where 122 | es1 = case nodeFor m of 123 | Just src -> foldr (addEdge src) es imps 124 | Nothing -> es 125 | size1 = size + 1 126 | ms1 = map (Module . impMod) imps ++ ms 127 | done1 = insMod m size done 128 | 129 | 130 | addEdge nFrom i aes = 131 | case nodeFor (impMod i) of 132 | Nothing -> aes 133 | Just nTo -> 134 | case impType i of 135 | SourceImp -> 136 | aes { sourceEdges = insSet nFrom nTo (sourceEdges aes) } 137 | NormalImp -> 138 | aes { normalEdges = insSet nFrom nTo (normalEdges aes) } 139 | 140 | 141 | in loop Trie.empty noEdges 0 inputs 142 | 143 | where 144 | maybePrune (es,ns) 145 | | prune_edges opts = (es { normalEdges = pruneEdges (normalEdges es) }, ns) 146 | | otherwise = (es,ns) 147 | 148 | ignore done m = isIgnored (ignore_mods opts) m 149 | || isJust (lookupMod m done) 150 | 151 | 152 | 153 | 154 | lookupMod :: ModName -> Nodes -> Maybe Int 155 | lookupMod (q,m) t = msum . map isThis =<< Trie.lookup (qualifierNodes q) t 156 | where isThis ((ty,m'),nid) = 157 | case ty of 158 | CollapsedNode False -> Nothing -- Keep looking for the actual node 159 | Deleted -> Nothing 160 | _ -> guard (m == m') >> return nid 161 | 162 | insMod :: ModName -> Int -> Nodes -> Nodes 163 | insMod (q,m) n t = Trie.insert (qualifierNodes q) ins t 164 | where 165 | ins xs = ((ModuleNode,m),n) : fromMaybe [] xs 166 | 167 | insSet :: Int -> Int -> Edges -> Edges 168 | insSet x y m = IMap.insertWith ISet.union x (ISet.singleton y) m 169 | 170 | 171 | 172 | pruneEdges :: Edges -> Edges 173 | pruneEdges es = foldr checkEdges es (IMap.toList es) 174 | where 175 | reachIn _ _ _ [] = False 176 | reachIn g tgt visited (x : xs) 177 | | x `ISet.member` visited = reachIn g tgt visited xs 178 | | x == tgt = True 179 | | otherwise = let vs = neighbours g x 180 | in reachIn g tgt (ISet.insert x visited) (vs ++ xs) 181 | 182 | neighbours g x = ISet.toList (IMap.findWithDefault ISet.empty x g) 183 | 184 | reachableIn g x y = reachIn g y ISet.empty [x] 185 | 186 | rmEdge x y g = IMap.adjust (ISet.delete y) x g 187 | 188 | checkEdge x y g = let g1 = rmEdge x y g 189 | in if reachableIn g1 x y then g1 else g 190 | 191 | checkEdges (x,vs) g = foldr (checkEdge x) g (ISet.toList vs) 192 | 193 | 194 | isIgnored :: IgnoreSet -> ModName -> Bool 195 | isIgnored (Trie.Sub _ (Just IgnoreAll)) _ = True 196 | isIgnored (Trie.Sub ts i ) (q,m) = 197 | case qualifierNodes q of 198 | [] -> 199 | case i of 200 | Just (IgnoreSome ms) -> elem m ms 201 | Just IgnoreAll -> error "BUG: IgnoreAll should be matched" 202 | Nothing -> False 203 | x : xs -> 204 | case Map.lookup x ts of 205 | Nothing -> False 206 | Just t -> isIgnored t (fromHierarchy xs,m) 207 | 208 | 209 | -- XXX: We could combine collapseAll and collapse into a single pass 210 | -- to avoid traversing form the root each time. 211 | collapseAll :: Opts -> Nodes -> Trie.Trie String Bool -> Nodes 212 | collapseAll opts t0 = 213 | foldr (\q t -> fromMaybe t (collapse opts t q)) t0 . toList 214 | where 215 | toList (Trie.Sub _ (Just x)) = return ([], x) 216 | toList (Trie.Sub as Nothing) = do (q,t) <- Map.toList as 217 | (qs,x) <- toList t 218 | return (q:qs, x) 219 | 220 | -- NOTE: We use the Maybe type to indicate when things changed. 221 | collapse :: Opts -> Nodes -> ([String],Bool) -> Maybe Nodes 222 | collapse _ _ ([],_) = Nothing 223 | 224 | collapse opts (Trie.Sub ts mb) ([q],alsoMod') = 225 | do t <- Map.lookup q ts 226 | let alsoMod = alsoMod' || mod_in_cluster opts 227 | -- if modules are moved in their sub-directory clsuter, 228 | -- then we always want to collapse them, irrspective of the flag given 229 | 230 | 231 | nestedMods = [ nm | Trie.Sub _ (Just xs) <- Map.elems ts 232 | , ((_,nm),_) <- xs ] 233 | will_move = mod_in_cluster opts && (q `elem` nestedMods) 234 | (thisMod,otherMods) 235 | | alsoMod || will_move 236 | , Just (nid,rest) <- findThisMod =<< mb = (Just nid, rest) 237 | | otherwise = (Nothing, fromMaybe [] mb) 238 | 239 | -- use this node-id to represent the collapsed cluster 240 | rep <- msum [ thisMod, getFirst t ] 241 | 242 | let close ((_,nm),_) = ((if will_move then Deleted else Redirect,nm),rep) 243 | ts' = Map.insert q (fmap (map close) t) ts 244 | newT | alsoMod || not will_move = CollapsedNode (isJust thisMod) 245 | | otherwise = ModuleNode 246 | 247 | return (Trie.Sub ts' (Just (((newT,q),rep) : otherMods))) 248 | where 249 | findThisMod (((_,nm),nid) : more) | nm == q = Just (nid,more) 250 | findThisMod (x : more) = do (yes,more') <- findThisMod more 251 | return (yes, x:more') 252 | findThisMod [] = Nothing 253 | 254 | getFirst (Trie.Sub ts1 ms) = 255 | msum (fmap snd (listToMaybe =<< ms) : map getFirst (Map.elems ts1)) 256 | 257 | collapse opts (Trie.Sub ts ms) (q : qs,x) = 258 | do t <- Map.lookup q ts 259 | t1 <- collapse opts t (qs,x) 260 | return (Trie.Sub (Map.insert q t1 ts) ms) 261 | 262 | 263 | 264 | -- | If inside cluster A.B we have a module M, 265 | -- and there is a cluster A.B.M, then move M into that cluster as a special node 266 | moveModulesInCluster :: Nodes -> Nodes 267 | moveModulesInCluster (Trie.Sub su0 ms0) = 268 | goMb (fmap moveModulesInCluster su0) ms0 269 | where 270 | goMb su mb = 271 | case mb of 272 | Nothing -> Trie.Sub su Nothing 273 | Just xs -> go [] su xs 274 | 275 | go ns su xs = 276 | case xs of 277 | [] -> Trie.Sub su $ if null ns then Nothing else Just ns 278 | y : ys -> 279 | case check y su of 280 | Left it -> go (it : ns) su ys 281 | Right su1 -> go ns su1 ys 282 | 283 | check it@((nt,s),i) mps = 284 | case nt of 285 | ModuleNode -> 286 | case Map.lookup s mps of 287 | Nothing -> Left it 288 | Just t -> Right (Map.insert s (Trie.insert [] add t) mps) 289 | where 290 | newM = ((ModuleInItsCluster,s),i) 291 | add xs = newM : fromMaybe [] xs 292 | 293 | 294 | ModuleInItsCluster -> Left it 295 | CollapsedNode _ -> Left it 296 | Redirect -> Left it 297 | Deleted -> Left it 298 | 299 | 300 | -- We use tries to group modules by directory. 301 | -------------------------------------------------------------------------------- 302 | 303 | 304 | 305 | -- Render edges and a trie into the dot language 306 | -------------------------------------------------------------------------------- 307 | make_dot :: Opts -> (AllEdges,Nodes) -> String 308 | make_dot opts (es,t) = 309 | showDot $ 310 | do attribute ("size", graph_size opts) 311 | attribute ("ratio", "fill") 312 | let cols = colors (color_scheme opts) 313 | if use_clusters opts 314 | then make_clustered_dot cols $ 315 | if mod_in_cluster opts then moveModulesInCluster t else t 316 | else make_unclustered_dot cols "" t >> return () 317 | genEdges normalAttr (normalEdges es) 318 | genEdges sourceAttr (sourceEdges es) 319 | where 320 | normalAttr _x _y = [] 321 | sourceAttr _x _y = [("style","dashed")] 322 | 323 | genEdges attr edges = 324 | forM_ (IMap.toList edges) $ \(x,ys) -> 325 | forM_ (ISet.toList ys) $ \y -> 326 | edge (userNodeId x) (userNodeId y) (attr x y) 327 | 328 | 329 | 330 | 331 | 332 | 333 | make_clustered_dot :: [Color] -> Nodes -> Dot () 334 | make_clustered_dot cs0 su = go (0,0,0) cs0 su >> return () 335 | where 336 | clusterC = "#0000000F" 337 | 338 | go outer_col ~(this_col:more) (Trie.Sub xs ys) = 339 | do let outerC = renderColor outer_col 340 | thisC = renderColor this_col 341 | 342 | forM_ (fromMaybe [] ys) $ \((t,ls),n) -> 343 | unless (t == Redirect || t == Deleted) $ 344 | userNode (userNodeId n) $ 345 | ("label",ls) : 346 | case t of 347 | CollapsedNode False -> [ ("shape", "box") 348 | , ("style","filled") 349 | , ("color", clusterC) 350 | ] 351 | CollapsedNode True -> [ ("style","filled") 352 | , ("fillcolor", clusterC) 353 | ] 354 | ModuleInItsCluster -> [ ("style","filled,bold") 355 | , ("fillcolor", outerC) 356 | ] 357 | 358 | ModuleNode -> [ ("style", "filled") 359 | , ("fillcolor", thisC) 360 | , ("penwidth","0") 361 | ] 362 | Redirect -> [] 363 | Deleted -> [] 364 | goSub this_col more (Map.toList xs) 365 | 366 | goSub _ cs [] = return cs 367 | goSub outer_col cs ((name,sub) : more) = 368 | do (_,cs1) <- cluster $ do attribute ("label", name) 369 | attribute ("color" , clusterC) 370 | attribute ("style", "filled") 371 | go outer_col cs sub 372 | 373 | goSub outer_col cs1 more 374 | 375 | 376 | make_unclustered_dot :: [Color] -> String -> Nodes -> Dot [Color] 377 | make_unclustered_dot c pre (Trie.Sub xs ys') = 378 | do let col = renderColor (head c) 379 | let ys = fromMaybe [] ys' 380 | forM_ ys $ \((t,ls),n) -> 381 | userNode (userNodeId n) $ 382 | [ ("fillcolor", col) 383 | , ("style", "filled") 384 | , ("label", pre ++ ls) 385 | ] ++ 386 | case t of 387 | CollapsedNode False -> [ ("shape", "box"), ("color", col) ] 388 | CollapsedNode True -> [ ("shape", "box") ] 389 | Redirect -> [] 390 | ModuleInItsCluster -> [] 391 | ModuleNode -> [] 392 | Deleted -> [] 393 | 394 | let c1 = if null ys then c else tail c 395 | c1 `seq` loop (Map.toList xs) c1 396 | where 397 | loop ((name,sub):ms) c1 = 398 | do let pre1 = pre ++ name ++ "." 399 | c2 <- make_unclustered_dot c1 pre1 sub 400 | loop ms c2 401 | loop [] c2 = return c2 402 | 403 | 404 | type Color = (Int,Int,Int) 405 | 406 | colors :: Int -> [Color] 407 | colors n = cycle $ mix_colors $ drop n palettes 408 | 409 | renderColor :: Color -> String 410 | renderColor (x,y,z) = '#' : showHex (mk x) (showHex (mk y) (showHex (mk z) "")) 411 | where mk n = 0xFF - n * 0x44 412 | 413 | 414 | mix_colors :: [[a]] -> [a] 415 | mix_colors css = mk set1 ++ mk set2 416 | where 417 | (set1,set2) = unzip $ map (splitAt 3) css 418 | mk = concat . transpose 419 | 420 | 421 | palettes :: [[Color]] 422 | palettes = [green, yellow, blue, red, cyan, magenta ] 423 | where 424 | red :: [Color] 425 | red = [ (0,1,1), (0,2,2), (0,3,3), (1,2,3), (1,3,3), (2,3,3) ] 426 | green = map rotR red 427 | blue = map rotR green 428 | [cyan,magenta,yellow] = map (map compl . reverse) [red, green, blue] 429 | 430 | rotR (x,y,z) = (z,x,y) 431 | compl (x,y,z) = (3-x,3-y,3-z) 432 | 433 | -- Warnings and error messages 434 | -------------------------------------------------------------------------------- 435 | warn :: Opts -> String -> IO () 436 | warn o _ | quiet o = return () 437 | warn _ msg = hPutStrLn stderr ("WARNING: " ++ msg) 438 | 439 | notFoundMsg :: ModName -> String 440 | notFoundMsg m = "Cannot find a file for module " 441 | ++ joinModName m ++ " (ignoring)" 442 | 443 | ambigMsg :: ModName -> [FilePath] -> String 444 | ambigMsg m xs = "Multiple files for module " ++ joinModName m 445 | ++ " (picking the first):\n" 446 | ++ intercalate "," xs 447 | 448 | 449 | -------------------------------------------------------------------------------- 450 | 451 | 452 | fromCabal :: Bool -> IO ([FilePath],[Input]) 453 | fromCabal True = 454 | do fs <- getDirectoryContents "." -- XXX 455 | case filter ((".cabal" ==) . takeExtension) fs of 456 | f : _ -> do units <- parseCabalFile f 457 | `X.catch` \SomeException {} -> return [] 458 | return (fromUnits units) 459 | _ -> return ([],[]) 460 | fromCabal _ = return ([],[]) 461 | 462 | 463 | fromUnits :: [Unit] -> ([FilePath], [Input]) 464 | fromUnits us = (concat fs, concat is) 465 | where 466 | (fs,is) = unzip (map fromUnit us) 467 | 468 | fromUnit :: Unit -> ([FilePath], [Input]) 469 | fromUnit u = (unitPaths u, map File (unitFiles u) ++ map Module (unitModules u)) 470 | 471 | 472 | 473 | -- Command line options 474 | -------------------------------------------------------------------------------- 475 | data Opts = Opts 476 | { inc_dirs :: [FilePath] 477 | , quiet :: Bool 478 | , with_missing :: Bool 479 | , use_clusters :: Bool 480 | , mod_in_cluster:: Bool 481 | , ignore_mods :: IgnoreSet 482 | , collapse_quals :: Trie.Trie String Bool 483 | -- ^ The "Bool" tells us if we should collapse modules as well. 484 | -- For example, "True" says that A.B.C would collapse not only A.B.C.* 485 | -- but also the module A.B.C, if it exists. 486 | , show_version :: Bool 487 | , color_scheme :: Int 488 | , prune_edges :: Bool 489 | , graph_size :: String 490 | 491 | , use_cabal :: Bool -- ^ should we try to use a cabal file, if any 492 | } 493 | 494 | type IgnoreSet = Trie.Trie String IgnoreSpec 495 | data IgnoreSpec = IgnoreAll | IgnoreSome [String] deriving Show 496 | 497 | type OptT = Opts -> Opts 498 | 499 | default_opts :: Opts 500 | default_opts = Opts 501 | { inc_dirs = [] 502 | , quiet = False 503 | , with_missing = False 504 | , use_clusters = True 505 | , mod_in_cluster = True 506 | , ignore_mods = Trie.empty 507 | , collapse_quals = Trie.empty 508 | , show_version = False 509 | , color_scheme = 0 510 | , prune_edges = False 511 | , graph_size = "6,4" 512 | , use_cabal = True 513 | } 514 | 515 | options :: [OptDescr OptT] 516 | options = 517 | [ Option ['q'] ["quiet"] (NoArg set_quiet) 518 | "Do not show warnings" 519 | 520 | , Option ['i'] [] (ReqArg add_inc "DIR") 521 | "Add a search directory" 522 | 523 | , Option ['a'] ["all"] (NoArg set_all) 524 | "Add nodes for missing modules" 525 | 526 | , Option [] ["no-cluster"] (NoArg set_no_cluster) 527 | "Do not cluster directories" 528 | 529 | , Option [] ["no-module-in-cluster"] (NoArg set_no_mod_in_cluster) 530 | "Do not place modules matching a cluster's name inside it." 531 | 532 | , Option ['r'] ["remove-module"] (ReqArg add_ignore_mod "NAME") 533 | "Do not display module NAME" 534 | 535 | , Option ['R'] ["remove-qual"] (ReqArg add_ignore_qual "NAME") 536 | "Do not display modules NAME.*" 537 | 538 | , Option ['c'] ["collapse"] (ReqArg (add_collapse_qual False) "NAME") 539 | "Display modules NAME.* as one node" 540 | 541 | , Option ['C'] ["collapse-module"] (ReqArg (add_collapse_qual True) "NAME") 542 | "Display modules NAME and NAME.* as one node" 543 | 544 | , Option ['p'] ["prune-edges"] (NoArg set_prune) 545 | "Remove imports if the module is imported by another imported module" 546 | 547 | , Option ['d'] ["graph-dim"] (ReqArg set_size "SIZE,SIZE") 548 | "Set dimensions of the graph. See the `size` attribute of graphvize." 549 | 550 | , Option ['s'] ["colors"] (ReqArg add_color_scheme "NUM") 551 | "Choose a color scheme number (0-5)" 552 | 553 | , Option [] ["no-cabal"] (NoArg (set_cabal False)) 554 | "Do not use Cabal for paths and modules." 555 | 556 | , Option ['v'] ["version"] (NoArg set_show_version) 557 | "Show the current version." 558 | ] 559 | 560 | add_current :: OptT 561 | add_current o = case inc_dirs o of 562 | [] -> o { inc_dirs = ["."] } 563 | _ -> o 564 | 565 | set_quiet :: OptT 566 | set_quiet o = o { quiet = True } 567 | 568 | set_show_version :: OptT 569 | set_show_version o = o { show_version = True } 570 | 571 | set_all :: OptT 572 | set_all o = o { with_missing = True } 573 | 574 | set_no_cluster :: OptT 575 | set_no_cluster o = o { use_clusters = False } 576 | 577 | set_no_mod_in_cluster :: OptT 578 | set_no_mod_in_cluster o = o { mod_in_cluster = False } 579 | 580 | add_inc :: FilePath -> OptT 581 | add_inc d o = o { inc_dirs = d : inc_dirs o } 582 | 583 | add_ignore_mod :: String -> OptT 584 | add_ignore_mod s o = o { ignore_mods = ins (splitModName s) } 585 | where 586 | ins (q,m) = Trie.insert (qualifierNodes q) (upd m) (ignore_mods o) 587 | 588 | upd _ (Just IgnoreAll) = IgnoreAll 589 | upd m (Just (IgnoreSome ms)) = IgnoreSome (m:ms) 590 | upd m Nothing = IgnoreSome [m] 591 | 592 | add_ignore_qual :: String -> OptT 593 | add_ignore_qual s o = o { ignore_mods = Trie.insert ((qualifierNodes.splitQualifier) s) 594 | (const IgnoreAll) (ignore_mods o) } 595 | 596 | add_color_scheme :: String -> OptT 597 | add_color_scheme n o = o { color_scheme = case reads n of 598 | [(x,"")] -> x 599 | _ -> color_scheme default_opts } 600 | 601 | add_collapse_qual :: Bool -> String -> OptT 602 | add_collapse_qual m s o = o { collapse_quals = upd ((qualifierNodes.splitQualifier) s) 603 | (collapse_quals o) } 604 | 605 | where 606 | upd [] (Trie.Sub xs (Just _)) = Trie.Sub xs (Just m) 607 | upd _ t@(Trie.Sub _ (Just _)) = t 608 | upd [] _ = Trie.Sub Map.empty (Just m) 609 | upd (q:qs) (Trie.Sub as _) = Trie.Sub (Map.alter add q as) Nothing 610 | where add j = Just $ upd qs $ fromMaybe Trie.empty j 611 | 612 | set_prune :: OptT 613 | set_prune o = o { prune_edges = True } 614 | 615 | set_size :: String -> OptT 616 | set_size s o = o { graph_size = s } 617 | 618 | set_cabal :: Bool -> OptT 619 | set_cabal on o = o { use_cabal = on } 620 | -------------------------------------------------------------------------------- /src/Graphmod/CabalSupport.hs: -------------------------------------------------------------------------------- 1 | {-# language CPP #-} 2 | 3 | module Graphmod.CabalSupport (parseCabalFile,Unit(..),UnitName(..)) where 4 | 5 | import Graphmod.Utils(ModName,fromHierarchy) 6 | 7 | import Data.Maybe(maybeToList) 8 | import System.FilePath(()) 9 | 10 | -- Interface to cabal. 11 | import Distribution.Verbosity(silent) 12 | import Distribution.PackageDescription 13 | ( GenericPackageDescription, PackageDescription(..) 14 | , Library(..), Executable(..), BuildInfo(..) ) 15 | import Distribution.PackageDescription.Configuration (flattenPackageDescription) 16 | import Distribution.ModuleName(ModuleName,components) 17 | 18 | #if MIN_VERSION_Cabal(3,6,0) 19 | import Distribution.Utils.Path (SymbolicPath, PackageDir, SourceDir, getSymbolicPath) 20 | #endif 21 | 22 | #if MIN_VERSION_Cabal(2,0,0) 23 | 24 | #if MIN_VERSION_Cabal(3,8,1) 25 | import Distribution.Simple.PackageDescription(readGenericPackageDescription) 26 | #elif MIN_VERSION_Cabal(2,2,0) 27 | import Distribution.PackageDescription.Parsec(readGenericPackageDescription) 28 | #else 29 | import Distribution.PackageDescription.Parse(readGenericPackageDescription) 30 | #endif 31 | 32 | import Distribution.Types.UnqualComponentName (UnqualComponentName) 33 | 34 | #if MIN_VERSION_Cabal(2,2,0) 35 | import Distribution.Pretty (prettyShow) 36 | 37 | pretty :: UnqualComponentName -> String 38 | pretty = prettyShow 39 | #else 40 | import Distribution.Text (disp) 41 | import Text.PrettyPrint (render) 42 | 43 | pretty :: UnqualComponentName -> String 44 | pretty = render . disp 45 | #endif 46 | 47 | 48 | #else 49 | import Distribution.PackageDescription.Parse(readPackageDescription) 50 | import Distribution.Verbosity (Verbosity) 51 | 52 | readGenericPackageDescription :: Verbosity -> FilePath -> IO GenericPackageDescription 53 | readGenericPackageDescription = readPackageDescription 54 | 55 | pretty :: String -> String 56 | pretty = id 57 | #endif 58 | 59 | -- Note that this isn't nested under the above #if because we need 60 | -- the backwards-compatible version to be available for all Cabal 61 | -- versions prior to 3.6 62 | #if MIN_VERSION_Cabal(3,6,0) 63 | sourceDirToFilePath :: SymbolicPath PackageDir SourceDir -> FilePath 64 | sourceDirToFilePath = getSymbolicPath 65 | #else 66 | sourceDirToFilePath :: FilePath -> FilePath 67 | sourceDirToFilePath = id 68 | #endif 69 | 70 | parseCabalFile :: FilePath -> IO [Unit] 71 | parseCabalFile f = fmap findUnits (readGenericPackageDescription silent f) 72 | 73 | 74 | -- | This is our abstraction for something in a cabal file. 75 | data Unit = Unit 76 | { unitName :: UnitName 77 | , unitPaths :: [FilePath] 78 | , unitModules :: [ModName] 79 | , unitFiles :: [FilePath] 80 | } deriving Show 81 | 82 | data UnitName = UnitLibrary | UnitExecutable String 83 | deriving Show 84 | 85 | 86 | libUnit :: Library -> Unit 87 | libUnit lib = Unit { unitName = UnitLibrary 88 | , unitPaths = sourceDirToFilePath <$> hsSourceDirs (libBuildInfo lib) 89 | , unitModules = map toMod (exposedModules lib) 90 | -- other modules? 91 | , unitFiles = [] 92 | } 93 | 94 | exeUnit :: Executable -> Unit 95 | exeUnit exe = Unit { unitName = UnitExecutable (pretty $ exeName exe) 96 | , unitPaths = sourceDirToFilePath <$> hsSourceDirs (buildInfo exe) 97 | , unitModules = [] -- other modules? 98 | , unitFiles = case hsSourceDirs (buildInfo exe) of 99 | [] -> [ modulePath exe ] 100 | ds -> [ sourceDirToFilePath d modulePath exe | d <- ds ] 101 | } 102 | 103 | toMod :: ModuleName -> ModName 104 | toMod m = case components m of 105 | [] -> error "Empty module name." 106 | xs -> (fromHierarchy (init xs), last xs) 107 | 108 | findUnits :: GenericPackageDescription -> [Unit] 109 | findUnits g = maybeToList (fmap libUnit (library pkg)) ++ 110 | fmap exeUnit (executables pkg) 111 | where 112 | pkg = flattenPackageDescription g -- we just ignore flags 113 | -------------------------------------------------------------------------------- /src/Graphmod/Trie.hs: -------------------------------------------------------------------------------- 1 | module Graphmod.Trie where 2 | 3 | import qualified Data.Map as Map 4 | import Data.Maybe(fromMaybe) 5 | 6 | data Trie a b = Sub (Map.Map a (Trie a b)) (Maybe b) 7 | deriving (Eq, Ord, Show) 8 | 9 | empty :: Trie a b 10 | empty = Sub Map.empty Nothing 11 | 12 | lookup :: Ord a => [a] -> Trie a b -> Maybe b 13 | lookup [] (Sub _ b) = b 14 | lookup (k:ks) (Sub as _) = Graphmod.Trie.lookup ks =<< Map.lookup k as 15 | 16 | insert :: (Ord a) => [a] -> (Maybe b -> b) -> Trie a b -> Trie a b 17 | insert [] f (Sub as b) = Sub as (Just (f b)) 18 | insert (k:ks) f (Sub as b) = Sub (Map.alter upd k as) b 19 | where upd j = Just $ insert ks f $ fromMaybe empty j 20 | 21 | instance Functor (Trie a) where 22 | fmap f (Sub m mb) = Sub (fmap (fmap f) m) (fmap f mb) 23 | -------------------------------------------------------------------------------- /src/Graphmod/Utils.hs: -------------------------------------------------------------------------------- 1 | module Graphmod.Utils 2 | ( parseFile 3 | , parseString 4 | , Qualifier 5 | , qualifierNodes 6 | , fromHierarchy 7 | , Import(..) 8 | , ImpType(..) 9 | , splitQualifier 10 | , ModName 11 | , splitModName 12 | , joinModName 13 | , relPaths 14 | , modToFile 15 | , suffixes 16 | ) where 17 | 18 | import Language.Haskell.Lexer(lexerPass0,Token(..),PosToken,line) 19 | 20 | import Control.Monad(mplus, filterM) 21 | import Control.Exception(evaluate) 22 | import Data.List(intercalate,isPrefixOf,nub) 23 | import System.Directory(doesFileExist) 24 | import qualified System.IO as IO 25 | import System.FilePath 26 | 27 | data Import = Import { impMod :: ModName, impType :: ImpType } 28 | deriving (Show, Eq) 29 | 30 | data ImpType = NormalImp | SourceImp 31 | deriving (Show,Eq,Ord) 32 | 33 | -- | Get the imports of a file. 34 | parseFile :: FilePath -> IO (ModName,[Import]) 35 | parseFile f = 36 | do h <- IO.openFile f IO.ReadMode 37 | IO.hSetEncoding h IO.utf8 38 | (modName, imps) <- (parseString . get_text) `fmap` IO.hGetContents h 39 | _ <- evaluate (length imps) -- this is here so that the file gets closed 40 | IO.hClose h 41 | if ext == ".imports" 42 | then return (splitModName (takeBaseName f), imps) 43 | else case modName of 44 | -- disambiguate Main modules with no qualifiers 45 | (Hierarchy [],"Main") -> return (splitFilePath f,imps) 46 | _ -> return (modName, imps) 47 | 48 | 49 | where get_text txt = if ext == ".lhs" then delit txt else txt 50 | ext = takeExtension f 51 | 52 | -- | Get the imports from a string that represents a program. 53 | parseString :: String -> (ModName,[Import]) 54 | parseString = parse . dropApproxCPP . dropComments . lexerPass0 55 | 56 | 57 | -- | Drop comments, but keep {-# SOURCE #-} pragmas. 58 | dropComments :: [PosToken] -> [PosToken] 59 | dropComments = filter (not . skip) 60 | where 61 | skip (t, (_,txt)) 62 | | t == Whitespace 63 | || t == Commentstart 64 | || t == Comment 65 | || t == LiterateComment = True 66 | | t == NestedComment = not (isSourcePragma txt) 67 | | otherwise = False 68 | 69 | 70 | isSourcePragma :: String -> Bool 71 | isSourcePragma txt = case words txt of 72 | ["{-#", "SOURCE", "#-}"] -> True 73 | _ -> False 74 | 75 | 76 | dropApproxCPP :: [PosToken] -> [PosToken] 77 | 78 | -- this is some artifact of the lexer 79 | dropApproxCPP ((_, (_,"")) : more) = dropApproxCPP more 80 | 81 | dropApproxCPP ((Varsym, (_,"#")) : (_, (pos,tok)) : more) 82 | | tok `elem` [ "if", "ifdef", "ifndef" ] = dropToEndif more 83 | | tok `elem` [ "include", "define", "undef" ] = dropToEOL more 84 | where 85 | dropToEndif ((Varsym, (_,"#")) : (_, (_,"endif")) : rest) 86 | = dropApproxCPP rest 87 | dropToEndif (_ : rest) = dropToEndif rest 88 | dropToEndif [] = [] 89 | 90 | dropToEOL ((_, (pos1,_)) : rest) 91 | | line pos == line pos1 = dropToEOL rest 92 | dropToEOL xs = dropApproxCPP xs 93 | 94 | dropApproxCPP (x : xs) = x : dropApproxCPP xs 95 | dropApproxCPP [] = [] 96 | 97 | 98 | -- 'import' maybe_src maybe_safe optqualified maybe_pkg modid 99 | -- maybeas maybeimpspec 100 | isImp :: [PosToken] -> Maybe (Import, [PosToken]) 101 | isImp ts = attempt (1::Int) (drop 1 ts) 102 | where 103 | attempt n toks 104 | -- import safe qualified "package" ModId 105 | | n > 4 = Nothing 106 | | otherwise = mplus (isMod toks) (attempt (n+1) (drop 1 toks)) 107 | 108 | isMod ((ty, (_,x)) : xs) = case ty of 109 | Conid -> Just (toImp x,xs) 110 | Qconid -> Just (toImp x,xs) 111 | _ -> Nothing 112 | isMod _ = Nothing 113 | 114 | toImp x = Import { impMod = splitModName x, impType = isSrc } 115 | isSrc = case ts of 116 | _ : (_,(_,x)) : _ | isSourcePragma x -> SourceImp 117 | _ -> NormalImp 118 | 119 | 120 | 121 | parse :: [PosToken] -> (ModName,[Import]) 122 | parse ((Reservedid,(_,"module")) : (_,(_,m)) : is) = 123 | (splitModName m,imports is) 124 | parse is = ((Hierarchy [],"Main"),imports is) 125 | -- TODO: special handling for Main modules, 126 | -- to disambiguate multiple main Modules in a single project 127 | 128 | imports :: [PosToken] -> [Import] 129 | imports ts = case isImp $ dropWhile (not . (("import" ==) . snd . snd)) ts of 130 | Just (x,xs) -> x : imports xs 131 | _ -> [] 132 | 133 | -- | A hierarchical module name. 134 | -- We make this an opaque type with accessors 'qualifierNodes' and 'fromHierarchy' 135 | -- so that we can transparently add new structure to this type. 136 | data Qualifier = Hierarchy [String] 137 | | FromFile [String] deriving (Show, Eq) 138 | qualifierNodes :: Qualifier -> [String] 139 | qualifierNodes (Hierarchy qs) = qs 140 | qualifierNodes (FromFile qs) = qs 141 | fromHierarchy :: [String] -> Qualifier 142 | fromHierarchy = Hierarchy 143 | 144 | type ModName = (Qualifier,String) 145 | 146 | -- | Convert a string name into a hierarchical name qualifier. 147 | splitQualifier :: String -> Qualifier 148 | splitQualifier cs = case break ('.'==) cs of 149 | (xs,_:ys) -> let Hierarchy qs = splitQualifier ys 150 | in Hierarchy (xs:qs) 151 | _ -> Hierarchy [cs] 152 | 153 | -- | The 'Qualifier' for a Main module is the path leading to it, 154 | -- the module name is the file's basename, which is Main in typical cases. 155 | splitFilePath :: FilePath -> ModName 156 | splitFilePath path = let (d,f) = splitFileName path 157 | in (FromFile . splitDirectories . takeDirectory $ d, dropExtensions f) 158 | 159 | -- | Convert a string name into a hierarchical name. 160 | -- It is important that 161 | -- 162 | -- @ 163 | -- f `elem` (('relPaths' . 'splitFilePath') f) 164 | -- @ 165 | splitModName :: String -> ModName 166 | splitModName cs = case break ('.'==) cs of 167 | (xs,_:ys) -> let (Hierarchy as,bs) = splitModName ys 168 | in (Hierarchy (xs:as),bs) 169 | _ -> (Hierarchy [],cs) 170 | 171 | joinModName :: ModName -> String 172 | joinModName (q,y) = intercalate "." (qualifierNodes q ++ [y]) 173 | 174 | -- | The files in which a module might reside. 175 | relPaths :: ModName -> [FilePath] 176 | relPaths (q,y) = [ prefix ++ suffix | suffix <- suffixes ] 177 | where prefix = foldr () y (qualifierNodes q) 178 | 179 | suffixes :: [String] 180 | suffixes = [".hs",".lhs", ".imports"] 181 | 182 | -- | The files in which a module might reside. 183 | -- We report only files that exist. 184 | modToFile :: [FilePath] -> ModName -> IO [FilePath] 185 | modToFile dirs m = nub `fmap` filterM doesFileExist paths 186 | where 187 | paths = [ d r | d <- dirs, r <- relPaths m ] 188 | 189 | 190 | delit :: String -> String 191 | delit txt = unlines $ bird $ lines txt 192 | where 193 | bird (('>' : cs) : ls) = (' ' : cs) : bird ls 194 | bird (l : ls) 195 | | "\\begin{code}" `isPrefixOf` l = in_code ls 196 | | otherwise = bird ls 197 | bird [] = [] 198 | 199 | in_code (l : ls) 200 | | "\\end{code}" `isPrefixOf` l = bird ls 201 | | otherwise = l : in_code ls 202 | in_code [] = [] -- unterminated code... 203 | 204 | 205 | 206 | -------------------------------------------------------------------------------- /stack.yaml: -------------------------------------------------------------------------------- 1 | resolver: lts-16.27 2 | 3 | packages: 4 | - "." 5 | 6 | nix: 7 | enable: false 8 | path: [nixpkgs=./nix/nixpkgs.nix] 9 | shell-file: ./nix/stack.nix 10 | -------------------------------------------------------------------------------- /stack.yaml.lock: -------------------------------------------------------------------------------- 1 | # This file was autogenerated by Stack. 2 | # You should not edit this file by hand. 3 | # For more information, please see the documentation at: 4 | # https://docs.haskellstack.org/en/stable/lock_files 5 | 6 | packages: [] 7 | snapshots: 8 | - completed: 9 | size: 533252 10 | url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/16/27.yaml 11 | sha256: c2aaae52beeacf6a5727c1010f50e89d03869abfab6d2c2658ade9da8ed50c73 12 | original: lts-16.27 13 | -------------------------------------------------------------------------------- /tests/T1/A.hs: -------------------------------------------------------------------------------- 1 | module A where 2 | import D.X 3 | import D.Y 4 | -------------------------------------------------------------------------------- /tests/T1/B.hs: -------------------------------------------------------------------------------- 1 | module B where 2 | -------------------------------------------------------------------------------- /tests/T1/C.hs: -------------------------------------------------------------------------------- 1 | module C where 2 | -------------------------------------------------------------------------------- /tests/T1/D.hs: -------------------------------------------------------------------------------- 1 | module D where 2 | 3 | import D.X 4 | -------------------------------------------------------------------------------- /tests/T1/D/X.hs: -------------------------------------------------------------------------------- 1 | module D.X where 2 | 3 | import B 4 | 5 | -------------------------------------------------------------------------------- /tests/T1/D/Y.hs: -------------------------------------------------------------------------------- 1 | module D.Y where 2 | import C 3 | --------------------------------------------------------------------------------