Graphalyze 0.8.0.0 → 0.9.0.0

raw patch · 10 files changed

+485/−221 lines, 10 filesdep ~graphvizdep ~pandocPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: graphviz, pandoc

API changes (from Hackage documentation)

Files

• Data/Graph/Analysis.hs +66/−12
• Data/Graph/Analysis/Algorithms/Clustering.hs +44/−21
• Data/Graph/Analysis/Algorithms/Directed.hs +88/−13
• Data/Graph/Analysis/Internal.hs +52/−8
• Data/Graph/Analysis/Reporting.hs +143/−89
• Data/Graph/Analysis/Reporting/Pandoc.hs +58/−53
• Data/Graph/Analysis/Types.hs +18/−0
• Data/Graph/Analysis/Utils.hs +9/−22
• Graphalyze.cabal +3/−3
• TODO +4/−0

@@ -29,7 +29,11 @@       -- $analfuncts       lengthAnalysis,       classifyRoots,-      interiorChains+      inaccessibleNodes,+      interiorChains,+      collapseAndUpdate,+      collapseAndUpdate',+      levelGraphFromRoot     ) where  import Data.Graph.Analysis.Internal@@ -41,9 +45,13 @@  import Data.Graph.Inductive.Graph -import Data.Maybe(mapMaybe)+import Data.List(find)+import Data.Maybe(mapMaybe, maybe) import qualified Data.Map as M+import Data.Map(Map) import qualified Data.Set as S+import Data.Set(Set)+import Control.Arrow(first)  import Data.Version(showVersion) import qualified Paths_Graphalyze as Paths(version)@@ -122,26 +130,38 @@  {- |    Compare the actual roots in the graph with those that are expected-   (i.e. those in 'wantedRoots').  Returns (in order):+   (i.e. those in 'wantedRootNodes').  Returns (in order): -   * Those roots that are expected (i.e. elements of 'wantedRoots'+   * Those roots that are expected (i.e. elements of 'wantedRootNodes'      that are roots).     * Those roots that are expected but not present (i.e. elements of-     'wantedRoots' that /aren't/ roots.+     'wantedRootNodes' that /aren't/ roots.     * Unexpected roots (i.e. those roots that aren't present in-     'wantedRoots').+     'wantedRootNodes').  -}-classifyRoots    :: (Ord n) => GraphData n e -> ([LNode n], [LNode n], [LNode n])+classifyRoots    :: GraphData n e -> (Set Node, Set Node, Set Node) classifyRoots gd = (areWanted, notRoots, notWanted)     where-      wntd = S.fromList $ wantedRoots gd-      rts = S.fromList $ applyAlg rootsOf gd-      areWanted = S.toList $ S.intersection wntd rts-      notRoots  = S.toList $ S.difference wntd rts-      notWanted = S.toList $ S.difference rts wntd+      wntd = S.fromList $ wantedRootNodes gd+      rts = S.fromList $ applyAlg rootsOf' gd+      areWanted = S.intersection wntd rts+      notRoots  = S.difference wntd rts+      notWanted = S.difference rts wntd +-- | Find the nodes that are not reachable from the expected roots+--   (i.e. those in 'wantedRootNodes').+inaccessibleNodes    :: GraphData n e -> Set Node+inaccessibleNodes gd = allNs `S.difference` reachableNs+    where+      -- We can't use accessibleOnlyFrom' on notWanted from+      -- classifyRoots, as there might be nodes that are roots but not+      -- detectable (e.g. a loop).+      allNs = S.fromList $ applyAlg nodes gd+      rs = S.fromList $ wantedRootNodes gd+      reachableNs = applyAlg accessibleFrom' gd rs+ -- | Only return those chains (see 'chainsIn') where the non-initial --   nodes are /not/ expected roots. interiorChains    :: (Eq n, Eq e) => GraphData n e -> [LNGroup n]@@ -151,3 +171,37 @@       rts = wantedRoots gd       interiorRoot = any (`elem` rts) . tail +-- | As with 'collapseAndReplace', but also update the+--   'wantedRootNodes' to contain the possibly compressed nodes.+--   Since the datums they refer to may no longer exist (as they are+--   compressed), 'unusedRelationships' is set to @[]@.+collapseAndUpdate    :: (Ord n) => [AGr n e -> [(NGroup, n)]]+                        -> GraphData n e -> GraphData n e+collapseAndUpdate fs = fst . collapseAndUpdate' fs++-- | As with 'collapseAndUpdate', but also includes a lookup 'Map'+--   from the old label to the new.+collapseAndUpdate'       :: (Ord n) => [AGr n e -> [(NGroup, n)]]+                            -> GraphData n e -> (GraphData n e, Map n n)+collapseAndUpdate' fs gd = (gd', repLookup)+  where+    gr = graph gd+    (gr', reps) = collapseAndReplace' fs gr+    lns' = mkNodeMap $ labNodes gr'+    reps' = map (first S.fromList) reps+    rs = S.fromList $ wantedRootNodes gd+    replace r = maybe r ((M.!) lns' . snd)+                $ find (S.member r . fst) reps'+    gd' = gd { graph = gr'+             , wantedRootNodes = S.toList $ S.map replace rs+             , unusedRelationships = []+             }+    nlLookup = M.fromList $ labNodes gr+    getLs = mapMaybe (flip M.lookup nlLookup)+    repLookup = M.fromList . spreadOut $ map (first getLs) reps++-- | As with 'levelGraph', but use the expected roots rather than the+--   actual roots.+levelGraphFromRoot    :: (Ord n) => GraphData n e+                         -> GraphData (GenCluster n) e+levelGraphFromRoot gd = updateGraph (levelGraphFrom (wantedRootNodes gd)) gd

@@ -7,6 +7,9 @@     Clustering and grouping algorithms that are graph-invariant and require    no user intervention.++   For a clustering algorithm that works only on directed graphs, see+   @levelGraph@ in "Data.Graph.Analysis.Algorithms.Directed".  -} module Data.Graph.Analysis.Algorithms.Clustering     ( -- * Clustering Algorithms@@ -21,7 +24,8 @@       CNodes,       collapseGraph,       collapseGraphBy,-      collapseGraphBy',+      collapseAndReplace,+      collapseAndReplace',       trivialCollapse,     ) where @@ -34,9 +38,10 @@  import Data.List(foldl', tails, delete, intersect) import Data.Function(on)+import Data.Maybe(fromJust) import qualified Data.Set.BKTree as BK import Data.Set.BKTree(BKTree, Metric(..))-import Control.Arrow(first, second)+import Control.Arrow(first, second, (***)) import System.Random(RandomGen, randomR)  -- -----------------------------------------------------------------------------@@ -276,6 +281,10 @@     It may be possible to extend this to a clustering algorithm by    collapsing low density regions into high density regions.++   If providing custom collapsing functions, you should ensure that+   for each function, it is not possible to have a recursive situation+   where a collapsed node keeps getting collapsed to itself.  -}  -- | A collapsed node contains a list of nodes that it represents.@@ -292,24 +301,32 @@ -- | Use the given functions to determine which nodes to collapse. collapseGraphBy    :: (DynGraph gr) => [gr (CNodes a) b -> [NGroup]]                       -> gr a b -> gr (CNodes a) b-collapseGraphBy fs = collapseGr fs'+collapseGraphBy fs = fst . collapseGr fs'     where       fs' = map (map (flip (,) Nothing) .) fs  -- | Use the given functions to determine which nodes to collapse, --   with a new label to represent the collapsed nodes.-collapseGraphBy'    :: (DynGraph gr) => [gr a b -> [(NGroup, a)]]-                       -> gr a b -> gr a b-collapseGraphBy' fs = unCollapse . collapseGr fs'+collapseAndReplace    :: (DynGraph gr) => [gr a b -> [(NGroup, a)]]+                         -> gr a b -> gr a b+collapseAndReplace fs = fst . collapseAndReplace' fs++-- | As with 'collapseAndReplace', but also return the+--   @('NGroup', a)@'s calculated with the functions provided.+collapseAndReplace'    :: (DynGraph gr) => [gr a b -> [(NGroup, a)]]+                          -> gr a b -> (gr a b, [(NGroup, a)])+collapseAndReplace' fs = (unCollapse *** strip) . collapseGr fs'     where-      -- convert gr a b -> [(NGroup a)] to+      -- convert gr a b -> [(NGroup, a)] to       -- gr (CNodes a) b -> [(NGroup, Maybe a)]-      fs' = map ((.nmap head) . (map (second Just) .)) fs+      fs' = map ((. nmap head) . (map (second Just) .)) fs+      -- Strip the Maybes+      strip = map (second fromJust)  -- | Collapse the graph. collapseGr      :: (DynGraph gr) => [gr (CNodes a) b -> [(NGroup, Maybe a)]]-                   -> gr a b -> gr (CNodes a) b-collapseGr fs g = foldl' collapseAllBy (makeCollapsible g) fs+                   -> gr a b -> (gr (CNodes a) b, [(NGroup, Maybe a)])+collapseGr fs g = foldl' collapseAllBy (makeCollapsible g, []) fs  -- | Return @'True'@ if the collapsed graph is either a singleton node --   or else isomorphic to the original graph (i.e. not collapsed at all).@@ -347,16 +364,21 @@       c' = (p,n1,l1++l2,s)  -- | Collapse the list of nodes down to one node.-collapseAll               :: (DynGraph gr) => gr (CNodes a) b-                             -> (NGroup, Maybe a)+collapseAll               :: (DynGraph gr) => (NGroup, Maybe a)                              -> gr (CNodes a) b-collapseAll g ([],_)      = g -- These two cases-collapseAll g ([_],_)     = g -- shouldn't occur.-collapseAll g ((n:ns),ma) = adj $ foldl' collapser g ns+                             -> gr (CNodes a) b+collapseAll ([],_)      g = g -- This case shouldn't occur+collapseAll ([n],ma)    g = maybeAdjustLabel n ma g+collapseAll ((n:ns),ma) g = foldl' collapser g' ns     where-      adj = maybe id (adjustLabel n) ma-      collapser g' = collapse g' n+      g' = maybeAdjustLabel n ma g+      collapser = flip collapse n +maybeAdjustLabel   :: (DynGraph gr) => Node -> Maybe a -> gr (CNodes a) b+                      -> gr (CNodes a) b+maybeAdjustLabel n = maybe id (adjustLabel n)++-- | Replace the label of the provided node with @[a]@. adjustLabel       :: (DynGraph gr) => Node -> a                      -> gr (CNodes a) b -> gr (CNodes a) b adjustLabel n a g = c & g'@@ -365,12 +387,13 @@       c = (p,n,[a],s)  -- | Collapse all results of the given function.-collapseAllBy     :: (DynGraph gr) => gr (CNodes a) b+collapseAllBy     :: (DynGraph gr) => (gr (CNodes a) b, [(NGroup, Maybe a)])                      -> (gr (CNodes a) b -> [(NGroup, Maybe a)])-                     -> gr (CNodes a) b-collapseAllBy g f = case (filter (not . single . fst) $ f g) of+                     -> (gr (CNodes a) b, [(NGroup, Maybe a)])+collapseAllBy g f = case (filter (not . null . fst) $ f (fst g)) of                       []     -> g                              -- We re-evaluate the function in case                              -- the original results used nodes that                              -- have been collapsed down.-                      (nsr:_) -> collapseAllBy (collapseAll g nsr) f+                      (nsr:_) -> second (nsr :)+                                 $ collapseAllBy (first (collapseAll nsr) g) f

@@ -25,8 +25,16 @@       coreOf,       -- * Clustering       levelGraph,+      levelGraphFrom,+      minLevel,+      -- * Node accessibility+      accessibleFrom,+      accessibleFrom',+      accessibleOnlyFrom,+      accessibleOnlyFrom',       -- * Other-      leafMinPaths+      leafMinPaths,+      leafMinPaths'     ) where  import Data.Graph.Analysis.Types@@ -36,10 +44,13 @@ import Data.Graph.Inductive.Query.BFS(esp)  import Data.List(minimumBy, unfoldr)+import Data.Maybe(fromMaybe) import Data.Function(on) import qualified Data.Map as M+import Data.Map(Map) import qualified Data.Set as S import Data.Set(Set)+import Control.Monad(ap)  -- ----------------------------------------------------------------------------- {- $ends@@ -161,29 +172,49 @@  {- |    Cluster the nodes in the graph based upon how far away they are-   from a root node.  Root nodes are in the cluster labelled "0",-   nodes in level "n" are at least /n/ edges away from a root node.+   from a root node.  Root nodes are in the cluster labelled 'minLevel',+   nodes in level \"n\" (with @n > minLevel@) are at least /n/ edges away+   from a root node. -}-levelGraph   :: (Ord a) => (DynGraph g) => g a b -> g (GenCluster a) b-levelGraph g = gmap addLbl g+levelGraph   :: (Ord a, DynGraph g) => g a b -> g (GenCluster a) b+levelGraph g = levelGraphFrom (rootsOf' g) g++-- | As with 'levelGraph' but provide a custom grouping of 'Node's to+--   consider as the \"roots\".+levelGraphFrom      :: (Ord a, DynGraph g) => NGroup -> g a b+                       -> g (GenCluster a) b+levelGraphFrom rs g = gmap addLbl g     where-      lvls = zip [0..] . map S.toList $ graphLevels g+      lvls = zip [minLevel..] . map S.toList $ graphLevels rs g       lvMap = M.fromList               $ concatMap (\(l,ns) -> map (flip (,) l) ns) lvls-      mkLbl n l = GC { clust = lvMap M.! n+      mkLbl n l = GC { clust = getLevel n                      , nLbl  = l                      }        addLbl (p,n,l,s) = (p, n, mkLbl n l, s) +      -- Have to consider unaccessible nodes.+      getLevel n = fromMaybe (pred minLevel) $ n `M.lookup` lvMap++-- | The level of the nodes in the 'NGroup' provided to+--   'levelGraphFrom' (or the root nodes for 'levelGraph').  A level+--   less than this indicates that the node is not accessible.+minLevel :: Int+minLevel = 0+ type NSet = Set Node  -- | Obtain the levels in the graph.-graphLevels   :: (DynGraph g) => g a b -> [NSet]-graphLevels g = unfoldr getNextLevel-                 (S.fromList $ rootsOf' g, g)+graphLevels :: (Graph g) => NGroup -> g a b -> [NSet]+graphLevels = flip graphLevels' . S.fromList -getNextLevel :: (DynGraph g) => (NSet, g a b)+graphLevels'   :: (Graph g) => g a b -> NSet -> [NSet]+graphLevels' g = unfoldr getNextLevel . flip (,) g++-- | The @(NSet, g a b)@ parameters are the current nodes to be+--   starting with in the current graph.+getNextLevel :: (Graph g) => (NSet, g a b)                 -> Maybe (NSet, (NSet, g a b)) getNextLevel (ns,g)     | S.null ns = Nothing@@ -191,8 +222,8 @@     where       g' = delNodes (S.toList ns) g       ns' = flip S.difference ns-            . S.unions . S.toList-            $ S.map getSuc ns+            . S.unions . map getSuc+            $ S.toList ns       getSuc = S.fromList . suc g  -- -----------------------------------------------------------------------------@@ -208,6 +239,14 @@       rs = rootsOf' g       ls = leavesOf' g +{- |+   The shortest paths to each of the leaves in the graph (excluding+   singletons).  This can be used to obtain an indication of the+   overall height/depth of the graph.+ -}+leafMinPaths' :: (Graph g) => g a b -> [NGroup]+leafMinPaths' = map (map node) . leafMinPaths+ -- | Given the list of roots in this graph, find the shortest path to --   this leaf node. lfMinPth        :: (Graph g) => g a b -> [Node] -> Node -> LNGroup a@@ -216,3 +255,39 @@                   . minimumBy (compare `on` fst)                   . addLengths                   $ map (\ r -> esp r l g) rs++-- -----------------------------------------------------------------------------++-- | Find all 'Node's that can be reached from the provided 'Node's.+accessibleFrom   :: (Graph g) => g a b -> [Node] -> [Node]+accessibleFrom g = S.toList . accessibleFrom' g . S.fromList++-- | Find all 'Node's that can be reached from the provided nodes+--   using 'Set's rather than lists.+accessibleFrom'   :: (Graph g) => g a b -> Set Node -> Set Node+accessibleFrom' g = S.unions . graphLevels' g++-- | Find those 'Node's that are reachable only from the provided+--   'Node's.+accessibleOnlyFrom   :: (Graph g) => g a b -> [Node] -> [Node]+accessibleOnlyFrom g = S.toList . accessibleOnlyFrom' g . S.fromList++-- | Find those 'Node's that are reachable only from the provided+--   'Node's, using 'Set's rather than lists.+accessibleOnlyFrom'   :: (Graph g) => g a b -> Set Node -> Set Node+accessibleOnlyFrom' g = M.keysSet+                        . fixPoint keepOnlyInternal+                        . setKeys (pre g)+                        . accessibleFrom' g++-- | Pseudo-inverse of 'M.keysSet'.+setKeys   :: (Ord a) => (a -> b) -> Set a -> Map a b+setKeys f = M.fromDistinctAscList . map (ap (,) f) . S.toAscList++-- | Removing nodes which have predecessors outside of this Map.+keepOnlyInternal :: Map Node NGroup -> Map Node NGroup+keepOnlyInternal = M.filter =<< onlyInternalPred++-- | Are these predecessor nodes all found within this Map?+onlyInternalPred :: Map Node NGroup -> NGroup -> Bool+onlyInternalPred = all . flip M.member

