{-
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.Colors
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
           , callCats
           ]

esCall, mods, esLoc, esData, esClass, esExp, callCats :: (DocGraph, DocInline)

esCall = (dg', R.Bold txt)
    where
      dg' = DG "legend_call" (Text "Function Call") dg
      dg = mkLegendGraph ns es
      nAs = [Shape BoxShape, FillColor defaultNodeColor]
      ns = [ (1, Label (StrLabel e1) : nAs)
           , (2, Label (StrLabel e2) : nAs)
           ]
      e1 = "f"
      e2 = "g"
      eAs = [Color [X11Color Black]]
      es = [(1,2,eAs)]
      txt = Grouping [ Text "Two normal functions with"
                     , Emphasis $ Text e1
                     , Text "calling"
                     , Emphasis $ Text e2
                     , Text "."
                     ]

mods = (dg', R.Bold txt)
    where
      dg' = DG "legend_mods" (Text "Module Import") dg
      dg = mkLegendGraph ns es
      nAs = [Shape Tab, FillColor defaultNodeColor]
      ns = [ (1, Label (StrLabel m1) : nAs)
           , (2, Label (StrLabel m2) : nAs)
           ]
      m1 = "Foo"
      m2 = "Bar"
      es = [(1,2,[])]
      txt = Grouping [ Text "Two modules with module"
                     , Emphasis $ Text m1
                     , Text "importing"
                     , Emphasis $ Text m2
                     , Text "."
                     ]

esLoc = (dg', R.Bold $ Text "Entities from different modules.")
    where
      dg' = DG "legend_loc" (Text "From module") dg
      dg = mkLegendGraph ns es
      nAs = [FillColor defaultNodeColor]
      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' = DG "legend_data" (Text "Data type declaration") dg
      dg = mkLegendGraph ns es
      nAs = [FillColor defaultNodeColor]
      ns = [ (1, Label (StrLabel "Constructor")
                   : Shape Box3D : nAs)
           , (2, Label (StrLabel "Record function")
                   : Shape Component : nAs)
           ]
      es = [(2,1,[ Color [X11Color Magenta], ArrowTail oDot, ArrowHead vee])]

esClass = (dg', R.Bold $ Text "Class and instance declarations.")
    where
      dg' = DG "legend_class" (Text "Class declaration") dg
      dg = mkLegendGraph ns es
      nAs = [FillColor defaultNodeColor]
      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 [X11Color Navy] : eAs)
           , (2,3, Color [X11Color Turquoise] : eAs)
           ]

esExp = (dg', R.Bold $ Text "Entity location/accessibility classification.")
    where
      dg' = DG "legend_loc2" (Text "Entity Location") dg
      dg = mkLegendGraph ns es
      ns = zip [1..]
           [ [ Label (StrLabel "Inaccessible entity")
             , FillColor inaccessibleColor]
           , [ Label (StrLabel "Exported root entity")
             , FillColor exportedRootColor]
           , [ Label (StrLabel "Exported non-root entity")
             , FillColor exportedInnerColor]
           , [ Label (StrLabel "Implicitly exported entity")
             , FillColor implicitExportColor]
           , [ Label (StrLabel "Leaf entity")
             , FillColor leafColor]
           , [ Label (StrLabel "Normal entity")
             , FillColor defaultNodeColor]
           ]
      es = []

callCats = (dg', R.Bold $ Text "Edge classification.")
  where
    dg' = DG "legend_edges" (Text "Edge Classification") dg
    dg = mkLegendGraph ns es
    ns = map (flip (,) [Label (StrLabel ""), Shape PointShape]) [1..5]
    eA = Dir NoDir
    es = [ (1,2, [eA, Label (StrLabel "Clique"), Color [cliqueColor]])
         , (2,3, [eA, Label (StrLabel "Cycle"), Color [cycleColor]])
         , (3,4, [eA, Label (StrLabel "Chain"), Color [chainColor]])
         , (4,5, [eA, Label (StrLabel "Normal"), Color [defaultEdgeColor]])
         ]


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