diff --git a/Analyse/Everything.hs b/Analyse/Everything.hs --- a/Analyse/Everything.hs +++ b/Analyse/Everything.hs @@ -79,11 +79,11 @@ $ map funcCalls pms' vs = S.filter (not . internalEntity) . S.unions $ map virtualEnts pms' - params = Params { dataPoints = ents - , relationships = calls - , roots = exps' - , directed = True - } + params = ImpParams { dataPoints = ents + , relationships = calls + , roots = exps' + , directed = True + } graphOf :: HData' -> Maybe DocElement graphOf cd = Just $ Section sec [gc] diff --git a/Analyse/Imports.hs b/Analyse/Imports.hs --- a/Analyse/Imports.hs +++ b/Analyse/Imports.hs @@ -61,11 +61,11 @@ importsToGraph :: [ModName] -> ParsedModules -> MData importsToGraph exps pms = mkMData $ importData params where - params = Params { dataPoints = M.keys pms - , relationships = moduleImports pms - , roots = exps - , directed = True - } + params = ImpParams { dataPoints = M.keys pms + , relationships = moduleImports pms + , roots = exps + , directed = True + } moduleImports :: ParsedModules -> [Rel ModName ()] moduleImports = concatMap imps . M.elems diff --git a/Analyse/Module.hs b/Analyse/Module.hs --- a/Analyse/Module.hs +++ b/Analyse/Module.hs @@ -87,12 +87,12 @@ n = applyAlg noNodes fd fd = importData params vs = virtualEnts hm - params = Params { dataPoints = S.toList $ internalEnts hm - , relationships = MS.toList . MS.map callToRel - $ funcCalls hm - , roots = S.toList $ exports hm - , directed = True - } + params = ImpParams { dataPoints = S.toList $ internalEnts hm + , relationships = MS.toList . MS.map callToRel + $ funcCalls hm + , roots = S.toList $ exports hm + , directed = True + } graphOf :: ModuleData -> Maybe DocElement graphOf (n,m,fd) = Just $ Section sec [gi] diff --git a/Analyse/Utils.hs b/Analyse/Utils.hs --- a/Analyse/Utils.hs +++ b/Analyse/Utils.hs @@ -30,7 +30,6 @@ module Analyse.Utils where import Data.Graph.Analysis hiding (Bold) -import Data.Graph.Inductive hiding (graphviz) import Data.List(groupBy, sortBy) import Data.Function(on) diff --git a/Analyse/Visualise.hs b/Analyse/Visualise.hs --- a/Analyse/Visualise.hs +++ b/Analyse/Visualise.hs @@ -35,10 +35,9 @@ import Analyse.Colors import Data.Graph.Analysis hiding (Bold) -import Data.Graph.Inductive import Data.GraphViz -import Data.Maybe(isJust, maybe) +import Data.Maybe(isNothing) import Data.List(find) import qualified Data.Set as S @@ -47,30 +46,23 @@ -- | Create the nested 'DotGraph'. drawGraph :: String -> Maybe ModName -> HData' -> DotGraph Node drawGraph gid mm dg = setID (Str gid) - $ graphvizClusters' (compactData dg') - gAttrs - toClust - ctypeID - clustAttributes' - nAttr - eAttr + . graphviz params $ compactData dg' + where + params = Params True gAttrs toClust ctypeID clustAttributes' nAttr eAttr dg' = origHData dg gAttrs = [nodeAttrs] -- [GraphAttrs [Label $ StrLabel t]] -- Possible clustering problem toClust = clusterEntity -- bool clusterEntity clusterEntityM' $ isJust mm - nAttr = entityAttributes dg' (not $ isJust mm) mm + nAttr = entityAttributes dg' (isNothing mm) mm eAttr = callAttributes' dg' -- | One-module-per-cluster 'DotGraph'. drawGraph' :: String -> HData' -> DotGraph Node drawGraph' gid dg = setID (Str gid) - $ graphvizClusters (compactData dg') - gAttrs - modClustAttrs - nAttr - eAttr + . graphvizClusters params $ compactData dg' where + params = Params True gAttrs N (const Nothing) modClustAttrs nAttr eAttr dg' = collapsedHData dg gAttrs = [nodeAttrs] -- [GraphAttrs [Label $ StrLabel t]] nAttr = entityAttributes dg' False Nothing @@ -82,7 +74,7 @@ -- only one module, @'Nothing'@ if all. entityAttributes :: GData n e -> Bool -> Maybe ModName -> LNode Entity -> Attributes -entityAttributes hd a mm (n,(Ent m nm t)) +entityAttributes hd a mm (n,Ent m nm t) = [ Label $ StrLabel lbl , Shape $ shapeFor t -- , Color [ColorName cl] @@ -94,7 +86,7 @@ where lbl = bool nm (nameOfModule m ++ "\\n" ++ nm) $ not sameMod || a - sameMod = maybe True ((==) m) mm + sameMod = maybe True (m==) mm shapeFor :: EntityType -> Shape shapeFor Constructor{} = Box3D @@ -109,7 +101,7 @@ styleFor :: Maybe ModName -> ModName -> StyleItem styleFor mm m@LocalMod{} = flip SItem [] . bool Solid Bold - $ maybe False ((==) m) mm + $ maybe False (m==) mm styleFor _ ExtMod{} = SItem Dashed [] styleFor _ UnknownMod = SItem Dotted [] @@ -168,12 +160,13 @@ drawClusters :: String -> (HSGraph -> HSClustGraph) -> HData' -> DotGraph Node drawClusters gid cf dg = setID (Str gid) - $ graphvizClusters (compactData dg') - gAttrs - (const cAttr) - nAttr - eAttr + . graphvizClusters params $ compactData dg' where + params = blankParams { globalAttributes = gAttrs + , fmtCluster = const cAttr + , fmtNode = nAttr + , fmtEdge = eAttr + } dg' = mapData' cf $ collapsedHData dg gAttrs = [nodeAttrs] -- [GraphAttrs [Label $ StrLabel t]] cAttr = [GraphAttrs [ Style [SItem Filled []] @@ -185,19 +178,20 @@ drawLevels :: String -> Maybe ModName -> HData' -> DotGraph Node drawLevels gid mm hd = setID (Str gid) - $ graphvizClusters dg' - gAttrs - levelAttr - nAttr - eAttr + $ graphvizClusters params dg' where + params = blankParams { globalAttributes = gAttrs + , fmtCluster = levelAttr + , fmtNode = nAttr + , fmtEdge = eAttr + } hd' = collapsedHData hd vs = collapsedVirts hd dg = compactData hd' wrs = wantedRootNodes dg ++ S.toList (implicitExports vs dg) dg' = updateGraph (levelGraphFrom wrs) dg gAttrs = [nodeAttrs] -- [GraphAttrs [Label $ StrLabel t]] - nAttr = entityAttributes hd' (not $ isJust mm) mm + nAttr = entityAttributes hd' (isNothing mm) mm eAttr = callAttributes' hd' levelAttr :: Int -> [GlobalAttributes] @@ -217,14 +211,9 @@ drawModules :: String -> MData -> DotGraph Node drawModules gid md = setID (Str gid) - $ graphvizClusters' (graphData md) - gAttrs - clusteredModule - cID - cAttr - nAttr - eAttr + . graphviz params $ graphData md where + params = Params True gAttrs clusteredModule cID cAttr nAttr eAttr cID (_,s) = bool Nothing (Just $ Str s) $ (not . null) s gAttrs = [nodeAttrs] -- [GraphAttrs [Label $ StrLabel t]] cAttr dp = [GraphAttrs $ directoryAttributes dp] @@ -252,7 +241,7 @@ hasNode = S.member n . fst nodeAttrs :: GlobalAttributes -nodeAttrs = NodeAttrs [ Margin . PVal $ PointD 0.4 0.1 +nodeAttrs = NodeAttrs [ Margin . PVal $ Point 0.4 0.1 , Style [SItem Filled []] ] diff --git a/CabalInfo.hs b/CabalInfo.hs --- a/CabalInfo.hs +++ b/CabalInfo.hs @@ -72,7 +72,7 @@ where nm = pName . pkgName $ package pd pName (PackageName nm') = nm' - exes = executables pd + exes = filter (buildable . buildInfo) $ executables pd lib = library pd moduleNames = map toFilePath exps | not $ null exes = nub $ map (dropExtension . modulePath) exes diff --git a/ChangeLog b/ChangeLog --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,20 @@ +Changes in 0.6.1.1 +================== + +* Update to take into account API changes of libraries. + +Changes in 0.6.1.0 +================== + +* Only consider buildable executables for Cabal-based analyses. + +* Also buildable with haskell-src-exts-1.7.* + +Changes in 0.6.0.2 +================== + +* Also buildable with haskell-src-exts-1.6.* + Changes in 0.6.0.1 ================== diff --git a/Parsing/Types.hs b/Parsing/Types.hs --- a/Parsing/Types.hs +++ b/Parsing/Types.hs @@ -35,7 +35,7 @@ , ClusterType(..) , Rel) import Data.Graph.Analysis.Reporting(unDotPath) -import Data.GraphViz(GraphID(..), NodeCluster(..)) +import Data.GraphViz(GraphID(..), LNodeCluster, NodeCluster(..)) import Data.Graph.Inductive.Graph(LNode) import Data.Char(isLetter, isDigit) @@ -196,7 +196,7 @@ type Depth = Int -clusteredModule :: LNode ModName -> NodeCluster (Depth, String) String +clusteredModule :: LNode ModName -> NodeCluster (Depth, String) (LNode String) clusteredModule (n,m) = go 0 $ modulePathOf m where go _ [m'] = N (n,m') @@ -204,7 +204,7 @@ go _ [] = error "Shouldn't be able to have an empty module name." instance ClusterType ModName where - clusterID = Just . Str . unDotPath . nameOfModule + clustID = Just . Str . unDotPath . nameOfModule instance ClusterLabel ModName where type Cluster ModName = String @@ -294,20 +294,20 @@ cluster = inModule nodeLabel = id -clusterEntityM :: LNode Entity -> NodeCluster String Entity +clusterEntityM :: LNode Entity -> LNodeCluster String Entity clusterEntityM ln = modPathClust id ln (N ln) modPathClust :: (String -> a) -> LNode Entity - -> NodeCluster a Entity -> NodeCluster a Entity + -> LNodeCluster a Entity -> LNodeCluster a Entity modPathClust f ln b = foldr ($) b $ map (C . f) p where p = modulePathOf . inModule $ snd ln -clusterEntityM' :: LNode Entity -> NodeCluster EntClustType Entity +clusterEntityM' :: LNode Entity -> LNodeCluster EntClustType Entity clusterEntityM' ln = modPathClust ModPath ln (clusterEntity ln) -clusterEntity :: LNode Entity -> NodeCluster EntClustType Entity -clusterEntity ln@(_,e) = setClust (N ln) +clusterEntity :: LNode Entity -> LNodeCluster EntClustType Entity +clusterEntity ln@(_,e) = setClust $ N ln where setClust = case eType e of (Constructor d) -> C $ DataDefn d diff --git a/SourceGraph.cabal b/SourceGraph.cabal --- a/SourceGraph.cabal +++ b/SourceGraph.cabal @@ -1,5 +1,5 @@ Name: SourceGraph -Version: 0.6.0.2 +Version: 0.6.1.1 Synopsis: Static code analysis using graph-theoretic techniques. Description: { Statically analyse Haskell source code using graph-theoretic @@ -75,9 +75,9 @@ random, directory, mtl, - fgl, - Graphalyze >= 0.9.0.0 && < 0.10.0.0, - graphviz >= 2999.8.0.0 && < 2999.9.0.0, + fgl >= 5.4.2.3 && < 5.5, + Graphalyze >= 0.10.0.0 && < 0.11.0.0, + graphviz >= 2999.10.0.0 && < 2999.11.0.0, Cabal >= 1.8 && < 1.9, - haskell-src-exts >= 1.5.0 && < 1.7.0 + haskell-src-exts >= 1.5.0 && < 1.10.0 } diff --git a/TODO b/TODO --- a/TODO +++ b/TODO @@ -1,3 +1,6 @@ +IDs for class, etc. subgraphs should include the modules for cases +like bytestring where two datatypes have the same name + TODO for SourceGraph ==================== @@ -132,6 +135,8 @@ available. - Pass GHC, CPP, etc. flags through for when parsing the files. + + - Use the correct source directory and match modules to files. Program Usage -------------