diff --git a/Analyse.hs b/Analyse.hs --- a/Analyse.hs +++ b/Analyse.hs @@ -29,7 +29,6 @@ -} module Analyse where -import Analyse.Utils import Analyse.Module import Analyse.Imports import Analyse.Everything @@ -45,6 +44,6 @@ analyse :: (RandomGen g) => g -> [ModuleName] -> HaskellModules -> [DocElement] analyse g exps hms = [ analyseModules hms - , analyseImports g exps hms + , analyseImports exps hms , analyseEverything g exps hms ] diff --git a/Analyse/Everything.hs b/Analyse/Everything.hs --- a/Analyse/Everything.hs +++ b/Analyse/Everything.hs @@ -27,27 +27,27 @@ Analysis of the entire overall piece of software. -} -module Analyse.Everything where +module Analyse.Everything (analyseEverything) where import Parsing.Types import Analyse.Utils import Data.Graph.Analysis +import Data.List import Data.Maybe import Text.Printf import System.Random type CodeData = GraphData Function - -- | Performs analysis of the entire codebase. analyseEverything :: (RandomGen g) => g -> [ModuleName] -> HaskellModules -> DocElement -analyseEverything g exps hm = Section title elems +analyseEverything g exps hm = Section sec elems where cd = codeToGraph exps hm - title = Text "Analysis of the entire codebase" + sec = Text "Analysis of the entire codebase" elems = catMaybes $ map ($cd) [ graphOf , clustersOf g @@ -74,26 +74,30 @@ } graphOf :: CodeData -> Maybe DocElement -graphOf cd = Just $ Section title [gc] +graphOf cd = Just $ Section sec [gc] where - title = Text "Visualisation of the entire software" + sec = Text "Visualisation of the entire software" gc = GraphImage $ applyAlg dg cd - dg g = toGraph "code" label g - label = "Software visualisation" + dg g = toGraph "code" lbl g + lbl = "Software visualisation" clustersOf :: (RandomGen g) => g -> CodeData -> Maybe DocElement -clustersOf g cd = Just $ Section title [text, gc, textAfter, cw, rng] +clustersOf g cd = Just $ Section sec [ text, gc, textAfter + , blank, cwMsg, cw, blank, rngMsg, rng] where - title = Text "Visualisation of overall function calls" + blank = Paragraph [BlankSpace] + sec = Text "Visualisation of overall function calls" gc = GraphImage $ applyAlg dg cd text = Paragraph [Text "Here is the current module grouping of functions:"] - dg gr = toClusters "codeCluster" label gr - label = "Module groupings" + dg gr = toClusters "codeCluster" lbl gr + lbl = "Module groupings" textAfter = Paragraph [Text "Here are two proposed module groupings:"] + cwMsg = Paragraph [Emphasis $ Text "Using the Chinese Whispers algorithm:"] cw = GraphImage . toClusters "codeCW" "Chinese Whispers module suggestions" $ applyAlg (chineseWhispers g) cd + rngMsg = Paragraph [Emphasis $ Text "Using the Relative Neighbourhood algorithm:"] rng = GraphImage . toClusters "codeRNG" "Relative Neighbourhood module suggestions" $ applyAlg relativeNeighbourhood cd @@ -101,12 +105,11 @@ componentAnal :: CodeData -> Maybe DocElement componentAnal cd | single comp = Nothing - | otherwise = Just elem + | otherwise = Just $ Section sec [Paragraph [Text text]] where comp = applyAlg componentsOf cd len = length comp - elem = Section title [Paragraph [Text text]] - title = Text "Function component analysis" + sec = Text "Function component analysis" text = printf "The functions are split up into %d components. \ \You may wish to consider splitting the code up \ \into multiple libraries." len @@ -114,43 +117,46 @@ cliqueAnal :: CodeData -> Maybe DocElement cliqueAnal cd | null clqs = Nothing - | otherwise = Just elem + | otherwise = Just el where - clqs = applyAlg cliquesIn cd - clqs' = map (Paragraph . return . Text . showNodes) clqs - text = Text "The code has the following cliques:" - elem = Section title $ (Paragraph [text]) : clqs' - title = Text "Overall clique analysis" + clqs = onlyCrossModule $ applyAlg cliquesIn cd + clqs' = return . Itemized + $ map (Paragraph . return . Text . showNodes) clqs + text = Text "The code has the following cross-module cliques:" + el = Section sec $ (Paragraph [text]) : clqs' + sec = Text "Overall clique analysis" cycleAnal :: CodeData -> Maybe DocElement cycleAnal cd | null cycs = Nothing - | otherwise = Just elem + | otherwise = Just el where - cycs = applyAlg uniqueCycles cd - cycs' = map (Paragraph . return . Text . showCycle) cycs - text = Text "The code has the following non-clique cycles:" - elem = Section title $ (Paragraph [text]) : cycs' - title = Text "Overall cycle analysis" + cycs = onlyCrossModule $ applyAlg uniqueCycles cd + cycs' = return . Itemized + $ map (Paragraph . return . Text . showCycle) cycs + text = Text "The code has the following cross-module non-clique cycles:" + el = Section sec $ (Paragraph [text]) : cycs' + sec = Text "Overall cycle analysis" chainAnal :: CodeData -> Maybe DocElement chainAnal cd | null chns = Nothing - | otherwise = Just elem + | otherwise = Just el where - chns = applyAlg chainsIn cd - chns' = map (Paragraph .return . Text . showPath) chns - text = Text "The functions have the following chains:" + chns = onlyCrossModule $ interiorChains cd + chns' = return . Itemized + $ map (Paragraph . return . Text . showPath) chns + text = Text "The code has the following cross-module chains:" textAfter = Text "These chains can all be compressed down to \ \a single function." - elem = Section title $ - [Paragraph [text]] ++ chns' ++ [Paragraph [textAfter]] - title = Text "Overall chain analysis" + el = Section sec $ + [Paragraph [text]] ++ chns' ++ [Paragraph [textAfter]] + sec = Text "Overall chain analysis" rootAnal :: CodeData -> Maybe DocElement rootAnal cd | asExpected = Nothing - | otherwise = Just elem + | otherwise = Just $ Section sec ps where (wntd, ntRs, ntWd) = classifyRoots cd asExpected = (null ntRs) && (null ntWd) @@ -160,54 +166,58 @@ [Text $ concat ["These functions are those that are " , s, ":"]] - , Paragraph [Text $ showNodes ns]] + , Paragraph [Emphasis . Text $ showNodes ns]] ps = concat . catMaybes $ map rpt [ ("available for use and roots",wntd) - , ("available for use but not roots",ntWd) - , ("not available for use but roots",ntRs)] - elem = Section title ps - title = Text "Import root analysis" + , ("available for use but not roots",ntRs) + , ("not available for use but roots",ntWd)] + sec = Text "Import root analysis" cycleCompAnal :: CodeData -> Maybe DocElement -cycleCompAnal cd = Just $ Section title [par] +cycleCompAnal cd = Just $ Section sec pars where cc = cyclomaticComplexity cd - title = Text "Overall Cyclomatic Complexity" - par = Paragraph [text, textAfter, link] + sec = Text "Overall Cyclomatic Complexity" + pars = [Paragraph [text], Paragraph [textAfter, link]] text = Text $ printf "The overall cyclomatic complexity is: %d" cc textAfter = Text "For more information on cyclomatic complexity, \ - \please see:" + \please see: " link = DocLink (Text "Wikipedia: Cyclomatic Complexity") (URL "http://en.wikipedia.org/wiki/Cyclomatic_complexity") coreAnal :: CodeData -> Maybe DocElement -coreAnal cd = Just elem +coreAnal cd = if (isEmpty core) + then Nothing + else Just $ Section sec [hdr, anal] where core = applyAlg coreOf cd p = "codeCore" - label = "Overall core" + lbl = "Overall core" hdr = Paragraph [Text "The core of software can be thought of as \ \the part where all the work is actually done."] - empMsg = Paragraph [Text "The code is a tree."] - anal = if (isEmpty core) - then empMsg - else GraphImage (toGraph p label core) - elem = Section title [hdr, anal] - title = Text "Overall Core analysis" + anal = GraphImage (toGraph p lbl core) + sec = Text "Overall Core analysis" collapseAnal :: CodeData -> Maybe DocElement -collapseAnal cd = Just elem +collapseAnal cd = if (trivialCollapse gc) + then Nothing + else Just $ Section sec [hdr, gr] where gc = applyAlg collapseGraph cd p = "codeCollapsed" - label = "Collapsed view of the entire codebase" + lbl = "Collapsed view of the entire codebase" hdr = Paragraph [Text "The collapsed view of code collapses \ \down all cliques, cycles, chains, etc. to \ \make the graph tree-like." ] - gr = GraphImage (toGraph p label gc) - elem = Section title [hdr, gr] - title = Text "Collapsed view of the entire codebase" + gr = GraphImage (toGraph p lbl gc) + sec = Text "Collapsed view of the entire codebase" + +-- | Only use those values that are in more than one module. +onlyCrossModule :: [LNGroup Function] -> [LNGroup Function] +onlyCrossModule = filter crossModule + where + crossModule = not . single . nub . map (inModule . label) diff --git a/Analyse/Imports.hs b/Analyse/Imports.hs --- a/Analyse/Imports.hs +++ b/Analyse/Imports.hs @@ -36,27 +36,24 @@ import Data.Maybe import Text.Printf -import System.Random type ImportData = GraphData ModuleName -- | Analyse the imports present in the software. Takes in a random seed -- as well as a list of all modules exported. -analyseImports :: (RandomGen g) => g -> [ModuleName] -> HaskellModules - -> DocElement -analyseImports g exps hm = Section title elems +analyseImports :: [ModuleName] -> HaskellModules -> DocElement +analyseImports exps hm = Section sec elems where - id = importsToGraph exps hm - title = Text "Analysis of module imports" + imd = importsToGraph exps hm + sec = Text "Analysis of module imports" elems = catMaybes - $ map ($id) [ graphOf - , clustersOf g - , cycleCompAnal - , rootAnal - , componentAnal - , cycleAnal - , chainAnal - ] + $ map ($imd) [ graphOf + , cycleCompAnal + , rootAnal + , componentAnal + , cycleAnal + , chainAnal + ] importsToGraph :: [ModuleName] -> HaskellModules -> ImportData importsToGraph exps hms = importData params @@ -67,76 +64,62 @@ , directed = True } -graphOf :: ImportData -> Maybe DocElement -graphOf id = Just $ Section title [gi] - where - title = Text "Visualisation of imports" - gi = GraphImage $ applyAlg dg id - dg g = toGraph "imports" label g - label = "Import visualisation" - -clustersOf :: (RandomGen g) => g -> ImportData -> Maybe DocElement -clustersOf g id = Just $ Section title [text, gi, textAfter, cw, rng] +graphOf :: ImportData -> Maybe DocElement +graphOf imd = Just $ Section sec [gi] where - title = Text "Visualisation of module groupings" - gi = GraphImage $ applyAlg dg id - text = Paragraph [Text "Here is the current module groupings:"] - dg gr = toClusters "importCluster" label gr - label = "Module groupings" - textAfter = Paragraph [Text "Here are two proposed module groupings:"] - cw = GraphImage - . toClusters "importCW" "Chinese Whispers module groupings" - $ applyAlg (chineseWhispers g) id - rng = GraphImage - . toClusters "importRNG" "Relative Neighbourhood module groupings" - $ applyAlg relativeNeighbourhood id + sec = Text "Visualisation of imports" + gi = GraphImage $ applyAlg dg imd + dg g = toGraph "imports" lbl g + lbl = "Import visualisation" componentAnal :: ImportData -> Maybe DocElement -componentAnal id +componentAnal imd | single comp = Nothing - | otherwise = Just elem + | otherwise = Just el where - comp = applyAlg componentsOf id + comp = applyAlg componentsOf imd len = length comp - elem = Section title [Paragraph [Text text]] - title = Text "Import component analysis" + el = Section sec [Paragraph [Text text]] + sec = Text "Import component analysis" text = printf "The imports have %d components. \ \You may wish to consider splitting the code up." len cycleAnal :: ImportData -> Maybe DocElement -cycleAnal id +cycleAnal imd | null cycs = Nothing - | otherwise = Just elem + | otherwise = Just el where - cycs = applyAlg cyclesIn id - cycs' = map (Paragraph .return . Text . showCycle) cycs + cycs = applyAlg cyclesIn imd + cycs' = return . Itemized + $ map (Paragraph . return . Text . showCycle) cycs text = Text "The imports have the following cycles:" textAfter = Text "Whilst this is valid, it may make it difficult \ \to use in ghci, etc." - elem = Section title - $ (Paragraph [text]) : cycs' ++ [Paragraph [textAfter]] - title = Text "Cycle analysis of imports" + el = Section sec + $ (Paragraph [text]) : cycs' ++ [Paragraph [textAfter]] + sec = Text "Cycle analysis of imports" chainAnal :: ImportData -> Maybe DocElement -chainAnal id +chainAnal imd | null chns = Nothing - | otherwise = Just elem + | otherwise = Just el where - chns = applyAlg chainsIn id - chns' = map (Paragraph .return . Text . showPath) chns + chns = interiorChains imd + chns' = return . Itemized + $ map (Paragraph . return . Text . showPath) chns text = Text "The imports have the following chains:" textAfter = Text "These chains can all be compressed down to \ \a single module." - elem = Section title $ - [Paragraph [text]] ++ chns' ++ [Paragraph [textAfter]] - title = Text "Import chain analysis" + el = Section sec $ + [Paragraph [text]] ++ chns' ++ [Paragraph [textAfter]] + sec = Text "Import chain analysis" rootAnal :: ImportData -> Maybe DocElement -rootAnal id +rootAnal imd | asExpected = Nothing - | otherwise = Just elem + | otherwise = Just $ Section sec ps where - (wntd, ntRs, ntWd) = classifyRoots id + (wntd, ntRs, ntWd) = classifyRoots imd asExpected = (null ntRs) && (null ntWd) rpt (s,ns) = if (null ns) then Nothing @@ -144,23 +127,22 @@ [Text $ concat ["These modules are those that are " , s, ":"]] - , Paragraph [Text $ showNodes ns]] + , Paragraph [Emphasis . Text $ showNodes ns]] ps = concat . catMaybes $ map rpt [ ("in the export list and roots",wntd) - , ("in the export list but not roots",ntWd) - , ("not in the export list but roots",ntRs)] - elem = Section title ps - title = Text "Import root analysis" + , ("in the export list but not roots",ntRs) + , ("not in the export list but roots",ntWd)] + sec = Text "Import root analysis" -cycleCompAnal :: ImportData -> Maybe DocElement -cycleCompAnal id = Just $ Section title [par] +cycleCompAnal :: ImportData -> Maybe DocElement +cycleCompAnal imd = Just $ Section sec pars where - cc = cyclomaticComplexity id - title = Text "Cyclomatic Complexity of imports" - par = Paragraph [text, textAfter, link] + cc = cyclomaticComplexity imd + sec = Text "Cyclomatic Complexity of imports" + pars = [Paragraph [text], Paragraph [textAfter, link]] text = Text $ printf "The cyclomatic complexity of the imports is: %d" cc textAfter = Text "For more information on cyclomatic complexity, \ - \please see:" + \please see: " link = DocLink (Text "Wikipedia: Cyclomatic Complexity") (URL "http://en.wikipedia.org/wiki/Cyclomatic_complexity") diff --git a/Analyse/Module.hs b/Analyse/Module.hs --- a/Analyse/Module.hs +++ b/Analyse/Module.hs @@ -51,14 +51,16 @@ -- | Performs analysis of all modules present in the 'HaskellModules' provided. analyseModules :: HaskellModules -> DocElement analyseModules = Section (Text "Analysis of each module") - . map analyseModule . hModulesIn + . catMaybes . map analyseModule . hModulesIn -- | Performs analysis of the given 'HaskellModule'. -analyseModule :: HaskellModule -> DocElement -analyseModule hm = Section title elems +analyseModule :: HaskellModule -> Maybe DocElement +analyseModule hm = if (n > 1) + then Just $ Section sec elems + else Nothing where m = show $ moduleName hm - fd = moduleToGraph hm + (n,fd) = moduleToGraph hm elems = catMaybes $ map ($fd) [ graphOf , collapseAnal @@ -70,13 +72,14 @@ , cycleAnal , chainAnal ] - title = Grouping [ Text "Analysis of" - , Emphasis (Text m)] + sec = Grouping [ Text "Analysis of" + , Emphasis (Text m)] -- | Convert the module to the /Graphalyze/ format. -moduleToGraph :: HaskellModule -> FunctionData -moduleToGraph hm = (show $ moduleName hm, fd') +moduleToGraph :: HaskellModule -> (Int,FunctionData) +moduleToGraph hm = (n,(show $ moduleName hm, fd')) where + n = applyAlg noNodes fd' fd' = manipulateNodes (AS . name) fd fd = importData params funcs = functions hm @@ -87,71 +90,74 @@ } graphOf :: FunctionData -> Maybe DocElement -graphOf (m,fd) = Just $ Section title [gi] +graphOf (m,fd) = Just $ Section sec [gi] where - title = Grouping [ Text "Visualisation of" - , Emphasis (Text m)] + sec = Grouping [ Text "Visualisation of" + , Emphasis (Text m)] gi = GraphImage $ applyAlg dg fd - dg g = toGraph m label g - label = unwords ["Diagram of:", m] + dg g = toGraph m lbl g + lbl = unwords ["Diagram of:", m] componentAnal :: FunctionData -> Maybe DocElement componentAnal (m,fd) | single comp = Nothing - | otherwise = Just elem + | otherwise = Just el where comp = applyAlg componentsOf fd len = length comp - elem = Section title [Paragraph [Text text]] - title = Grouping [ Text "Component analysis of" - , Emphasis (Text m)] + el = Section sec [Paragraph [Text text]] + sec = Grouping [ Text "Component analysis of" + , Emphasis (Text m)] text = printf "The module %s has %d components. \ \You may wish to consider splitting it up." m len cliqueAnal :: FunctionData -> Maybe DocElement cliqueAnal (m,fd) | null clqs = Nothing - | otherwise = Just elem + | otherwise = Just el where clqs = applyAlg cliquesIn fd - clqs' = map (Paragraph . return . Text . showNodes) clqs + clqs' = return . Itemized + $ map (Paragraph . return . Text . showNodes) clqs text = Text $ printf "The module %s has the following cliques:" m - elem = Section title $ (Paragraph [text]) : clqs' - title = Grouping [ Text "Clique analysis of" - , Emphasis (Text m)] + el = Section sec $ (Paragraph [text]) : clqs' + sec = Grouping [ Text "Clique analysis of" + , Emphasis (Text m)] cycleAnal :: FunctionData -> Maybe DocElement cycleAnal (m,fd) | null cycs = Nothing - | otherwise = Just elem + | otherwise = Just el where cycs = applyAlg uniqueCycles fd - cycs' = map (Paragraph . return . Text . showCycle) cycs + cycs' = return . Itemized + $ map (Paragraph . return . Text . showCycle) cycs text = Text $ printf "The module %s has the following non-clique \ \cycles:" m - elem = Section title $ (Paragraph [text]) : cycs' - title = Grouping [ Text "Cycle analysis of" - , Emphasis (Text m)] + el = Section sec $ (Paragraph [text]) : cycs' + sec = Grouping [ Text "Cycle analysis of" + , Emphasis (Text m)] chainAnal :: FunctionData -> Maybe DocElement chainAnal (m,fd) | null chns = Nothing - | otherwise = Just elem + | otherwise = Just el where - chns = applyAlg chainsIn fd - chns' = map (Paragraph . return . Text . showPath) chns + chns = interiorChains fd + chns' = return . Itemized + $ map (Paragraph . return . Text . showPath) chns text = Text $ printf "The module %s has the following chains:" m textAfter = Text "These chains can all be compressed down to \ \a single function." - elem = Section title - $ [Paragraph [text]] ++ chns' ++ [Paragraph [textAfter]] - title = Grouping [ Text "Chain analysis of" - , Emphasis (Text m)] + el = Section sec + $ [Paragraph [text]] ++ chns' ++ [Paragraph [textAfter]] + sec = Grouping [ Text "Chain analysis of" + , Emphasis (Text m)] rootAnal :: FunctionData -> Maybe DocElement rootAnal (m,fd) | asExpected = Nothing - | otherwise = Just elem + | otherwise = Just el where (wntd, ntRs, ntWd) = classifyRoots fd asExpected = (null ntRs) && (null ntWd) @@ -161,51 +167,52 @@ [Text $ concat ["These nodes are those that are " , s, ":"]] - , Paragraph [Text $ showNodes ns]] + , Paragraph [Emphasis . Text $ showNodes ns]] ps = concat . catMaybes $ map rpt [ ("in the export list and roots",wntd) - , ("in the export list but not roots",ntWd) - , ("not in the export list but roots",ntRs)] - elem = Section title ps - title = Grouping [ Text "Root analysis of" - , Emphasis (Text m)] + , ("in the export list but not roots",ntRs) + , ("not in the export list but roots",ntWd)] + el = Section sec ps + sec = Grouping [ Text "Root analysis of" + , Emphasis (Text m)] coreAnal :: FunctionData -> Maybe DocElement -coreAnal (m,fd) = Just elem +coreAnal (m,fd) = if (isEmpty core) + then Nothing + else Just el where core = applyAlg coreOf fd p = m ++ "_core" - label = unwords ["Core of", m] + lbl = unwords ["Core of", m] hdr = Paragraph [Text "The core of a module can be thought of as \ \the part where all the work is actually done."] - empMsg = Paragraph [Text $ printf "The module %s is a tree." m] - anal = if (isEmpty core) - then empMsg - else GraphImage (toGraph p label core) - elem = Section title [hdr, anal] - title = Grouping [ Text "Core analysis of" - , Emphasis (Text m)] + anal = GraphImage (toGraph p lbl core) + el = Section sec [hdr, anal] + sec = Grouping [ Text "Core analysis of" + , Emphasis (Text m)] -collapseAnal :: FunctionData -> Maybe DocElement -collapseAnal (m,fd) = Just elem +collapseAnal :: FunctionData -> Maybe DocElement +collapseAnal (m,fd) = if (trivialCollapse gc) + then Nothing + else Just el where gc = applyAlg collapseGraph fd p = m ++ "_collapsed" - label = unwords ["Collapsed view of", m] + lbl = unwords ["Collapsed view of", m] hdr = Paragraph [Text "The collapsed view of a module collapses \ \down all cliques, cycles, chains, etc. to \ \make the graph tree-like." ] - gr = GraphImage (toGraph p label gc) - elem = Section title [hdr, gr] - title = Grouping [ Text "Collapsed view of" - , Emphasis (Text m)] + gr = GraphImage (toGraph p lbl gc) + el = Section sec [hdr, gr] + sec = Grouping [ Text "Collapsed view of" + , Emphasis (Text m)] cycleCompAnal :: FunctionData -> Maybe DocElement -cycleCompAnal (m,fd) = Just $ Section title pars +cycleCompAnal (m,fd) = Just $ Section sec pars where cc = cyclomaticComplexity fd - title = Grouping [ Text "Cyclomatic Complexity of" + sec = Grouping [ Text "Cyclomatic Complexity of" , Emphasis (Text m)] pars = [Paragraph [text], Paragraph [textAfter, link]] text = Text 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 -import Data.GraphViz import Data.Graph.Inductive hiding (graphviz) @@ -46,13 +45,13 @@ toGraph :: (Show a) => FilePath -> String -> AGr a -> DocGraph toGraph p t g = (p,Text t,dg) where - dg = graphviz t g [maximumSize] + dg = graphviz t g toClusters :: (Show c, ClusterLabel a c) => FilePath -> String -> AGr a -> DocGraph toClusters p t g = (p, Text t, dg) where - dg = graphvizClusters t g [maximumSize] + dg = graphvizClusters t g -- | Cyclomatic complexity cyclomaticComplexity :: GraphData a -> Int diff --git a/Main.hs b/Main.hs --- a/Main.hs +++ b/Main.hs @@ -38,6 +38,8 @@ import Distribution.Package import Distribution.PackageDescription hiding (author) +import Distribution.PackageDescription.Parse +import Distribution.ModuleName (toFilePath) import Distribution.Verbosity import Data.Char @@ -70,11 +72,11 @@ hms <- parseFilesFrom dir' analyseCode dir nm exps hms -programName :: String -programName = "SourceGraph" +programmeName :: String +programmeName = "SourceGraph" -programVersion :: String -programVersion = "0.2" +programmeVersion :: String +programmeVersion = "0.3" putErrLn :: String -> IO () putErrLn = hPutStrLn stderr @@ -87,28 +89,37 @@ (Right gpd') -> return (Just $ parse gpd') (Left _) -> return Nothing where - parse pd = (nm, exp') + parse pd = (nm, exps') where cbl = packageDescription pd - nm = pkgName $ package cbl + nm = pName . pkgName $ package cbl + pName (PackageName nm') = nm' cexes :: [Executable] cexes = map (condTreeData .snd) $ condExecutables pd exes = executables cbl clib = condLibrary pd lib = library cbl - exp | not $ null cexes = nub $ map (dropExtension . modulePath) cexes - | not $ null exes = nub . map dropExtension $ exeModules cbl - | isJust clib = exposedModules . condTreeData - $ fromJust clib - | isJust lib = exposedModules $ fromJust lib - | otherwise = error "No exposed modules" - exp' = map createModule exp + moduleNames = map toFilePath + exps | not $ null cexes = nub $ map (dropExtension . modulePath) cexes + | not $ null exes = nub . map dropExtension . moduleNames $ exeModules cbl + | isJust clib = moduleNames . exposedModules . condTreeData + $ fromJust clib + | isJust lib = moduleNames . exposedModules $ fromJust lib + | otherwise = error "No exposed modules" + exps' = map fpToModule exps getCabalFile :: [FilePath] -> Maybe FilePath getCabalFile = listToMaybe . filter isCabalFile where isCabalFile f = (takeExtension f) == (extSeparator : "cabal") +fpToModule :: FilePath -> ModuleName +fpToModule = createModule . map pSep + where + pSep c + | isPathSeparator c = moduleSep + | otherwise = c + -- ----------------------------------------------------------------------------- -- | Recursively parse all files from this directory @@ -182,7 +193,6 @@ isTrivial ".." = True isTrivial "_darcs" = True isTrivial "dist" = True -isTrivial "Pandoc.hs" = True isTrivial f | isSetup f = True isTrivial _ = False @@ -199,23 +209,33 @@ analyseCode fp nm exps hms = do d <- today g <- newStdGen let dc = doc d g - out <- createDocument pandocHtml dc - case out of - Just fp -> success fp - Nothing -> failure + docOut <- createDocument pandocHtml dc + case docOut of + Just path -> success path + Nothing -> failure where - doc d g = Doc { rootDirectory = rt - , fileFront = nm - , title = t - , author = a - , date = d - , content = c g + graphdir = "graphs" + doc d g = Doc { rootDirectory = rt + , fileFront = nm + , graphDirectory = graphdir + , title = t + , author = a + , date = d + , content = msg : c g } - rt = fp programName + rt = fp programmeName sv s v = s ++ " (version " ++ v ++ ")" t = Grouping [Text "Analysis of", Emphasis $ Text nm] - a = unwords [ "Analysed by", sv programName programVersion + a = unwords [ "Analysed by", sv programmeName programmeVersion , "using", sv "Graphalyze" version] c g = analyse g exps hms - success fp = putStrLn $ unwords ["Report generated at:",fp] + success fp' = putStrLn $ unwords ["Report generated at:",fp'] failure = putErrLn "Unable to generate report" + msg = Paragraph [ Text "Please note that the source-code analysis in this\ + \ document is not necessarily perfect: " + , Emphasis $ Text programmeName + , Text " is " + , Bold $ Text "not" + , Text " a refactoring tool, and does not take into \ + \account Class declarations and record functions." + ] diff --git a/Parsing.hs b/Parsing.hs --- a/Parsing.hs +++ b/Parsing.hs @@ -33,6 +33,8 @@ , ModuleName , createModule , parseHaskell + -- from Parsing.Types + , moduleSep ) where import Parsing.Types diff --git a/Parsing/ParseModule.hs b/Parsing/ParseModule.hs --- a/Parsing/ParseModule.hs +++ b/Parsing/ParseModule.hs @@ -115,8 +115,8 @@ imps = if (importQualified im) then qImport else mImport ++ qImport - getFunctions m = map (setModule m) . getItems - setModule m f = F m f Nothing + getFunctions m' = map (setModule m') . getItems + setModule m' f = F m' f Nothing getItems = catMaybes . map getImport -- We only care about functions, variables, etc. getImport (HsIVar nm) = Just (nameOf nm) @@ -126,11 +126,11 @@ -- | Parsing the export list. parseExports :: ModuleName -> [HsExportSpec] -> [Function] -parseExports m = catMaybes . map (parseExport m) +parseExports m = catMaybes . map parseExport where -- We only care about exported functions. - parseExport m (HsEVar qn) = fmap (setFuncModule m) $ hsName qn - parseExport _ _ = Nothing + parseExport (HsEVar qn) = fmap (setFuncModule m) $ hsName qn + parseExport _ = Nothing -- | Parse the contents of the module. For each stand-alone function, -- return it along with all other known functions that it calls. @@ -191,10 +191,10 @@ -- Qualified variables and constructors instance HsItem HsQName where - hsName (Qual mod name) = fmap (addQual (modName mod)) (hsName name) - hsName (UnQual name) = hsName name + hsName (Qual m nm) = fmap (addQual (modName m)) (hsName nm) + hsName (UnQual nm) = hsName nm -- inbuilt special syntax, e.g. [], (,), etc. - hsName (Special _) = Nothing + hsName (Special _) = Nothing -- Infix operators. instance HsItem HsQOp where @@ -242,7 +242,7 @@ hsNames (HsPList pats) = hsNames pats hsNames (HsPParen pat) = hsNames pat hsNames (HsPRec _ pfields) = hsNames pfields - hsNames (HsPAsPat name pat) = hsName' name + hsNames (HsPAsPat nm pat) = hsName' nm ++ hsNames pat hsNames HsPWildCard = [] hsNames (HsPIrrPat pat) = hsNames pat diff --git a/SourceGraph.cabal b/SourceGraph.cabal --- a/SourceGraph.cabal +++ b/SourceGraph.cabal @@ -1,5 +1,5 @@ Name: SourceGraph -Version: 0.2 +Version: 0.3 Synopsis: Use graph-theory to analyse your code Description: SourceGraph uses the Graphalyze library to analyse Cabalized Haskell code. @@ -32,6 +32,6 @@ else Build-Depends: base < 3 - Build-Depends: fgl, Graphalyze >= 0.4, graphviz >= 2008.9.20, - Cabal >= 1.4, Cabal < 1.5, haskell-src-exts >= 0.3 + Build-Depends: fgl, Graphalyze >= 0.5, graphviz >= 2008.9.20, + Cabal >= 1.6, Cabal < 1.7, haskell-src-exts >= 0.3 } diff --git a/TODO b/TODO --- a/TODO +++ b/TODO @@ -1,9 +1,6 @@ TODO for SourceGraph ==================== -* Have a way of showing small graphs in the all-in-one file - that then link to larger graphs. - * Let users choose output directory * Let users choose output format @@ -11,6 +8,7 @@ * Have a "just draw the graph" option * "Smarter" analysis: don't show compressed if its boring, etc. + -- Mainly done, could possibly be smarter * Write a README