├── .gitignore ├── README.md ├── app ├── index.html └── index.js ├── elm-module-graph.py ├── elm-package.json ├── package.json ├── src ├── Main.elm ├── ModuleGraph.elm ├── Ports.elm └── ports.js └── webpack.config.js /.gitignore: -------------------------------------------------------------------------------- 1 | .DS_Store 2 | elm-stuff 3 | node_modules 4 | script.js 5 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # elm-module-graph 2 | 3 | Visually explore package and module dependencies for an Elm project. 4 | 5 | 6 | ## Examples 7 | 8 | Explore dependency graphs for these Elm projects: 9 | 10 | - [graph](https://justinmimbs.github.io/elm-module-graph/examples/ellie.html) - [lukewestby/ellie](https://github.com/lukewestby/ellie) 11 | - [graph](https://justinmimbs.github.io/elm-module-graph/examples/elm-spa-example.html) - [rtfeldman/elm-spa-example](https://github.com/rtfeldman/elm-spa-example) 12 | - [graph](https://justinmimbs.github.io/elm-module-graph/examples/time-tracker.html) - [knewter/time-tracker](https://github.com/knewter/time-tracker) 13 | - [graph](https://justinmimbs.github.io/elm-module-graph/examples/tradenomiitti.html) - [Tradenomiliitto/tradenomiitti](https://github.com/Tradenomiliitto/tradenomiitti) 14 | 15 | 16 | ## Usage 17 | 18 | 1. __Generate__ a `module-graph.json` file for your Elm project with the Python script in this repository. 19 | 20 | To generate this file, first save the script, [elm-module-graph.py](https://raw.githubusercontent.com/justinmimbs/elm-module-graph/master/elm-module-graph.py), locally. Execute it, passing it the file path to either an Elm module or an `elm-package.json`. 21 | 22 | ```sh 23 | ./elm-module-graph.py project/src/Main.elm 24 | ``` 25 | 26 | or 27 | 28 | ```sh 29 | ./elm-module-graph.py library/elm-package.json 30 | ``` 31 | 32 | By default it writes to a file in the current working directory named `module-graph.json`, but you can specify a different output location with the `--output` option. 33 | 34 | 35 | 2. __Provide__ that file to this page: [elm-module-graph](https://justinmimbs.github.io/elm-module-graph). 36 | 37 | 38 | ## About 39 | 40 | The page displays two graph diagrams. Nodes are vertically sorted so that for each connection the lower node depends on the higher node. 41 | 42 | In the Packages graph, clicking a package name will toggle its modules in and out of the Modules graph. In the Modules graph, clicking a module name will highlight the subgraph it's connected to; the nodes are then colored based on distance from the selected module. 43 | 44 | Graph diagrams are drawn using [justinmimbs/elm-arc-diagram](http://package.elm-lang.org/packages/justinmimbs/elm-arc-diagram/latest). 45 | -------------------------------------------------------------------------------- /app/index.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | Elm Module Graph 8 | 9 | 10 | 11 | 12 | 13 | -------------------------------------------------------------------------------- /app/index.js: -------------------------------------------------------------------------------- 1 | var Elm = require('../src/Main.elm'); 2 | var ports = require('../src/ports.js'); 3 | 4 | var app = Elm.Main.fullscreen(); 5 | ports.init(app); 6 | 7 | // leak reference to app for injecting example 8 | window.app = app; 9 | -------------------------------------------------------------------------------- /elm-module-graph.py: -------------------------------------------------------------------------------- 1 | #!/usr/bin/python 2 | 3 | import argparse 4 | import json 5 | import io 6 | import os 7 | import re 8 | import sys 9 | 10 | 11 | re_import = re.compile(r"{-.*?-}|^import\s+([A-Z][\w\.]*)", re.DOTALL | re.MULTILINE) 12 | 13 | # source text -> [modulename] 14 | def extract_imports(text): 15 | return filter(lambda s: s != "" and s[0:7] != "Native.", re_import.findall(text)) 16 | 17 | 18 | # source text -> modulename 19 | def extract_modulename(text): 20 | match = re.match(r"(?:port )?module\s+([A-Z][\w\.]*)", text) 21 | return match.group(1) if match is not None else None 22 | 23 | 24 | # repo path -> "/" 25 | def extract_packagename(repository): 26 | match = re.search(r"([^\/]+\/[^\/]+?)(\.\w+)?$", repository) 27 | return match.group(1) if match is not None else None 28 | 29 | 30 | # -> maybe filepath of nearest elm-package.json 31 | def find_elmpackagejson(path): 32 | elmpackagejson = os.path.join(path, "elm-package.json") 33 | if not os.path.exists(path) or os.path.ismount(path): 34 | return None 35 | elif os.path.isfile(elmpackagejson): 36 | return elmpackagejson 37 | else: 38 | return find_elmpackagejson(os.path.dirname(path)) 39 | 40 | 41 | # -> {"sourcedirs": [dir], "dependencies": [packagename]} 42 | def get_packageinfo(packagedir): 43 | elmpackagedata = json.load(open(os.path.join(packagedir, "elm-package.json"))) 44 | return { 45 | "sourcedirs": map( 46 | lambda dir: os.path.normpath(os.path.join(packagedir, dir)), 47 | elmpackagedata.get("source-directories", []) 48 | ), 49 | "dependencies": elmpackagedata.get("dependencies", {}).keys() 50 | } 51 | 52 | 53 | # -> (packagename, modulename, sourcepath) 54 | def find_importedmodule(packages, packagename, importedmodulename): 55 | sourcedirs = map(tuple(packagename), packages[packagename]["sourcedirs"]) 56 | dependencysourcedirs = concatmap(lambda dep: map(tuple(dep), packages[dep]["sourcedirs"]), packages[packagename]["dependencies"]) 57 | 58 | segments = importedmodulename.split(".") 59 | for (importedpackagename, sourcedir) in (sourcedirs + dependencysourcedirs): 60 | sourcepath = os.path.join(sourcedir, *segments) + ".elm" 61 | if os.path.isfile(sourcepath): 62 | return (importedpackagename, importedmodulename, sourcepath) 63 | 64 | print "warning: source file not found for module (" + importedmodulename +") as imported from (" + packagename + ")" 65 | return None 66 | 67 | 68 | def tuple(a): 69 | return lambda b: (a, b) 70 | 71 | 72 | def concatmap(f, list): 73 | return reduce(lambda r, x: r + f(x), list, []) 74 | 75 | 76 | # -> {qualifiedmodulename: {"imports": [qualifiedmodulename], "package": packagename}} 77 | def graph_from_imports(packages, packagename, modulename, importedmodulenames, graph): 78 | importedmodules = filter( 79 | lambda x: x is not None, 80 | map(lambda m: find_importedmodule(packages, packagename, m), importedmodulenames) 81 | ) 82 | graph[qualify(packagename, modulename)] = { 83 | "imports": map(lambda (p, m, _): qualify(p, m), importedmodules), 84 | "package": packagename 85 | } 86 | return reduce( 87 | lambda g, (p, m, sourcepath): graph_from_imports(packages, p, m, extract_imports(open(sourcepath).read()), g), 88 | filter( 89 | lambda (p, m, _): qualify(p, m) not in graph, 90 | importedmodules 91 | ), 92 | graph 93 | ) 94 | 95 | 96 | def qualify(packagename, modulename): 97 | return packagename + " " + modulename 98 | 99 | 100 | def main(): 101 | parser = argparse.ArgumentParser() 102 | parser.add_argument("-o", "--output", default="module-graph.json", help="file to write to (default: module-graph.json)") 103 | parser.add_argument("filepath", help="path to .elm file or elm-package.json") 104 | args = parser.parse_args() 105 | 106 | filepath = os.path.abspath(args.filepath) 107 | 108 | if not os.path.isfile(filepath): 109 | print "error: file not found: " + filepath 110 | sys.exit(1) 111 | 112 | elmpackagejson = filepath if os.path.basename(filepath) == "elm-package.json" else find_elmpackagejson(filepath) 113 | 114 | if elmpackagejson is None: 115 | print "error: elm-package.json not found for: " + filepath 116 | sys.exit(1) 117 | 118 | projectdir = os.path.dirname(elmpackagejson) 119 | 120 | if not os.path.exists(os.path.join(projectdir, "elm-stuff")): 121 | print "error: elm-stuff folder not found (run elm-make and try again)" 122 | sys.exit(1) 123 | 124 | # packages (dict), projectname, entryname, modulenames (list) 125 | elmpackagedata = json.load(open(elmpackagejson)) 126 | projectname = extract_packagename(elmpackagedata.get("repository", "")) or "user/project" 127 | 128 | packages = {projectname: get_packageinfo(projectdir)} 129 | for (packagename, version) in json.load(open(os.path.join(projectdir, "elm-stuff", "exact-dependencies.json"))).items(): 130 | packages[packagename] = get_packageinfo(os.path.join(projectdir, "elm-stuff", "packages", packagename, version)) 131 | 132 | if filepath == elmpackagejson: 133 | entryname = "exposed-modules" 134 | modulenames = elmpackagedata.get("exposed-modules", []) 135 | else: 136 | sourcetext = open(filepath).read() 137 | entryname = extract_modulename(sourcetext) or "Main" 138 | modulenames = extract_imports(sourcetext) 139 | 140 | # graph 141 | modulegraph = graph_from_imports(packages, projectname, entryname, modulenames, {}) 142 | 143 | output = io.open(args.output, "w", encoding="utf-8") 144 | output.write(unicode(json.dumps(modulegraph, indent=2, separators=[",", ": "]), encoding="utf-8-sig")) 145 | output.close() 146 | 147 | 148 | if __name__ == "__main__": 149 | main() 150 | -------------------------------------------------------------------------------- /elm-package.json: -------------------------------------------------------------------------------- 1 | { 2 | "version": "1.0.0", 3 | "summary": "Visually explore package and module dependencies for an Elm project", 4 | "repository": "https://github.com/justinmimbs/elm-module-graph.git", 5 | "license": "BSD3", 6 | "source-directories": [ 7 | "src" 8 | ], 9 | "exposed-modules": [], 10 | "dependencies": { 11 | "elm-lang/core": "5.0.0 <= v < 6.0.0", 12 | "elm-lang/html": "2.0.0 <= v < 3.0.0", 13 | "elm-lang/svg": "2.0.0 <= v < 3.0.0", 14 | "justinmimbs/elm-arc-diagram": "1.0.0 <= v < 2.0.0" 15 | }, 16 | "elm-version": "0.18.0 <= v < 0.19.0" 17 | } 18 | -------------------------------------------------------------------------------- /package.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "elm-module-graph", 3 | "author": "Justin Mimbs ", 4 | "description": "", 5 | "repository": { 6 | "type": "git", 7 | "url": "https://github.com/justinmimbs/elm-module-graph.git" 8 | }, 9 | "devDependencies": { 10 | "elm-webpack-loader": "4.x.x", 11 | "webpack": "1.x.x", 12 | "webpack-dev-server": "1.x.x" 13 | }, 14 | "scripts": { 15 | "build": "BUILD_ENV=production webpack", 16 | "dev": "webpack-dev-server --port=8000" 17 | } 18 | } 19 | -------------------------------------------------------------------------------- /src/Main.elm: -------------------------------------------------------------------------------- 1 | module Main exposing (main) 2 | 3 | import Dict 4 | import Html exposing (Html) 5 | import Html.Attributes 6 | import Html.Events 7 | import Json.Decode 8 | import ModuleGraph 9 | import Ports exposing (File) 10 | 11 | 12 | main : Program Never Model Msg 13 | main = 14 | Html.program 15 | { init = ( NoFile False, Cmd.none ) 16 | , update = update 17 | , view = view 18 | , subscriptions = subscriptions 19 | } 20 | 21 | 22 | type Model 23 | = NoFile Bool 24 | | SelectedFile (Result String ModuleGraph.Model) 25 | 26 | 27 | type Msg 28 | = RequestFileInputData 29 | | ReceiveFileInputData (Maybe File) 30 | | ModuleGraphMsg ModuleGraph.Msg 31 | 32 | 33 | fileInputId : String 34 | fileInputId = 35 | "file-input" 36 | 37 | 38 | subscriptions : Model -> Sub Msg 39 | subscriptions _ = 40 | Ports.fileInputData (Tuple.second >> Maybe.map Ports.toFile >> ReceiveFileInputData) 41 | 42 | 43 | update : Msg -> Model -> ( Model, Cmd Msg ) 44 | update msg state = 45 | case msg of 46 | RequestFileInputData -> 47 | ( NoFile True 48 | , Ports.requestFileInputData fileInputId 49 | ) 50 | 51 | ReceiveFileInputData mFile -> 52 | ( mFile 53 | |> Maybe.map (SelectedFile << resultFromFile) 54 | |> Maybe.withDefault (NoFile False) 55 | , Cmd.none 56 | ) 57 | 58 | ModuleGraphMsg msg_ -> 59 | ( case state of 60 | SelectedFile (Ok moduleGraph) -> 61 | SelectedFile (Ok (moduleGraph |> ModuleGraph.update msg_)) 62 | 63 | _ -> 64 | state 65 | , Cmd.none 66 | ) 67 | 68 | 69 | resultFromFile : File -> Result String ModuleGraph.Model 70 | resultFromFile file = 71 | file.content 72 | |> Result.andThen 73 | (Json.Decode.decodeString ModuleGraph.decodeInput) 74 | |> Result.map 75 | ModuleGraph.init 76 | 77 | 78 | view : Model -> Html Msg 79 | view state = 80 | let 81 | isAwaitingFile = 82 | case state of 83 | NoFile True -> 84 | True 85 | 86 | _ -> 87 | False 88 | in 89 | Html.div 90 | [ Html.Attributes.style 91 | [ ( "margin", "40px" ) 92 | , ( "font-family", "Helvetica, Arial, san-serif" ) 93 | , ( "font-size", "12px" ) 94 | ] 95 | ] 96 | [ Html.input 97 | [ Html.Attributes.type_ "file" 98 | , Html.Attributes.id fileInputId 99 | , Html.Attributes.disabled isAwaitingFile 100 | , Html.Attributes.style 101 | [ ( "width", "300px" ) 102 | , ( "margin-bottom", "20px" ) 103 | , ( "font-size", "12px" ) 104 | ] 105 | , Html.Events.on "change" (Json.Decode.succeed RequestFileInputData) 106 | ] 107 | [] 108 | , case state of 109 | SelectedFile (Ok moduleGraph) -> 110 | ModuleGraph.view moduleGraph |> Html.map ModuleGraphMsg 111 | 112 | SelectedFile (Err error) -> 113 | viewSection 114 | [ Html.text error 115 | ] 116 | 117 | NoFile _ -> 118 | viewSection 119 | [ Html.text "To explore package and module dependencies for an Elm project, generate a " 120 | , Html.a [ Html.Attributes.href "https://github.com/justinmimbs/elm-module-graph" ] [ Html.text "module-graph.json" ] 121 | , Html.text " file, and provide it above." 122 | ] 123 | ] 124 | 125 | 126 | viewSection : List (Html a) -> Html a 127 | viewSection = 128 | Html.div 129 | [ Html.Attributes.style 130 | [ ( "width", "360px" ) 131 | , ( "margin-top", "20px" ) 132 | ] 133 | ] 134 | -------------------------------------------------------------------------------- /src/ModuleGraph.elm: -------------------------------------------------------------------------------- 1 | module ModuleGraph exposing (Input, decodeInput, Model, init, Msg, update, view) 2 | 3 | import AcyclicDigraph exposing (Node, Edge, Cycle, AcyclicDigraph) 4 | import ArcDiagram 5 | import ArcDiagram.Distance 6 | import Dict exposing (Dict) 7 | import Html exposing (Html) 8 | import Html.Attributes 9 | import Json.Decode exposing (Decoder) 10 | import Set exposing (Set) 11 | import Svg exposing (Svg) 12 | import Svg.Attributes 13 | 14 | 15 | -- Input 16 | 17 | 18 | type alias Input = 19 | Dict String ( Set String, String ) 20 | 21 | 22 | decodeInput : Decoder Input 23 | decodeInput = 24 | Json.Decode.dict 25 | (Json.Decode.map2 26 | (,) 27 | (Json.Decode.field "imports" <| Json.Decode.map Set.fromList <| Json.Decode.list Json.Decode.string) 28 | (Json.Decode.field "package" Json.Decode.string) 29 | ) 30 | 31 | 32 | 33 | -- Model 34 | 35 | 36 | type alias Model = 37 | { graphs : Graphs 38 | , excludedPackages : Set Node 39 | , selectedModule : Maybe Node 40 | } 41 | 42 | 43 | type alias Graphs = 44 | { packages : ( Set Edge, Dict Node String ) 45 | , modules : ( Set Edge, Dict Node ( String, String ) ) 46 | } 47 | 48 | 49 | init : Input -> Model 50 | init input = 51 | let 52 | graphs = 53 | graphsFromInput input 54 | in 55 | Model 56 | graphs 57 | (initExcludedPackages (graphs.packages |> Tuple.second)) 58 | Nothing 59 | 60 | 61 | graphsFromInput : Input -> Graphs 62 | graphsFromInput input = 63 | let 64 | moduleIdFromName : String -> Node 65 | moduleIdFromName = 66 | input 67 | |> Dict.keys 68 | |> List.indexedMap (flip (,)) 69 | |> Dict.fromList 70 | |> lookup -1 71 | 72 | --(Set Edge, Dict Node (String, String)) 73 | ( moduleEdges, moduleLabels ) = 74 | input 75 | |> Dict.foldl 76 | (\moduleName ( imports, packageName ) ( edges, labels ) -> 77 | let 78 | moduleId = 79 | moduleIdFromName moduleName 80 | in 81 | ( Set.union 82 | (imports |> Set.map ((flip (,)) moduleId << moduleIdFromName)) 83 | edges 84 | , Dict.insert 85 | moduleId 86 | ( secondWord moduleName |> Maybe.withDefault moduleName, packageName ) 87 | labels 88 | ) 89 | ) 90 | ( Set.empty, Dict.empty ) 91 | 92 | packageNameFromModuleId : Node -> String 93 | packageNameFromModuleId = 94 | (flip Dict.get) moduleLabels >> Maybe.map Tuple.second >> Maybe.withDefault "" 95 | 96 | packageNameEdges : Set ( String, String ) 97 | packageNameEdges = 98 | moduleEdges 99 | |> Set.map (mapTuple packageNameFromModuleId) 100 | |> Set.filter (uncurry (/=)) 101 | 102 | packageIdFromName : Dict String Node 103 | packageIdFromName = 104 | packageNameEdges 105 | |> Set.foldl 106 | (\( x, y ) -> Set.insert x >> Set.insert y) 107 | Set.empty 108 | |> Set.toList 109 | |> List.indexedMap (flip (,)) 110 | |> Dict.fromList 111 | in 112 | Graphs 113 | ( packageNameEdges |> Set.map (mapTuple (lookup -1 packageIdFromName)) 114 | , invertDict packageIdFromName 115 | ) 116 | ( moduleEdges, moduleLabels ) 117 | 118 | 119 | secondWord : String -> Maybe String 120 | secondWord = 121 | String.words >> List.drop 1 >> List.head 122 | 123 | 124 | initExcludedPackages : Dict Node String -> Set Node 125 | initExcludedPackages packageLabels = 126 | [ "elm-lang/core", "elm-lang/html", "elm-lang/virtual-dom" ] 127 | |> List.filterMap 128 | ((flip Dict.get) (invertDict packageLabels)) 129 | |> Set.fromList 130 | 131 | 132 | 133 | -- Msg 134 | 135 | 136 | type Msg 137 | = ToggleModule Node 138 | | TogglePackage Node 139 | 140 | 141 | update : Msg -> Model -> Model 142 | update msg model = 143 | case msg of 144 | ToggleModule node -> 145 | { model | selectedModule = model.selectedModule |> toggleMaybe node } 146 | 147 | TogglePackage node -> 148 | { model | excludedPackages = model.excludedPackages |> toggleSet node } 149 | 150 | 151 | 152 | -- view 153 | 154 | 155 | defaultLayout : ArcDiagram.Layout 156 | defaultLayout = 157 | ArcDiagram.defaultLayout 158 | 159 | 160 | packagesLayout : ArcDiagram.Layout 161 | packagesLayout = 162 | { defaultLayout 163 | | nodePadding = 2 164 | , labelWidth = 240 165 | , labelMinHeight = 18 166 | } 167 | 168 | 169 | modulesLayout : ArcDiagram.Layout 170 | modulesLayout = 171 | { packagesLayout 172 | | labelWidth = 360 173 | } 174 | 175 | 176 | view : Model -> Html Msg 177 | view { graphs, excludedPackages, selectedModule } = 178 | let 179 | ( packageEdges, packageLabels ) = 180 | graphs.packages 181 | 182 | ( moduleEdges, moduleLabels ) = 183 | graphs.modules 184 | 185 | packageNameFromId = 186 | lookup "" packageLabels 187 | 188 | moduleLabelFromId = 189 | lookup ( "", "" ) moduleLabels 190 | 191 | isExcludedPackage = 192 | (flip Set.member) excludedPackages 193 | 194 | packageView = 195 | packageEdges 196 | |> AcyclicDigraph.fromEdges 197 | |> unpack 198 | (viewCycles packageNameFromId) 199 | (ArcDiagram.view 200 | packagesLayout 201 | { viewLabel = viewLabel << isExcludedPackage <<* packageNameFromId 202 | , colorNode = nodeColor << isExcludedPackage 203 | , colorEdge = edgeColor << (mapTuple isExcludedPackage) 204 | } 205 | ) 206 | 207 | excludedPackageNames = 208 | Set.map packageNameFromId excludedPackages 209 | 210 | includedModuleIds = 211 | Dict.foldl 212 | (\moduleId ( _, packageName ) set -> 213 | if Set.member packageName excludedPackageNames then 214 | set 215 | else 216 | Set.insert moduleId set 217 | ) 218 | Set.empty 219 | moduleLabels 220 | 221 | moduleView = 222 | moduleEdges 223 | |> induceSubgraph includedModuleIds 224 | |> AcyclicDigraph.fromEdges 225 | |> unpack 226 | (viewCycles (moduleLabelFromId >> Tuple.first)) 227 | (viewModulesDiagram moduleLabelFromId selectedModule) 228 | in 229 | Html.div 230 | [ Html.Attributes.style 231 | [ ( "font-family", "Helvetica, Arial, san-serif" ) 232 | ] 233 | ] 234 | [ viewSection 235 | [ viewHeader "Packages" (Dict.size packageLabels) 236 | , packageView |> Html.map TogglePackage 237 | ] 238 | , viewSection 239 | [ viewHeader "Modules" (Set.size includedModuleIds) 240 | , moduleView |> Html.map ToggleModule 241 | ] 242 | ] 243 | 244 | 245 | viewSection : List (Html a) -> Html a 246 | viewSection = 247 | Html.div 248 | [ Html.Attributes.style 249 | [ ( "margin", "20px 0 40px" ) 250 | ] 251 | ] 252 | 253 | 254 | viewCycles : (Node -> String) -> List Cycle -> Html a 255 | viewCycles toLabel cycles = 256 | Html.div 257 | [] 258 | [ Html.text "Graph has the following cycles:" 259 | , Html.ol 260 | [ Html.Attributes.style 261 | [ ( "font-family", labelFontFamily ) 262 | ] 263 | ] 264 | (cycles |> List.map (viewCycle toLabel)) 265 | ] 266 | 267 | 268 | viewCycle : (Node -> String) -> Cycle -> Html a 269 | viewCycle toLabel cycle = 270 | Html.li 271 | [] 272 | [ Html.text (cycle |> List.map toLabel |> String.join " -> ") ] 273 | 274 | 275 | viewHeader : String -> Int -> Html a 276 | viewHeader title n = 277 | Html.h2 278 | [ Html.Attributes.style 279 | [ ( "margin", "0 0 20px" ) 280 | , ( "font-size", "20px" ) 281 | , ( "font-weight", "normal" ) 282 | ] 283 | ] 284 | [ Html.text <| title ++ " (" ++ toString n ++ ")" 285 | ] 286 | 287 | 288 | defaultPaint : ArcDiagram.Paint 289 | defaultPaint = 290 | ArcDiagram.defaultPaint 291 | 292 | 293 | defaultDistancePaint = 294 | ArcDiagram.Distance.defaultDistancePaint 295 | 296 | 297 | viewModulesDiagram : (Node -> ( String, String )) -> Maybe Node -> AcyclicDigraph -> Html Node 298 | viewModulesDiagram moduleLabelFromNode selectedNode graph = 299 | let 300 | paint : ArcDiagram.Paint 301 | paint = 302 | case selectedNode of 303 | Just node -> 304 | ArcDiagram.Distance.paint 305 | { defaultDistancePaint 306 | | viewLabel = \n d -> viewLabelPair (isNothing d) (moduleLabelFromNode n) 307 | } 308 | graph 309 | node 310 | 311 | Nothing -> 312 | { defaultPaint 313 | | viewLabel = moduleLabelFromNode >> (viewLabelPair False) 314 | } 315 | in 316 | ArcDiagram.view 317 | modulesLayout 318 | paint 319 | graph 320 | 321 | 322 | induceSubgraph : Set Node -> Set Edge -> Set Edge 323 | induceSubgraph nodes = 324 | Set.filter 325 | (\( x, y ) -> 326 | Set.member x nodes && Set.member y nodes 327 | ) 328 | 329 | 330 | edgeColor : ( Bool, Bool ) -> String 331 | edgeColor ( xIsDimmed, yIsDimmed ) = 332 | if xIsDimmed || yIsDimmed then 333 | "rgba(0, 0, 0, 0.1)" 334 | else 335 | "gray" 336 | 337 | 338 | nodeColor : Bool -> String 339 | nodeColor isDimmed = 340 | if isDimmed then 341 | "rgb(200, 200, 200)" 342 | else 343 | "black" 344 | 345 | 346 | labelFontFamily : String 347 | labelFontFamily = 348 | "Menlo, Monaco, Consolas, monospace" 349 | 350 | 351 | labelAttributes : List (Svg.Attribute a) 352 | labelAttributes = 353 | [ Svg.Attributes.x "4px" 354 | , Svg.Attributes.fontFamily labelFontFamily 355 | , Svg.Attributes.fontSize "11px" 356 | , Svg.Attributes.dominantBaseline "middle" 357 | ] 358 | 359 | 360 | labelText : Bool -> String -> Svg a 361 | labelText isDimmed label = 362 | Svg.tspan 363 | [ Svg.Attributes.fill (nodeColor isDimmed) 364 | ] 365 | [ Svg.text label 366 | ] 367 | 368 | 369 | viewLabel : Bool -> String -> Svg a 370 | viewLabel isDimmed label = 371 | Svg.text_ 372 | labelAttributes 373 | [ labelText isDimmed label 374 | ] 375 | 376 | 377 | viewLabelPair : Bool -> ( String, String ) -> Svg a 378 | viewLabelPair isDimmed ( label, sublabel ) = 379 | Svg.text_ 380 | labelAttributes 381 | [ labelText isDimmed label 382 | , labelText True <| " (" ++ sublabel ++ ")" 383 | ] 384 | 385 | 386 | 387 | -- extra 388 | 389 | 390 | isNothing : Maybe a -> Bool 391 | isNothing m = 392 | case m of 393 | Just _ -> 394 | False 395 | 396 | Nothing -> 397 | True 398 | 399 | 400 | toggleMaybe : a -> Maybe a -> Maybe a 401 | toggleMaybe a ma = 402 | if ma == Just a then 403 | Nothing 404 | else 405 | Just a 406 | 407 | 408 | unpack : (e -> x) -> (a -> x) -> Result e a -> x 409 | unpack fromErr fromOk result = 410 | case result of 411 | Err e -> 412 | fromErr e 413 | 414 | Ok a -> 415 | fromOk a 416 | 417 | 418 | mapTuple : (a -> b) -> ( a, a ) -> ( b, b ) 419 | mapTuple f ( x, y ) = 420 | ( f x, f y ) 421 | 422 | 423 | toggleSet : comparable -> Set comparable -> Set comparable 424 | toggleSet a set = 425 | if Set.member a set then 426 | Set.remove a set 427 | else 428 | Set.insert a set 429 | 430 | 431 | lookup : v -> Dict comparable v -> comparable -> v 432 | lookup default dict = 433 | (flip Dict.get) dict >> Maybe.withDefault default 434 | 435 | 436 | {-| Given a Dict x y, return the Dict y x. Assume the Dict represents a 437 | bijective mapping. 438 | -} 439 | invertDict : Dict comparable comparable1 -> Dict comparable1 comparable 440 | invertDict = 441 | Dict.foldl 442 | (flip Dict.insert) 443 | Dict.empty 444 | 445 | 446 | infixl 8 <<* 447 | (<<*) : (x -> a -> b) -> (x -> a) -> x -> b 448 | (<<*) f g x = 449 | f x (g x) 450 | -------------------------------------------------------------------------------- /src/Ports.elm: -------------------------------------------------------------------------------- 1 | port module Ports exposing (FileJson, File, toFile, requestFileInputData, fileInputData) 2 | 3 | 4 | type alias File = 5 | { name : String 6 | , content : Result String String 7 | } 8 | 9 | 10 | type alias FileJson = 11 | { name : String 12 | , error : Maybe String 13 | , content : Maybe String 14 | } 15 | 16 | 17 | type alias Id = 18 | String 19 | 20 | 21 | toFile : FileJson -> File 22 | toFile { name, error, content } = 23 | File 24 | name 25 | (content 26 | |> Maybe.map Ok 27 | |> Maybe.withDefault (Err (error |> Maybe.withDefault "No error message provided")) 28 | ) 29 | 30 | 31 | port requestFileInputData : Id -> Cmd a 32 | 33 | 34 | port fileInputData : (( Id, Maybe FileJson ) -> a) -> Sub a 35 | -------------------------------------------------------------------------------- /src/ports.js: -------------------------------------------------------------------------------- 1 | function requestFileInputData(id, callback) { 2 | var input = document.getElementById(id); 3 | if (input === null || input.type !== 'file') { 4 | return; 5 | } 6 | 7 | var maxFileSize = 512 * 1024; 8 | var file = input.files[0]; 9 | 10 | if (file === undefined) { 11 | callback([id, null]); 12 | 13 | } else if (file.size > maxFileSize) { 14 | callback([id, { 15 | name : file.name, 16 | error: 'File is larger than the maximum allowed (' + Math.round(maxFileSize / 1024) + ' KB)', 17 | content: null 18 | }]); 19 | 20 | } else { 21 | var fileReader = new FileReader(); 22 | 23 | fileReader.addEventListener('error', function () { 24 | callback([id, { 25 | name: file.name, 26 | error: 'File could not be loaded: ' + fileReader.error.name, 27 | content: null 28 | }]); 29 | }); 30 | 31 | fileReader.addEventListener('load', function () { 32 | callback([id, { 33 | name: file.name, 34 | error: null, 35 | content: fileReader.result 36 | }]); 37 | }); 38 | 39 | fileReader.readAsText(file); 40 | } 41 | } 42 | 43 | module.exports = { 44 | init: function (app) { 45 | app.ports.requestFileInputData.subscribe(function (id) { 46 | requestFileInputData(id, app.ports.fileInputData.send); 47 | }); 48 | } 49 | }; 50 | -------------------------------------------------------------------------------- /webpack.config.js: -------------------------------------------------------------------------------- 1 | var webpack = require('webpack'); 2 | 3 | var BUILD_ENV = process.env.BUILD_ENV || 'development'; 4 | 5 | module.exports = { 6 | entry: './app/index.js', 7 | output: { 8 | path: 'app', 9 | publicPath: 'app', 10 | filename: 'script.js', 11 | }, 12 | module: { 13 | noParse: [/\.elm$/], 14 | loaders: [ 15 | { 16 | test: /\.elm$/, 17 | exclude: [/elm-stuff/, /node_modules/], 18 | loader: 'elm-webpack-loader?cwd=' + __dirname, 19 | }, 20 | ], 21 | }, 22 | plugins: [ 23 | ].concat( 24 | BUILD_ENV === 'production' 25 | ? [ 26 | new webpack.optimize.UglifyJsPlugin({ 27 | test: /\.js$/, 28 | sourceMap: false, 29 | compress: { 30 | warnings: false, 31 | screw_ie8: true, 32 | }, 33 | }), 34 | ] 35 | : [] 36 | ), 37 | }; 38 | --------------------------------------------------------------------------------