{-
Copyright (C) 2009 Ivan Lazar Miljenovic <Ivan.Miljenovic@gmail.com>
This file is part of SourceGraph.
SourceGraph is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 3 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
-}
{- |
Module : Analyse
Description : Analyse Haskell software
Copyright : (c) Ivan Lazar Miljenovic 2009
License : GPL-3 or later.
Maintainer : Ivan.Miljenovic@gmail.com
Analyse Haskell software
-}
module Analyse(analyse, sgLegend) where
import Analyse.Module
import Analyse.Imports
import Analyse.Everything
import Analyse.Utils
import Parsing.Types
import Data.Graph.Analysis hiding (Bold)
import qualified Data.Graph.Analysis.Reporting as R (DocInline(Bold))
import Data.GraphViz.Types
import Data.GraphViz.Attributes
import System.Random(RandomGen)
-- | Analyse an entire Haskell project. Takes in a random seed,
-- the list of exported modules and the parsed Haskell code in
-- 'HaskellModules' form.
analyse :: (RandomGen g) => g -> [ModName] -> ParsedModules
-> [DocElement]
analyse g exps hms = [ analyseEverything g exps hms
, analyseImports exps hms
, analyseModules hms
]
sgLegend :: [(DocGraph, DocInline)]
sgLegend = [ esCall
, mods
, esLoc
, esData
, esClass
, esExp
]
esCall, mods, esLoc, esData, esClass, esExp :: (DocGraph, DocInline)
esCall = (dg', R.Bold $ Text "Two normal functions with a function call.")
where
dg' = ("legend_call", Text "Function Call", dg)
dg = mkLegendGraph ns es
nAs = [Shape BoxShape, FillColor innerNode]
ns = [ (1, Label (StrLabel "f") : nAs)
, (2, Label (StrLabel "g") : nAs)
]
eAs = [Color [ColorName "black"]]
es = [(1,2,eAs)]
mods = (dg', R.Bold $ Text "Two normal modules with a module import.")
where
dg' = ("legend_mods", Text "Module Import", dg)
dg = mkLegendGraph ns es
nAs = [Shape Tab, FillColor innerNode]
ns = [ (1, Label (StrLabel "Foo") : nAs)
, (2, Label (StrLabel "Bar") : nAs)
]
es = [(1,2,[])]
esLoc = (dg', R.Bold $ Text "Entities from different modules.")
where
dg' = ("legend_loc", Text "From module", dg)
dg = mkLegendGraph ns es
nAs = [FillColor innerNode]
ns = [ (1, Label (StrLabel "Current module")
: Style [SItem Bold []] : nAs)
, (2, Label (StrLabel "Other project module")
: Style [SItem Solid []] : nAs)
, (3, Label (StrLabel "Known external module")
: Style [SItem Dashed []] : nAs)
, (4, Label (StrLabel "Unknown external module")
: Style [SItem Dotted []] : nAs)
]
es = []
esData = (dg', R.Bold $ Text "Data type declaration.")
where
dg' = ("legend_data", Text "Data type declaration", dg)
dg = mkLegendGraph ns es
nAs = [FillColor innerNode]
ns = [ (1, Label (StrLabel "Constructor")
: Shape Box3D : nAs)
, (2, Label (StrLabel "Record function")
: Shape Component : nAs)
]
es = [(2,1,[ Color [ColorName "magenta"], ArrowTail oDot, ArrowHead vee])]
esClass = (dg', R.Bold $ Text "Class and instance declarations.")
where
dg' = ("legend_class", Text "Class declaration", dg)
dg = mkLegendGraph ns es
nAs = [FillColor innerNode]
ns = [ (1, Label (StrLabel "Default instance")
: Shape Octagon : nAs)
, (2, Label (StrLabel "Class function")
: Shape DoubleOctagon : nAs)
, (3, Label (StrLabel "Instance for data type")
: Shape Octagon : nAs)
]
eAs = [Dir NoDir]
es = [ (2,1, Color [ColorName "navy"] : eAs)
, (2,3, Color [ColorName "turquoise"] : eAs)
]
esExp = (dg', R.Bold $ Text "Entity location classification.")
where
dg' = ("legend_loc2", Text "Entity Location", dg)
dg = mkLegendGraph ns es
ns = [ (1, [ Label (StrLabel "Un-exported root entity")
, FillColor unExportedRoot])
, (2, [ Label (StrLabel "Exported root entity")
, FillColor exportedRoot])
, (3, [ Label (StrLabel "Exported non-root entity")
, FillColor exportedInner])
, (4, [ Label (StrLabel "Leaf entity")
, FillColor leafNode])
, (5, [ Label (StrLabel "Normal entity")
, FillColor innerNode])
]
es = []
mkLegendGraph :: [(Int,Attributes)] -> [(Int,Int,Attributes)]
-> DotGraph Node
mkLegendGraph ns es = DotGraph { strictGraph = False
, directedGraph = True
, graphID = Nothing
, graphStatements
= DotStmts { attrStmts = atts
, subGraphs = [nSG]
, nodeStmts = []
, edgeStmts = map mkE es
}
}
where
atts = [ GraphAttrs [OutputOrder EdgesFirst]
, NodeAttrs [FontSize 10, Style [SItem Filled []]]
]
sgAtts = [GraphAttrs [Rank MinRank]]
nSG = DotSG { isCluster = False
, subGraphID = Nothing
, subGraphStmts = DotStmts { attrStmts = sgAtts
, subGraphs = []
, nodeStmts = map mkN ns
, edgeStmts = []
}
}
mkN (n,as) = DotNode n as
mkE (f,t,as) = DotEdge f t True as