@@ -17,6 +17,8 @@ import Data.Either(partitionEithers) import qualified Data.Map as M import Data.Map(Map)+import qualified Data.Set as S+import Data.Set(Set) import Data.Maybe(fromJust) import Control.Arrow((***)) import Control.Monad(ap)@@ -39,11 +41,61 @@ applyBoth :: (a -> b) -> (a,a) -> (b,b) applyBoth f = f *** f +-- | Create a lookup 'Map' to determine which 'Node' has a specific label. mkNodeMap :: (Ord a) => [LNode a] -> Map a Node mkNodeMap = M.fromList . map swap +spreadOut :: [([a], b)] -> [(a,b)]+spreadOut = concatMap spread+  where+    spread (as, b) = map (flip (,) b) as+ -- -----------------------------------------------------------------------------+-- Items re-exported in Utils (needed by Types, so defined here to+-- avoid cycles). +-- | The node number of an 'LNode'.+node :: LNode a -> Node+node = fst++-- | The label of an 'LNode'.+label :: LNode a -> a+label = snd++-- | Find all the labelled nodes in the graph that match the given predicate.+filterNodes     :: (Graph g) => (g a b -> LNode a -> Bool) -> g a b -> [LNode a]+filterNodes p g = filter (p g) (labNodes g)++-- | Find all the nodes in the graph that match the given predicate.+filterNodes'     :: (Graph g) => (g a b -> Node -> Bool) -> g a b -> [Node]+filterNodes' p g = filter (p g) (nodes g)++-- | Obtain the labels for a list of 'Node's.+--   It is assumed that each 'Node' is indeed present in the given graph.+addLabels    :: (Graph g) => g a b -> [Node] -> [LNode a]+addLabels gr = map (ap (,) (fromJust . lab gr))++-- | Obtain the labels for a 'Set' of 'Node's.+--   It is assumed that each 'Node' is indeed present in the given graph.+addLabels'    :: (Ord a, Graph g) => g a b -> Set Node -> Set (LNode a)+addLabels' gr = S.map (ap (,) (fromJust . lab gr))++-- | Obtain the labels for a list of 'Node's.+--   It is assumed that each 'Node' is indeed present in the given graph.+getLabels   :: (Graph g) => g a b -> [Node] -> [a]+getLabels gr = map label . addLabels gr++-- | Obtain the labels for a list of 'Node's.+--   It is assumed that each 'Node' is indeed present in the given graph.+getLabels'   :: (Ord a, Graph g) => g a b -> Set Node -> Set a+getLabels' gr = S.fromList -- List fusion might make this more+                           -- efficient than multiple S.map's with the+                           -- resulting internal re-organisation.+                . getLabels gr+                . S.toList++-- -----------------------------------------------------------------------------+ -- | A relationship between two nodes with a label. type Rel n e = (n, n, e) @@ -79,11 +131,3 @@       dupSwap e@(x,y,l) | x == y    = [e]                         | otherwise = [e, (y,x,l)]       graphEdges = dupSwap' gEdges---- This is needed by Types, so it's defined here and then exported by--- Utils to avoid cyclic problems.---- | Obtain the labels for a list of 'Node's.---   It is assumed that each 'Node' is indeed present in the given graph.-addLabels    :: (Graph g) => g a b -> [Node] -> [LNode a]-addLabels gr = map (ap (,) (fromJust . lab gr))

