content: {- |
  Module      :  ./GUI/displayDependencyGraph.hs
  Description :  create a slightly faked dependency graph of the hets directories
  Copyright   :  (c) jianchun wang and Uni Bremen 2006
  License     :  GPLv2 or higher, see LICENSE.txt
  
  Maintainer  :  Christian.Maeder@dfki.de
  Stability   :  provisional
  Portability :  portable
  
  in order to generate the graph, hets needs to be created with
  -ddump-minimal-imports first. Start the GUI\/displayDependencyGraph
  binary that reads in the .imports files in the top-level directory and
  save the graph as postscript possibly after moving some edges and
  nodes. Suitably convert the postscript file to a .png file and upload
  it.
  
  If the graph contains cycles exclude suitable modules in 'exclude'.
  
  * File, Print..., Page Size A3, Fit to Page, Send to: File
  
  * convert -rotate 90 graph.ps graph.png
  
  
  -}
  
  module Main where
  
  -- for graph display
  import UDrawGraph.Graph
  import Graphs.GraphDisp
  import Graphs.GraphConfigure
  
  -- for windows display
  import HTk.Toolkit.TextDisplay
  import HTk.Kernel.Configuration (size)
  import Events.Events (sync)
  import Events.Destructible (destroy, destroyed)
  import qualified HTk.Toplevel.HTk as HTk
  
  import qualified Data.Map as Map
  import qualified Data.Set as Set
  import qualified Common.Lib.Rel as Rel
  
  import System.Directory
  import Data.List
  
  main :: IO ()
  main = do
      fs <- getDirectoryContents "."
      let suf = ".imports"
          fn = filter (isSuffixOf suf) fs
          ffn = map ( \ s -> take (length s - length suf) s) fn
          ffnn = filter exclude $ filter (elem '.') ffn
          fln = map (takeWhile (not . (== '.'))) ffnn
          fln' = nub fln
      lfs <- mapM (readFile . (++ suf)) ffnn
      let ss = map (filter (isPrefixOf "import") . lines) lfs
          sss = getContent6 ss
          ssss' = map (filter exclude) sss
          ssss = map (map $ takeWhile (not . (== '.'))) ssss'
          sss' = map nub ssss
          graphParms = GraphTitle "Dependency Graph" $$
                          OptimiseLayout True $$
                          AllowClose (return True) $$
                          emptyGraphParms
      wishInst <- HTk.initHTk [HTk.withdrawMainWin]
      depG <- newGraph daVinciSort graphParms
      let flln = nub $ fln' ++ concat sss'
          subNodeMenu = LocalMenu (Menu (Just "Info") [
                        Button "Contents" (\ lg -> createTextDisplay
                        ("Contents of " ++ lg)
                         (showCon lg) [size (80, 25)])])
          showCon lg = unlines (filter (isPrefixOf (lg ++ ".")) ffnn)
          subNodeTypeParms =
                           subNodeMenu $$$
                           Ellipse $$$
                           ValueTitle return $$$
                           Color "yellow" $$$
                           emptyNodeTypeParms
      subNodeType <- newNodeType depG subNodeTypeParms
      subNodeList <- mapM (newNode depG subNodeType) flln
      let slAndNodes = Map.fromList $ zip flln subNodeList
          lookup' g_sl = Map.findWithDefault
                                (error "lookup': node not found")
                                g_sl slAndNodes
          subArcMenu = LocalMenu ( Menu Nothing [])
          subArcTypeParms = subArcMenu $$$
                            ValueTitle id $$$
                              Color "green" $$$
                            emptyArcTypeParms
      subArcType <- newArcType depG subArcTypeParms
      let insertSubArc (node1, node2) =
                             newArc depG subArcType (return "")
                                    (lookup' node1)
                                    (lookup' node2)
      mapM_ insertSubArc $
                       Rel.toList $ Rel.intransKernel $ Rel.transClosure $
                          Rel.fromList
                       $ isIn3 $ concat $ zipWith getContent2 fln sss'
      redraw depG
      sync (destroyed depG)
      destroy wishInst
  
  exclude :: String -> Bool
  exclude s = not
      $ isPrefixOf "ATC." s || isPrefixOf ".ATC_" (dropWhile (/= '.') s)
      || Set.member s (Set.fromList
      [ "Isabelle.CreateTheories"
      , "CspCASLProver.Utils", "CspCASLProver.IsabelleUtils"
      , "CspCASLProver.TransProcesses", "CspCASLProver.CspCASLProver"
      , "CASL.QuickCheck"
      , "Proofs.InferBasic", "Proofs.BatchProcessing"
      , "Comorphisms.GetPreludeLib"
      , "Maude.Maude2DG", "Maude.PreComorphism"
      , "Haskell.Haskell2DG", "Haskell.CreateModules"
      , "Comorphisms.KnownProvers", "Comorphisms.LogicGraph"
      , "Interfaces.GenericATPState"
      , "GUI.Utils", "GUI.Taxonomy"
      , "Driver.Options" -- Static
      , "GUI.GenericATP", "SoftFOL.CreateDFGDoc"
      , "SoftFOL.MathServMapping", "SoftFOL.ProveMathServ"
      , "SoftFOL.ProveDarwin", "SoftFOL.ProveSPASS"
      , "SoftFOL.ProveVampire", "SoftFOL.ProverState"
      , "Taxonomy.MMiSSOntologyGraph"
      , "Propositional.Prop2CNF", "Propositional.Prop2CASLHelpers"
      , "Propositional.Prove"
      , "Modifications.ModalEmbedding"
      , "Static.AnalysisLibrary", "Static.WACocone"
      , "OMDoc.DataTypes"
      , "OMDoc.Export"
      , "Debug.Trace"
      ])
  
  getContent2 :: String -> [String] -> [(String, String)]
  getContent2 x = map (\ m -> (x, m))
  
  getContent4 :: [String] -> [String]
  getContent4 = map ((!! 1) . words)
  
  getContent5 :: [String] -> [String]
  getContent5 = map $ takeWhile (not . (== '('))
  
  getContent6 :: [[String]] -> [[String]]
  getContent6 = map $ filter (elem '.') . getContent5 . getContent4
  
  isIn3 :: (Eq a) => [(a, a)] -> [(a, a)]
  isIn3 = filter $ uncurry (/=)
  