SourceGraph 0.6.1.1 → 0.7.0.0
raw patch · 5 files changed
+68/−48 lines, 5 filesdep ~Cabaldep ~Graphalyzedep ~graphviz
Dependency ranges changed: Cabal, Graphalyze, graphviz
Files
- Analyse.hs +20/−9
- Analyse/Visualise.hs +10/−10
- Main.hs +25/−16
- Parsing.hs +9/−9
- SourceGraph.cabal +4/−4
Analyse.hs view
@@ -41,6 +41,7 @@ import Data.GraphViz.Attributes import System.Random(RandomGen)+import Control.Arrow(first) -- | Analyse an entire Haskell project. Takes in a random seed, -- the list of exported modules and the parsed Haskell code in@@ -52,15 +53,16 @@ , analyseModules hms ] -sgLegend :: [(DocGraph, DocInline)]-sgLegend = [ esCall- , mods- , esLoc- , esData- , esClass- , esExp- , callCats- ]+sgLegend :: [(Either DocGraph DocInline, DocInline)]+sgLegend = map (first Left) [ esCall+ , mods+ , esLoc+ , esData+ , esClass+ , esExp+ , callCats+ ]+ ++ [first Right edgeExplain] esCall, mods, esLoc, esData, esClass, esExp, callCats :: (DocGraph, DocInline) @@ -206,3 +208,12 @@ } mkN (n,as) = DotNode n as mkE (f,t,as) = DotEdge f t True as++edgeExplain :: (DocInline, DocInline)+edgeExplain = (Grouping cntnt, R.Bold $ Text "Edge Widths")+ where+ cntnt = [ Text "The width of each edge is calculated by:"+ , BlankSpace+ , Emphasis $ Text+ "width = log (number of function calls) + 1"+ ]
Analyse/Visualise.hs view
@@ -51,7 +51,7 @@ where params = Params True gAttrs toClust ctypeID clustAttributes' nAttr eAttr dg' = origHData dg- gAttrs = [nodeAttrs] -- [GraphAttrs [Label $ StrLabel t]]+ gAttrs = [nodeAttrs] -- [GraphAttrs [toLabel t]] -- Possible clustering problem toClust = clusterEntity -- bool clusterEntity clusterEntityM' $ isJust mm nAttr = entityAttributes dg' (isNothing mm) mm@@ -64,7 +64,7 @@ where params = Params True gAttrs N (const Nothing) modClustAttrs nAttr eAttr dg' = collapsedHData dg- gAttrs = [nodeAttrs] -- [GraphAttrs [Label $ StrLabel t]]+ gAttrs = [nodeAttrs] -- [GraphAttrs [toLabel t]] nAttr = entityAttributes dg' False Nothing eAttr = callAttributes' dg' @@ -75,7 +75,7 @@ entityAttributes :: GData n e -> Bool -> Maybe ModName -> LNode Entity -> Attributes entityAttributes hd a mm (n,Ent m nm t)- = [ Label $ StrLabel lbl+ = [ toLabel lbl , Shape $ shapeFor t -- , Color [ColorName cl] , FillColor $ entCol hd n@@ -121,7 +121,7 @@ callAttributes' :: GData n e -> LEdge (Int, CallType) -> Attributes-callAttributes' hd (f,t,(n,ct)) = PenWidth (fromIntegral n)+callAttributes' hd (f,t,(n,ct)) = PenWidth (log (fromIntegral n) + 1) : callAttributes hd (f,t) ct clustAttributes :: EntClustType -> Attributes@@ -141,7 +141,7 @@ , Style [SItem Filled [], SItem Rounded []] , FillColor $ X11Color SlateGray1 ]-clustAttributes (ModPath p) = [ Label $ StrLabel p ]+clustAttributes (ModPath p) = [ toLabel p ] clustAttributes' :: EntClustType -> [GlobalAttributes] clustAttributes' = return . GraphAttrs . clustAttributes@@ -168,7 +168,7 @@ , fmtEdge = eAttr } dg' = mapData' cf $ collapsedHData dg- gAttrs = [nodeAttrs] -- [GraphAttrs [Label $ StrLabel t]]+ gAttrs = [nodeAttrs] -- [GraphAttrs [toLabel t]] cAttr = [GraphAttrs [ Style [SItem Filled []] , FillColor clusterBackground ]@@ -190,7 +190,7 @@ dg = compactData hd' wrs = wantedRootNodes dg ++ S.toList (implicitExports vs dg) dg' = updateGraph (levelGraphFrom wrs) dg- gAttrs = [nodeAttrs] -- [GraphAttrs [Label $ StrLabel t]]+ gAttrs = [nodeAttrs] -- [GraphAttrs [toLabel t]] nAttr = entityAttributes hd' (isNothing mm) mm eAttr = callAttributes' hd' @@ -215,9 +215,9 @@ 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]]+ gAttrs = [nodeAttrs] -- [GraphAttrs [toLabel t]] cAttr dp = [GraphAttrs $ directoryAttributes dp]- nAttr (n,m) = [ Label $ StrLabel m+ nAttr (n,m) = [ toLabel m , FillColor $ entCol md n , Shape Tab ]@@ -241,7 +241,7 @@ hasNode = S.member n . fst nodeAttrs :: GlobalAttributes-nodeAttrs = NodeAttrs [ Margin . PVal $ Point 0.4 0.1+nodeAttrs = NodeAttrs [ Margin . PVal $ createPoint 0.4 0.1 , Style [SItem Filled []] ]
Main.hs view
@@ -72,8 +72,9 @@ dir' <- if null dir then getCurrentDirectory else return dir- hms <- parseFilesFrom dir'- analyseCode dir nm exps hms+ (failed,hms) <- parseFilesFrom dir'+ mapM_ (putErrLn . ("Could not parse source file "++)) failed+ analyseCode dir nm exps failed hms programmeName :: String programmeName = "SourceGraph"@@ -111,13 +112,13 @@ isCabalFile = hasExt "cabal" parseMain :: FilePath -> IO (Maybe (String, [ModName]))-parseMain fp = do pms <- parseHaskellFiles [fp]+parseMain fp = do (_,pms) <- parseHaskellFiles [fp] let mn = fst $ M.findMin pms return $ Just (nameOfModule mn, [mn]) -- | Determine if this is the path of a Haskell file. isHaskellFile :: FilePath -> Bool-isHaskellFile fp = any (flip hasExt fp) haskellExtensions+isHaskellFile fp = any (`hasExt` fp) haskellExtensions hasExt :: String -> FilePath -> Bool hasExt ext = (==) ext . drop 1 . takeExtension@@ -132,10 +133,10 @@ -- ----------------------------------------------------------------------------- -- | Recursively parse all files from this directory-parseFilesFrom :: FilePath -> IO ParsedModules+parseFilesFrom :: FilePath -> IO ([FilePath],ParsedModules) parseFilesFrom fp = parseHaskellFiles =<< getHaskellFilesFrom fp -parseHaskellFiles :: [FilePath] -> IO ParsedModules+parseHaskellFiles :: [FilePath] -> IO ([FilePath],ParsedModules) parseHaskellFiles = liftM parseHaskell . readFiles -- -----------------------------------------------------------------------------@@ -211,15 +212,15 @@ -- ----------------------------------------------------------------------------- -analyseCode :: FilePath -> String -> [ModName]- -> ParsedModules -> IO ()-analyseCode fp nm exps hms = do d <- today- g <- newStdGen- let dc = doc d g- docOut <- createDocument pandocHtml' dc- case docOut of- Just path -> success path- Nothing -> failure+analyseCode :: FilePath -> String -> [ModName]+ -> [FilePath] -> ParsedModules -> IO ()+analyseCode fp nm exps fld hms = do d <- today+ g <- newStdGen+ let dc = doc d g+ docOut <- createDocument pandocHtml' dc+ case docOut of+ Just path -> success path+ Nothing -> failure where pandocHtml' = alsoSaveDot pandocHtml graphdir = "graphs"@@ -240,7 +241,9 @@ c g = analyse g exps hms success fp' = putStrLn $ unwords ["Report generated at:",fp'] failure = putErrLn "Unable to generate report"- notes = Section (Text "Notes") [msg, implicitMsg, linkMsg]+ notes = Section (Text "Notes")+ $ (if null fld then id else (++[failed]))+ [msg, implicitMsg, linkMsg] msg = Paragraph [ Text "Please note that the source-code analysis in this\ \ document is not necessarily perfect: " , Emphasis $ Text programmeName@@ -264,3 +267,9 @@ ] linkMsg = Paragraph [Text "All graph visualisations link to larger \ \SVG versions of the same graph."]+ failed = Section (Text "Parsing Failures")+ [ Paragraph [Text "The following source files were unable\+ \ to be parsed; this may result in some\+ \ analysis failures:"]+ , Itemized $ map (Paragraph . return . Text) fld+ ]
Parsing.hs view
@@ -46,28 +46,28 @@ , defaultParseMode) import Language.Haskell.Exts.Syntax(Module) -import Data.Maybe(mapMaybe)+import Data.Either(partitionEithers) type FileContents = (FilePath,String) -- | Parse all the files and return the map. -- This uses laziness to evaluate the 'HaskellModules' result -- whilst also using it to parse all the modules to create it.-parseHaskell :: [FileContents] -> ParsedModules-parseHaskell fc = hms+parseHaskell :: [FileContents] -> ([FilePath],ParsedModules)+parseHaskell fc = (failed,hms) where- ms = parseFiles fc+ (failed,ms) = parseFiles fc hms = createModuleMap hss hss = map (parseModule hms) ms -- | Attempt to parse an individual file.-parseFile :: FileContents -> Maybe Module+parseFile :: FileContents -> Either FilePath Module parseFile (p,f) = case (parseFileContentsWithMode mode f) of- (ParseOk hs) -> Just hs- _ -> Nothing+ (ParseOk hs) -> Right hs+ _ -> Left p where mode = defaultParseMode { parseFilename = p } -- | Parse all the files that you can.-parseFiles :: [FileContents] -> [Module]-parseFiles = mapMaybe parseFile+parseFiles :: [FileContents] -> ([FilePath],[Module])+parseFiles = partitionEithers . map parseFile
SourceGraph.cabal view
@@ -1,5 +1,5 @@ Name: SourceGraph-Version: 0.6.1.1+Version: 0.7.0.0 Synopsis: Static code analysis using graph-theoretic techniques. Description: { Statically analyse Haskell source code using graph-theoretic@@ -76,8 +76,8 @@ directory, mtl, 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,+ Graphalyze >= 0.11.0.0 && < 0.12.0.0,+ graphviz >= 2999.11.0.0 && < 2999.12.0.0,+ Cabal >= 1.8 && < 1.11, haskell-src-exts >= 1.5.0 && < 1.10.0 }