diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,20 @@ +Copyright (c) 2015 ncaq + +Permission is hereby granted, free of charge, to any person obtaining +a copy of this software and associated documentation files (the +"Software"), to deal in the Software without restriction, including +without limitation the rights to use, copy, modify, merge, publish, +distribute, sublicense, and/or sell copies of the Software, and to +permit persons to whom the Software is furnished to do so, subject to +the following conditions: + +The above copyright notice and this permission notice shall be included +in all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. +IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY +CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, +TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE +SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/exec/Main.hs b/exec/Main.hs new file mode 100644 --- /dev/null +++ b/exec/Main.hs @@ -0,0 +1,6 @@ +module Main where +import Prelude (IO) +import System.ImportGraph.AppMain (appMain) + +main :: IO () +main = appMain diff --git a/haskell-import-graph.cabal b/haskell-import-graph.cabal new file mode 100644 --- /dev/null +++ b/haskell-import-graph.cabal @@ -0,0 +1,51 @@ +name: haskell-import-graph +version: 1.0.0 +synopsis: create haskell import graph for graphviz +description: { +create haskell import graph for graphviz +How to: +> cabal build +> haskell-import-graph +Or, +> haskell-import-graph dist/build/foo/foo-tmp/bar.hi +} +license: MIT +license-file: LICENSE +author: ncaq +maintainer: ncaq@ncaq.net +copyright: Copyright (c) 2015 ncaq +category: Development +build-type: Simple +cabal-version: >=1.10 + +source-repository head + type: git + location: https://github.com/ncaq/haskell-import-graph.git + +library + hs-source-dirs: lib + exposed-modules: System.ImportGraph.AppMain + , System.ImportGraph.GetIface + , System.ImportGraph.ModuleCluster + + ghc-options: -Wall -fwarn-incomplete-uni-patterns -fwarn-monomorphism-restriction -fwarn-identities + default-language: Haskell2010 + default-extensions: NamedFieldPuns + NoImplicitPrelude + OverloadedStrings + RecordWildCards + + build-depends: base >= 4.8 && < 4.9 + , classy-prelude >= 0.12 && < 0.13 + , ghc >= 7.10 && < 7.11 + , graphviz >= 2999 && < 3000 + , process >= 1.2 && < 1.3 + , text >= 1.2 && < 1.3 + , transformers >= 0.4 && < 0.5 + +executable haskell-import-graph + hs-source-dirs: exec + main-is: Main.hs + ghc-options: -Wall -fwarn-incomplete-uni-patterns -fwarn-monomorphism-restriction -fwarn-identities + default-language: Haskell2010 + build-depends: base, haskell-import-graph diff --git a/lib/System/ImportGraph/AppMain.hs b/lib/System/ImportGraph/AppMain.hs new file mode 100644 --- /dev/null +++ b/lib/System/ImportGraph/AppMain.hs @@ -0,0 +1,45 @@ +module System.ImportGraph.AppMain where +import ClassyPrelude +import Data.GraphViz +import Data.GraphViz.Attributes.Complete +import Data.GraphViz.Printing (renderDot) +import qualified Data.GraphViz.Types.Generalised as G +import Data.GraphViz.Types.Monadic +import qualified Data.Text.Lazy as L +import qualified Data.Text.Lazy.IO as L +import GHC +import System.ImportGraph.GetIface +import System.ImportGraph.ModuleCluster +import System.Process + +appMain :: IO () +appMain = do + args <- getArgs + libDir <- getLibDirReadProcess + runGhc libDir $ + case args of + ["-h"] -> liftIO $ L.putStrLn help + ["--help"] -> liftIO $ L.putStrLn help + [] -> do + ifaces <- findIfaces + liftIO . L.putStrLn $ renderGraph ifaces + [hiPath] -> do + iface <- getIface $ unpack hiPath + liftIO . L.putStrLn $ renderGraph [iface] + _ -> liftIO $ L.putStrLn help + +getLibDirReadProcess :: IO (Maybe FilePath) +getLibDirReadProcess = listToMaybe . lines <$> readProcess "ghc" ["--print-libdir"] "" + +help :: L.Text +help = unlines [ "Usage: cabal build && haskell-import-graph" + , "or: cabal build && haskell-import-graph dist/build/foo/foo-tmp/bar.hi" + ] + +renderGraph :: [ModIface] -> L.Text +renderGraph = renderDot . toDot . importGraph (Str "haskell-import-graph") + +importGraph :: GraphID -> [ModIface] -> G.DotGraph L.Text +importGraph graphName mods = digraph graphName $ do + graphAttrs [Compound True, RankDir FromLeft] + mapM moduleCluster mods diff --git a/lib/System/ImportGraph/GetIface.hs b/lib/System/ImportGraph/GetIface.hs new file mode 100644 --- /dev/null +++ b/lib/System/ImportGraph/GetIface.hs @@ -0,0 +1,20 @@ +module System.ImportGraph.GetIface where +import BinIface +import ClassyPrelude +import GHC +import System.Process +import TcRnMonad + +findIfaces :: Ghc [ModIface] +findIfaces = do + his <- liftIO findHiFiles + _ <- setSessionDynFlags =<< getSessionDynFlags + mapM getIface his + +findHiFiles :: IO [FilePath] +findHiFiles = lines <$> readProcess "find" ["-iname", "*.hi"] "" + +getIface :: FilePath -> Ghc ModIface +getIface filename = do + hsc_env <- getSession + liftIO . initTcRnIf 's' hsc_env () () $ readBinIface IgnoreHiWay QuietBinIFaceReading filename diff --git a/lib/System/ImportGraph/ModuleCluster.hs b/lib/System/ImportGraph/ModuleCluster.hs new file mode 100644 --- /dev/null +++ b/lib/System/ImportGraph/ModuleCluster.hs @@ -0,0 +1,43 @@ +module System.ImportGraph.ModuleCluster where +import Avail +import ClassyPrelude +import Data.GraphViz +import Data.GraphViz.Attributes.Complete +import Data.GraphViz.Types.Monadic +import qualified Data.Text.Lazy as L +import HscTypes +import Module +import Name + +moduleCluster :: ModIface -> Dot L.Text +moduleCluster iface@ModIface{..} = do + cluster (Str (ifaceName iface)) $ do + graphAttrs [textLabel (ifaceName iface)] + node (ifaceDummyNodeName iface) [Style [SItem Invisible []]] + mapM node' exports + mapM_ (ifaceUsageEdges iface) mi_usages + where exports = map (pack . getOccString . availName) mi_exports + +ifaceName :: ModIface -> L.Text +ifaceName = moduleText . mi_module + +moduleText :: Module -> L.Text +moduleText = pack . moduleNameString . moduleName + +ifaceDummyNodeName :: ModIface -> L.Text +ifaceDummyNodeName iface = ifaceName iface <> "_dummy_node" + +ifaceClusterName :: ModIface -> L.Text +ifaceClusterName iface = "cluster_" <> ifaceName iface + +ifaceUsageEdges :: ModIface -> Usage -> Dot L.Text +ifaceUsageEdges iface UsagePackageModule{..} = do + ifaceEdge iface (moduleText usg_mod) + node (moduleText usg_mod) [Shape Component] +ifaceUsageEdges iface UsageHomeModule{..} = + mapM_ (ifaceEdge iface . pack . occNameString . fst) usg_entities +ifaceUsageEdges iface UsageFile{..} = + ifaceEdge iface (pack usg_file_path) + +ifaceEdge :: ModIface -> L.Text -> Dot L.Text +ifaceEdge iface edgeTo = edge (ifaceDummyNodeName iface) edgeTo [LTail (ifaceClusterName iface)]