@@ -16,7 +16,9 @@       DocElement(..),       DocInline(..),       GraphSize(..),-      DocGraph,+      DocGraph(..),+      VisParams(..),+      VisProperties(..),       -- * Helper functions       -- $utilities       addLegend,@@ -30,12 +32,12 @@ import Data.Graph.Inductive(Node) import Data.GraphViz -import Data.Maybe(isJust, fromJust, catMaybes) import Data.Time(getZonedTime, zonedTimeToLocalTime, formatTime) import Control.Exception.Extensible(SomeException(..), tryJust) import System.Directory(createDirectoryIfMissing)-import System.FilePath((</>), (<.>))+import System.FilePath((</>), makeRelative) import System.Locale(defaultTimeLocale)+import Control.Monad(liftM, when)  -- ----------------------------------------------------------------------------- @@ -52,19 +54,20 @@    instance of 'DocumentGenerator'.  -} data Document = Doc { -- | Document location-                      rootDirectory  :: FilePath,-                      fileFront      :: String,+                      rootDirectory  :: FilePath+                    , fileFront      :: String                       -- | The sub-directory of 'rootDirectory',                       --   where graphs are to be created.-                      graphDirectory :: FilePath,+                    , graphDirectory :: FilePath                       -- | Pre-matter-                      title          :: DocInline,-                      author         :: String,-                      date           :: String,+                    , title          :: DocInline+                    , author         :: String+                    , date           :: String                       -- | Main-matter-                      legend         :: [(DocGraph, DocInline)],-                      content        :: [DocElement]+                    , legend         :: [(DocGraph, DocInline)]+                    , content        :: [DocElement]                     }+                deriving (Eq, Ord, Show, Read)  -- | Represents the class of document generators. class DocumentGenerator dg where@@ -76,11 +79,9 @@     docExtension   :: dg -> String  -- | Representation of a location, either on the internet or locally.-data Location = Web String | File FilePath--instance Show Location where-    show (Web url) = url-    show (File fp) = fp+data Location = Web String+              | File FilePath+              deriving (Eq, Ord, Show, Read)  -- | Elements of a document. data DocElement = Section DocInline [DocElement]@@ -89,6 +90,7 @@                 | Itemized [DocElement]                 | Definitions [(DocInline, DocInline)]                 | GraphImage DocGraph+                deriving (Eq, Ord, Show, Read)  -- | Inline elements of a document. data DocInline = Text String@@ -98,12 +100,47 @@                | Emphasis DocInline                | DocLink DocInline Location                | DocImage DocInline Location+               deriving (Eq, Ord, Show, Read)  -- | Specify the 'DotGraph' to turn into an image, its filename (sans --   extension) and its caption.  The 'DotGraph' should not have a --   'Size' set.-type DocGraph = (FilePath, DocInline, DotGraph Node)+data DocGraph = DG {  -- | What name to provide the image file+                      --   (without an extension).+                     imageFile   :: FilePath+                   , description :: DocInline+                   , dotGraph    :: DotGraph Node+                   }+              deriving (Eq, Ord, Show, Read) +-- | Defines the parameters used for creating visualisations of+--   graphs.+data VisParams = VParams { -- | Root directory of the document.+                           rootDir      :: FilePath+                           -- | Image sub-directory.+                         , graphDir     :: FilePath+                           -- | The default visualisation.+                         , defaultImage :: VisProperties+                           -- | If @'Just' vp'@, then a larger+                           --   visualisation is linked to from the+                           --   default one.+                         , largeImage   :: Maybe VisProperties+                           -- | Should the Dot source code be saved as well?+                         , saveDot      :: Bool+                         }+               deriving (Eq, Ord, Show, Read)++-- | A specification on how to visualise a 'DocGraph'.+data VisProperties = VProps { size   :: GraphSize+                            , format :: GraphvizOutput+                            }+                   deriving (Eq, Ord, Show, Read)++-- | Specify the size the 'DotGraph' should be at.+data GraphSize = GivenSize Point  -- ^ Specify the size to use.+               | DefaultSize      -- ^ Let GraphViz choose an appropriate size.+               deriving (Eq, Ord, Show, Read)+ -- -----------------------------------------------------------------------------  {- $utilities@@ -111,29 +148,30 @@  -}  -- | Create the legend section and add it to the document proper.-addLegend       :: FilePath -> FilePath -> Document -> IO Document-addLegend fp gfp d = do mLg <- legendToElement fp gfp $ legend d-                        let es = content d-                            es' = maybe es (flip (:) es) mLg-                        return $ d { legend  = []-                                   , content = es'-                                   }+addLegend             :: FilePath -> FilePath -> VisProperties+                         -> Document -> IO Document+addLegend fp gfp vp d = do mLg <- legendToElement fp gfp vp $ legend d+                           let es = content d+                               es' = maybe es (flip (:) es) mLg+                           return $ d { legend  = []+                                      , content = es'+                                      } -legendToElement           :: FilePath -> FilePath -> [(DocGraph, DocInline)]+legendToElement           :: FilePath -> FilePath -> VisProperties+                             -> [(DocGraph, DocInline)]                              -> IO (Maybe DocElement)-legendToElement _  _   [] = return Nothing-legendToElement fp gfp ls = do mDefs <- mapM (uncurry (legToDef fp gfp)) ls-                               let defs = catMaybes mDefs-                                   df   = Definitions defs-                                   sec  = Section (Text "Legend") [df]-                               return $ Just sec--legToDef               :: FilePath -> FilePath -> DocGraph -> DocInline-                          -> IO (Maybe (DocInline, DocInline))-legToDef fp gfp dg def = fmap (fmap (flip (,) def)) img-    where-      img = graphImage fp gfp DefaultSize Png "png" DocImage dg+legendToElement _  _   _  [] = return Nothing+legendToElement fp gfp vp ls = do defs <- mapM (uncurry (legToDef fp gfp vp)) ls+                                  let df   = Definitions defs+                                  return $ Just $ Section (Text "Legend") [df] +legToDef                  :: FilePath -> FilePath -> VisProperties+                             -> DocGraph -> DocInline+                             -> IO (DocInline, DocInline)+legToDef fp gfp vp dg def = liftM (flip (,) def)+                            $ graphImage' fp gfp vp' dg+  where+    vp' = vp { size = DefaultSize }  -- | Return today's date as a string, e.g. \"Monday 1 January, 2000\". --   This arbitrary format is chosen as there doesn't seem to be a way@@ -158,62 +196,73 @@       isRight (Right _) = True       isRight _         = False --- | Attempts to creates a png file (with the given filename in the---   given directory) from the graph using the given attributes.---   If the second set of attributes is not 'Nothing', then the first---   image links to the second.  The whole result is wrapped in a---   'Paragraph'.-createGraph :: FilePath -> FilePath -> GraphSize -> Maybe GraphSize-            -> DocGraph -> IO (Maybe DocElement)-createGraph fp gfp s ms (fn,inl,ag)-    = do eImg <- gI s Png "png" DocImage fn inl Nothing-         if isJust eImg-            then case ms of-                   Nothing    -> rt eImg-                   (Just s') -> rt =<< gI s' Svg "svg" DocLink fn' (toImg eImg) eImg-            else return Nothing-    where-      fn' = fn ++ "-large"-      i2e i = Just (i,Paragraph [i])-      rt = return . fmap snd-      -- This is safe because of the isJust above.-      toImg = fst . fromJust-      gI a o e ln nm lb fl = do mImg <- graphImage fp gfp a o e ln (nm,lb,ag)-                                case mImg of-                                  Nothing    -> return fl-                                  (Just img) -> return $ i2e img+-- | Attempts to create image files (with the given filename in the+--   given directory) from the graph.  If the second 'VisProperties'+--   not 'Nothing', then the first image links to the second.  The+--   whole result is wrapped in a 'Paragraph'.  'unDotPath' is applied+--   to the filename in the 'DocGraph'.+createGraph :: VisParams -- ^ Visualisation parameters.+               -> DocGraph+               -> IO DocElement+createGraph params dg+  = do when (saveDot params) (graphImage rDir gDir vpD dgD >> return ())+       dl  <- graphImage' rDir gDir vp dg'+       dl' <- maybe return tryImg mvp dl+       return $ Paragraph [dl']+  where+    rDir = rootDir params+    gDir = graphDir params+    vp = defaultImage params+    vpD = VProps { size   = DefaultSize+                 , format = Canon+                 }+    mvp = largeImage params+    dg' = dg { imageFile = unDotPath $ imageFile dg }+    dgL = checkLargeFilename vp mvp dg'+    dgD = checkFilename vp vpD "dot" dg'+    tryImg vp' di = liftM (either (const di) (DocLink di))+                   $ graphImage rDir gDir vp' dgL --- | Create the inline image/link from the given DocGraph.-graphImage :: FilePath -> FilePath -> GraphSize-           -> GraphvizOutput -> FilePath-           -> (DocInline -> Location -> DocInline)-           -> DocGraph -> IO (Maybe DocInline)-graphImage fp gfp s output ext link (fn,inl,dg)-    = do created <- runGraphviz dg' output filename'-         if created-            then return (Just img)-            else return Nothing-    where-      dg' = setSize s dg-      fn' = unDotPath fn-      filename = gfp </> fn' <.> ext-      filename' = fp </> filename-      loc = File filename-      img = link inl loc+-- | If both output formats are the same, then the larger image needs+--   a different filename.+checkLargeFilename :: VisProperties -> Maybe VisProperties+                      -> DocGraph -> DocGraph+checkLargeFilename _   Nothing    dg = dg+checkLargeFilename vp1 (Just vp2) dg = checkFilename vp1 vp2 "large" dg --- | Specify the size the 'DotGraph' should be at.-data GraphSize = GivenSize Point  -- ^ Specify the size to use.-               | DefaultSize      -- ^ Let GraphViz choose an appropriate size.+checkFilename :: VisProperties -> VisProperties -> String+                 -> DocGraph -> DocGraph+checkFilename vp1 vp2 s dg+  | format vp1 == format vp2 = dg { imageFile = imageFile dg ++ '-' : s }+  | otherwise                = dg +graphImage :: FilePath -> FilePath -> VisProperties -> DocGraph+              -> IO (Either DocInline Location)+graphImage rDir gDir vp dg = liftM (either' Text (File . fixPath))+                             $ addExtension (runGraphviz dot)+                                            (format vp)+                                            filename+  where+    dot = setSize vp $ dotGraph dg+    filename = rDir </> gDir </> imageFile dg+    fixPath = makeRelative rDir++graphImage' :: FilePath -> FilePath -> VisProperties -> DocGraph+               -> IO DocInline+graphImage' rDir gDir vp dg = liftM (either id f)+                              $ graphImage rDir gDir vp dg+  where+    f = DocImage (description dg)+ -- | Add a 'GlobalAttribute' to the 'DotGraph' specifying the given size.-setSize                 :: GraphSize -> DotGraph a -> DotGraph a-setSize DefaultSize   g = g-setSize (GivenSize p) g = g { graphStatements = stmts' }-    where-      stmts = graphStatements g-      stmts' = stmts { attrStmts = a : attrStmts stmts }-      a = GraphAttrs [s]-      s = Size p+setSize      :: VisProperties -> DotGraph a -> DotGraph a+setSize vp g = case size vp of+                 DefaultSize   -> g+                 (GivenSize s) -> g { graphStatements = setS s}+  where+    setS s = stmts { attrStmts = sizeA s : attrStmts stmts }+    stmts = graphStatements g+    sizeA s = GraphAttrs [Size s]  -- | Using a 6:4 ratio, create the given 'Point' representing --   width,height from the width.@@ -227,3 +276,8 @@     where       replace '.' = '-'       replace c   = c++-- | Map either element of an 'Either'.+either'                 :: (a -> c) -> (b -> d) -> Either a b -> Either c d+either' fl _  (Left a)  = Left  $ fl a+either' _  fr (Right b) = Right $ fr b

@@ -21,13 +21,15 @@       pandocHtml,       pandocLaTeX,       pandocRtf,-      pandocMarkdown+      pandocMarkdown,+      alsoSaveDot     ) where  -- TODO : the ability to create multiple files.  import Data.Graph.Analysis.Reporting +import Data.GraphViz.Commands(GraphvizOutput(Png, Svg)) import Text.Pandoc  import Data.List(intersperse)@@ -44,30 +46,32 @@  -}  pandocHtml :: PandocDocument-pandocHtml = pd { writer       = writeHtmlString-                , extension    = "html"-                , header       = "" -- Header will be included-                , extGraphSize = Just DefaultSize+pandocHtml = pd { writer        = writeHtmlString+                , extension     = "html"+                , templateName  = "html"+                , extGraphProps = Just VProps { size   = DefaultSize+                                              , format = Svg+                                              }                 }  pandocLaTeX :: PandocDocument-pandocLaTeX = pd { writer    = writeLaTeX-                 , extension = "tex"-                 , header    = defaultLaTeXHeader+pandocLaTeX = pd { writer     = writeLaTeX+                 , extension  = "tex"+                 , templateName = "latex"                  -- 4.5" should be less than \textwidth in LaTeX.-                 , graphSize = createSize 4.5+                 , graphProps = defaultProps { size = createSize 4.5 }                  }  pandocRtf :: PandocDocument pandocRtf = pd { writer    = writeRTF                , extension = "rtf"-               , header    = defaultRTFHeader+               , templateName = "rtf"                }  pandocMarkdown :: PandocDocument pandocMarkdown = pd { writer = writeMarkdown                     , extension = "text"-                    , header = ""+                    , templateName = "markdown"                     }  -- -----------------------------------------------------------------------------@@ -79,32 +83,41 @@ -- | Definition of a Pandoc Document.  Size measurements are in inches, --   and a 6:4 ratio is used for width:length. data PandocDocument = PD { -- | The Pandoc document style-                           writer       :: WriterOptions -> Pandoc -> String,+                           writer        :: WriterOptions -> Pandoc -> String                            -- | The file extension used-                           extension    :: FilePath,-                           -- | The Pandoc header to use-                           header       :: String,+                         , extension     :: FilePath+                           -- | Which template to get.+                         , templateName  :: String                            -- | Size of graphs to be produced.-                           graphSize    :: GraphSize,+                         , graphProps    :: VisProperties                            -- | Optional size of external linked graphs.-                           extGraphSize :: Maybe GraphSize+                         , extGraphProps :: Maybe VisProperties+                           -- | Should the Dot source code be saved as well?+                         , keepDot       :: Bool                          }  -- | Some default sizes.  Note that all other fields of 'PandocDocument' --   still need to be defined. pd :: PandocDocument-pd = PD { writer       = undefined,-          extension    = undefined,-          header       = undefined,-          graphSize    = defaultSize,-          extGraphSize = Nothing+pd = PD { writer        = undefined+        , extension     = undefined+        , templateName  = undefined+        , graphProps    = defaultProps+        , extGraphProps = Nothing+        , keepDot       = False         } +-- | Also save the generated Dot code to file when creating visualisations.+alsoSaveDot   :: PandocDocument -> PandocDocument+alsoSaveDot p = p { keepDot = True }+ defaultWidth :: Double defaultWidth = 10 -defaultSize :: GraphSize-defaultSize = createSize defaultWidth+defaultProps :: VisProperties+defaultProps = VProps { size   = createSize defaultWidth+                      , format = Png+                      }  instance DocumentGenerator PandocDocument where     createDocument = createPandoc@@ -119,34 +132,30 @@  -- | Used when traversing the document structure. data PandocProcess = PP { secLevel :: Int-                        , filedir  :: FilePath-                        , graphdir :: FilePath-                        , grSize   :: GraphSize-                        , eGSize   :: Maybe GraphSize+                        , visParams :: VisParams                         }+                   deriving (Eq, Ord, Show, Read)  -- | Start with a level 1 heading. defaultProcess :: PandocProcess-defaultProcess = PP { secLevel = 1-                    , graphdir = undefined-                    , filedir  = undefined-                    , grSize   = undefined-                    , eGSize   = undefined+defaultProcess = PP { secLevel  = 1+                    , visParams = undefined                     }  -- | Create the document. createPandoc     :: PandocDocument -> Document -> IO (Maybe FilePath)-createPandoc p d = do created <- tryCreateDirectory dir+createPandoc p d = do Right template <- getDefaultTemplate (templateName p)+                      created <- tryCreateDirectory dir                       -- If the first one fails, so will this one.                       tryCreateDirectory $ dir </> gdir                       if not created                          then failDoc-                         else do d' <- addLegend dir gdir d+                         else do d' <- addLegend dir gdir (graphProps p) d                                  elems <- multiElems pp $ content d'                                  case elems of                                    Just es -> do let es' = htmlAuthDt : es                                                      pnd = Pandoc meta es'-                                                     doc = convert pnd+                                                     doc = convert template pnd                                                  wr <- tryWrite doc                                                  case wr of                                                    (Right _) -> success@@ -160,13 +169,14 @@       meta = makeMeta (title d) auth dt       -- Html output doesn't show date and auth anywhere by default.       htmlAuthDt = htmlInfo auth dt-      pp = defaultProcess { filedir = dir-                          , graphdir = gdir-                          , grSize = graphSize p-                          , eGSize = extGraphSize p-                          }-      opts = writerOptions { writerHeader = (header p) }-      convert = writer p opts+      pp = defaultProcess { visParams = vp }+      vp = VParams { rootDir      = dir+                   , graphDir     = gdir+                   , defaultImage = graphProps p+                   , largeImage   = extGraphProps p+                   , saveDot      = keepDot p+                   }+      convert t = writer p (writerOptions {writerTemplate = t})       file = dir </> fileFront d <.> extension p       tryWrite :: String -> IO (Either SomeException ())       tryWrite = try . writeFile file@@ -180,8 +190,8 @@  -}  -- | The meta information-makeMeta     :: DocInline -> String -> String -> Meta-makeMeta t a = Meta (inlines t) [a]+makeMeta         :: DocInline -> String -> String -> Meta+makeMeta tle a t = Meta (inlines tle) [[Str a]] [Str t]  -- | Html output doesn't show the author and date; use this to print it. htmlInfo         :: String -> String -> Block@@ -236,16 +246,11 @@                                     return (fmap (return . BulletList) elems')  elements _ (Definitions defs)  = return . Just . return . DefinitionList-                                 $ map (inlines *** (return . Plain . inlines))+                                 $ map (inlines *** ((:[]) . (:[])+                                                     . Plain . inlines))                                        defs -elements p (GraphImage dg)     = do el <- createGraph (filedir p)-                                                      (graphdir p)-                                                      (grSize p)-                                                      (eGSize p) dg-                                    case el of-                                      Nothing  -> return Nothing-                                      Just img -> elements p img+elements p (GraphImage dg)     = elements p =<< createGraph (visParams p) dg  -- | Concatenate the result of multiple calls to 'elements'. multiElems         :: PandocProcess -> [DocElement] -> IO (Maybe [Block])

@@ -22,6 +22,8 @@       LNGroup,       -- * Functions on @GraphData@.       wantedRoots,+      addRoots,+      addRootsBy,       applyAlg,       applyDirAlg,       mergeUnused,@@ -74,6 +76,22 @@       gns = S.fromList $ nodes g       rs = S.fromList $ wantedRootNodes gd       rs' = S.toList $ gns `S.intersection` rs++-- | Add extra expected root nodes.  No checks are made that these+--   are valid 'Node' values.+addRoots      :: GraphData n e -> NGroup -> GraphData n e+addRoots gd ns = gd { wantedRootNodes = S.toList rs' }+    where+      ns' = S.fromList ns+      rs = S.fromList $ wantedRootNodes gd+      rs' = rs `S.union` ns'++-- | Use a filtering function to find extra root nodes to add.+addRootsBy      :: (LNode n -> Bool) -> GraphData n e -> GraphData n e+addRootsBy p gd = addRoots gd rs'+    where+      p' _ = p+      rs' = map node $ applyAlg (filterNodes p') gd  -- | Apply an algorithm to the data to be analysed. applyAlg   :: (AGr n e -> a) -> GraphData n e -> a

@@ -11,14 +11,17 @@     ( -- * Graph functions       -- ** Data extraction       -- $extracting-      node,-      label,+      node,         -- Re-exported from Internal+      label,        -- Re-exported from Internal       labels,       edge,       eLabel,-      addLabels, -- Re-exported from Internal-      filterNodes,-      filterNodes',+      addLabels,    -- Re-exported from Internal+      addLabels',   -- Re-exported from Internal+      getLabels,    -- Re-exported from Internal+      getLabels',   -- Re-exported from Internal+      filterNodes,  -- Re-exported from Internal+      filterNodes', -- Re-exported from Internal       pathValues,       -- ** Graph manipulation       undir,@@ -82,14 +85,6 @@  -- $extracting Extracting data from graphs. --- | The node number of an 'LNode'.-node :: LNode a -> Node-node = fst---- | The label of an 'LNode'.-label :: LNode a -> a-label = snd- -- | The labels of all nodes in a tree. labels :: (Graph g) => g a b -> [a] labels = map label . labNodes@@ -102,14 +97,6 @@ eLabel         :: LEdge b -> b eLabel (_,_,b) = b --- | Find all the labelled nodes in the graph that match the given predicate.-filterNodes     :: (Graph g) => (g a b -> LNode a -> Bool) -> g a b -> [LNode a]-filterNodes p g = filter (p g) (labNodes g)---- | Find all the nodes in the graph that match the given predicate.-filterNodes'     :: (Graph g) => (g a b -> Node -> Bool) -> g a b -> [Node]-filterNodes' p g = filter (p g) (nodes g)- -- | Extract the actual 'LNode's from an 'LPath'. pathValues          :: LPath a -> [LNode a] pathValues (LP lns) = lns@@ -171,7 +158,7 @@ compact' = emap length . compact  -- | Compact the graph by adjoining identical duplicate edges.-compactSame :: (Ord b) => (DynGraph gr) => gr a b -> gr a (Int,b)+compactSame :: (Ord b, DynGraph gr) => gr a b -> gr a (Int,b) compactSame = gmap cmpct     where       cEs = map toAdj . group . sort

@@ -1,5 +1,5 @@ Name:                Graphalyze-Version:             0.8.0.0+Version:             0.9.0.0 Synopsis:            Graph-Theoretic Analysis library. Description:         A library to use graph theory to analyse the relationships                         inherent in discrete data.@@ -31,8 +31,8 @@                          time,                          bktrees >= 0.2,                          fgl >= 5.4.2.2,-                         graphviz >= 2999.6.0.0 && < 2999.7.0.0,-                         pandoc+                         graphviz >= 2999.8.0.0 && < 2999.9.0.0,+                         pandoc >= 1.4 && < 1.5          Exposed-Modules:     Data.Graph.Analysis                              Data.Graph.Analysis.Types

@@ -12,3 +12,7 @@  * Write a README +* For Reporting, have a Document -> IO Document function that+  generates all the visualisations and replaces all GraphImage+  DocElement values with DocImage, etc. (and then the Document ->+  Pandoc conversion can be pure).