displayDependencyGraph.hs revision b08da428e39d3a35bbba1abf478a454b857d1625
a1a48072301767054f2a9ff7ccf8974b0d6a6a28Christian Maeder{- |
a1a48072301767054f2a9ff7ccf8974b0d6a6a28Christian MaederModule : $Header$
a1a48072301767054f2a9ff7ccf8974b0d6a6a28Christian MaederCopyright : (c) jianchun wang and Uni Bremen 2006
a1a48072301767054f2a9ff7ccf8974b0d6a6a28Christian MaederLicense : similar to LGPL, see HetCATS/LICENSE.txt or LIZENZ.txt
a1a48072301767054f2a9ff7ccf8974b0d6a6a28Christian Maeder
a1a48072301767054f2a9ff7ccf8974b0d6a6a28Christian MaederMaintainer : wjch868@tzi.de
a1a48072301767054f2a9ff7ccf8974b0d6a6a28Christian MaederStability : provisional
a1a48072301767054f2a9ff7ccf8974b0d6a6a28Christian MaederPortability : portable
a1a48072301767054f2a9ff7ccf8974b0d6a6a28Christian Maeder
a1a48072301767054f2a9ff7ccf8974b0d6a6a28Christian Maeder-}
a1a48072301767054f2a9ff7ccf8974b0d6a6a28Christian Maedermodule Main where
a1a48072301767054f2a9ff7ccf8974b0d6a6a28Christian Maeder
a1a48072301767054f2a9ff7ccf8974b0d6a6a28Christian Maeder-- for graph display
a1a48072301767054f2a9ff7ccf8974b0d6a6a28Christian Maederimport DaVinciGraph
a1a48072301767054f2a9ff7ccf8974b0d6a6a28Christian Maederimport GraphDisp
a1a48072301767054f2a9ff7ccf8974b0d6a6a28Christian Maederimport GraphConfigure
5b3e0bbb6a776c60dc14113435a44e7b13d2fa01Christian Maeder
a1a48072301767054f2a9ff7ccf8974b0d6a6a28Christian Maeder-- for windows display
5b3e0bbb6a776c60dc14113435a44e7b13d2fa01Christian Maederimport TextDisplay
a1a48072301767054f2a9ff7ccf8974b0d6a6a28Christian Maederimport Configuration
a1a48072301767054f2a9ff7ccf8974b0d6a6a28Christian Maederimport Events
a1a48072301767054f2a9ff7ccf8974b0d6a6a28Christian Maederimport Destructible
a1a48072301767054f2a9ff7ccf8974b0d6a6a28Christian Maederimport qualified HTk
5b3e0bbb6a776c60dc14113435a44e7b13d2fa01Christian Maeder
5b3e0bbb6a776c60dc14113435a44e7b13d2fa01Christian Maederimport qualified Data.Map as Map
5b3e0bbb6a776c60dc14113435a44e7b13d2fa01Christian Maederimport qualified Data.Set as Set
a1a48072301767054f2a9ff7ccf8974b0d6a6a28Christian Maederimport qualified Common.Lib.Rel as Rel
5b3e0bbb6a776c60dc14113435a44e7b13d2fa01Christian Maeder
5b3e0bbb6a776c60dc14113435a44e7b13d2fa01Christian Maederimport System.Directory
5b3e0bbb6a776c60dc14113435a44e7b13d2fa01Christian Maederimport Data.List
0c92a39a4adf3c1cbe173e3b16c65c159a1ce612Christian Maeder
0c92a39a4adf3c1cbe173e3b16c65c159a1ce612Christian Maedermain :: IO ()
0c92a39a4adf3c1cbe173e3b16c65c159a1ce612Christian Maedermain = do
0c92a39a4adf3c1cbe173e3b16c65c159a1ce612Christian Maeder fs <- getDirectoryContents "."
0c92a39a4adf3c1cbe173e3b16c65c159a1ce612Christian Maeder let suf = ".imports"
0c92a39a4adf3c1cbe173e3b16c65c159a1ce612Christian Maeder fn = filter (isSuffixOf suf) fs
0c92a39a4adf3c1cbe173e3b16c65c159a1ce612Christian Maeder ffn = map ( \ s -> take (length s - length suf) s) fn
0c92a39a4adf3c1cbe173e3b16c65c159a1ce612Christian Maeder ffnn = filter exclude $ filter (elem '.') ffn
5b3e0bbb6a776c60dc14113435a44e7b13d2fa01Christian Maeder fln = map (fst . break (== '.')) ffnn
5b3e0bbb6a776c60dc14113435a44e7b13d2fa01Christian Maeder fln' = nub fln
36a493b7eec0f9d719674296c26afe7fd9bfe327Christian Maeder lfs <- mapM (readFile . (++ suf)) ffnn
5b3e0bbb6a776c60dc14113435a44e7b13d2fa01Christian Maeder let ss = map (filter (isPrefixOf "import") . lines) lfs
0c92a39a4adf3c1cbe173e3b16c65c159a1ce612Christian Maeder sss = getContent6 ss
0c92a39a4adf3c1cbe173e3b16c65c159a1ce612Christian Maeder ssss' = map (filter exclude) sss
0c92a39a4adf3c1cbe173e3b16c65c159a1ce612Christian Maeder ssss = map (map $ fst . break (== '.')) ssss'
0c92a39a4adf3c1cbe173e3b16c65c159a1ce612Christian Maeder sss' = map nub ssss
06f58a67e6df999858bf4f97d5e0786956562d29Christian Maeder graphParms = GraphTitle "Dependency Graph" $$
0c92a39a4adf3c1cbe173e3b16c65c159a1ce612Christian Maeder OptimiseLayout True $$
0c92a39a4adf3c1cbe173e3b16c65c159a1ce612Christian Maeder AllowClose (return True) $$
0c92a39a4adf3c1cbe173e3b16c65c159a1ce612Christian Maeder emptyGraphParms
0c92a39a4adf3c1cbe173e3b16c65c159a1ce612Christian Maeder wishInst <- HTk.initHTk [HTk.withdrawMainWin]
a1a48072301767054f2a9ff7ccf8974b0d6a6a28Christian Maeder depG <- newGraph daVinciSort graphParms
d4aed7a2eea6b546c0d9520d85038addb7beb12fChristian Maeder let flln = nub $ fln' ++ concat sss'
d4aed7a2eea6b546c0d9520d85038addb7beb12fChristian Maeder subNodeMenu = LocalMenu (Menu (Just "Info") [
d4aed7a2eea6b546c0d9520d85038addb7beb12fChristian Maeder Button "Contents" (\lg -> createTextDisplay
a1a48072301767054f2a9ff7ccf8974b0d6a6a28Christian Maeder ("Contents of " ++ lg)
5b3e0bbb6a776c60dc14113435a44e7b13d2fa01Christian Maeder (showCon lg) [size(80,25)])])
5b3e0bbb6a776c60dc14113435a44e7b13d2fa01Christian Maeder showCon lg = unlines (filter (isPrefixOf (lg++".")) ffnn)
5b3e0bbb6a776c60dc14113435a44e7b13d2fa01Christian Maeder subNodeTypeParms =
5b3e0bbb6a776c60dc14113435a44e7b13d2fa01Christian Maeder subNodeMenu $$$
d4aed7a2eea6b546c0d9520d85038addb7beb12fChristian Maeder Ellipse $$$
a1a48072301767054f2a9ff7ccf8974b0d6a6a28Christian Maeder ValueTitle return $$$
36a493b7eec0f9d719674296c26afe7fd9bfe327Christian Maeder Color "yellow" $$$
36a493b7eec0f9d719674296c26afe7fd9bfe327Christian Maeder emptyNodeTypeParms
a1a48072301767054f2a9ff7ccf8974b0d6a6a28Christian Maeder subNodeType <- newNodeType depG subNodeTypeParms
36a493b7eec0f9d719674296c26afe7fd9bfe327Christian Maeder subNodeList <- mapM (newNode depG subNodeType) flln
36a493b7eec0f9d719674296c26afe7fd9bfe327Christian Maeder let slAndNodes = Map.fromList $ zip flln subNodeList
bb2c1beb7ab66a49627a2a34df80864a3c65cc83Christian Maeder lookup' g_sl = Map.findWithDefault
36a493b7eec0f9d719674296c26afe7fd9bfe327Christian Maeder (error "lookup': node not found")
bb2c1beb7ab66a49627a2a34df80864a3c65cc83Christian Maeder g_sl slAndNodes
bb2c1beb7ab66a49627a2a34df80864a3c65cc83Christian Maeder subArcMenu = LocalMenu( Menu Nothing [])
bb2c1beb7ab66a49627a2a34df80864a3c65cc83Christian Maeder subArcTypeParms = subArcMenu $$$
bb2c1beb7ab66a49627a2a34df80864a3c65cc83Christian Maeder ValueTitle id $$$
bb2c1beb7ab66a49627a2a34df80864a3c65cc83Christian Maeder Color "green" $$$
36a493b7eec0f9d719674296c26afe7fd9bfe327Christian Maeder emptyArcTypeParms
36a493b7eec0f9d719674296c26afe7fd9bfe327Christian Maeder subArcType <- newArcType depG subArcTypeParms
36a493b7eec0f9d719674296c26afe7fd9bfe327Christian Maeder let insertSubArc = \ (node1, node2) ->
36a493b7eec0f9d719674296c26afe7fd9bfe327Christian Maeder newArc depG subArcType (return "")
36a493b7eec0f9d719674296c26afe7fd9bfe327Christian Maeder (lookup' node1)
36a493b7eec0f9d719674296c26afe7fd9bfe327Christian Maeder (lookup' node2)
36a493b7eec0f9d719674296c26afe7fd9bfe327Christian Maeder mapM_ insertSubArc $
36a493b7eec0f9d719674296c26afe7fd9bfe327Christian Maeder Rel.toList $ Rel.intransKernel $ Rel.transClosure $
36a493b7eec0f9d719674296c26afe7fd9bfe327Christian Maeder Rel.fromList
36a493b7eec0f9d719674296c26afe7fd9bfe327Christian Maeder $ isIn3 $ concat $ zipWith getContent2 fln sss'
36a493b7eec0f9d719674296c26afe7fd9bfe327Christian Maeder redraw depG
36a493b7eec0f9d719674296c26afe7fd9bfe327Christian Maeder sync(destroyed depG)
36a493b7eec0f9d719674296c26afe7fd9bfe327Christian Maeder destroy wishInst
36a493b7eec0f9d719674296c26afe7fd9bfe327Christian Maeder HTk.finishHTk
36a493b7eec0f9d719674296c26afe7fd9bfe327Christian Maeder
36a493b7eec0f9d719674296c26afe7fd9bfe327Christian Maederexclude :: String -> Bool
5b3e0bbb6a776c60dc14113435a44e7b13d2fa01Christian Maederexclude s = not $
d4aed7a2eea6b546c0d9520d85038addb7beb12fChristian Maeder isPrefixOf "ATC." s || isPrefixOf ".ATC_" (dropWhile (/= '.') s)
d4aed7a2eea6b546c0d9520d85038addb7beb12fChristian Maeder || Set.member s (Set.fromList
36a493b7eec0f9d719674296c26afe7fd9bfe327Christian Maeder [ "Isabelle.CreateTheories"
d4aed7a2eea6b546c0d9520d85038addb7beb12fChristian Maeder , "OWL_DL.ToHaskellAS", "OWL_DL.StructureAna", "OWL_DL.OWLAnalysis"
d4aed7a2eea6b546c0d9520d85038addb7beb12fChristian Maeder , "Haskell.Haskell2DG", "Haskell.CreateModules"
d4aed7a2eea6b546c0d9520d85038addb7beb12fChristian Maeder , "Comorphisms.KnownProvers", "GUI.GenericATPState", "PGIP.Utils"
d4aed7a2eea6b546c0d9520d85038addb7beb12fChristian Maeder , "GUI.Utils", "GUI.ProofManagement" -- Proofs
a1a48072301767054f2a9ff7ccf8974b0d6a6a28Christian Maeder , "Proofs.Automatic", "Driver.Options" -- Static
5b3e0bbb6a776c60dc14113435a44e7b13d2fa01Christian Maeder , "Proofs.EdgeUtils", "Proofs.StatusUtils" -- Driver
38824a7dba4f7d82532afec67e0b594a5af5d76bChristian Maeder , "SPASS.Utils", "Proofs.BatchProcessing", "GUI.GenericATPState"
36a493b7eec0f9d719674296c26afe7fd9bfe327Christian Maeder , "GUI.GenericATP", "SPASS.CreateDFGDoc" -- SPASS
36a493b7eec0f9d719674296c26afe7fd9bfe327Christian Maeder -- , "GUI.Taxonomy", "GUI.ShowGraph" -- PGIP
36a493b7eec0f9d719674296c26afe7fd9bfe327Christian Maeder , "Static.DevGraph", "Syntax.AS_Library", "Static.AnalysisLibrary"
a1a48072301767054f2a9ff7ccf8974b0d6a6a28Christian Maeder , "OMDoc.HetsInterface", "OMDoc.OMDocOutput", "Debug.Trace"
36a493b7eec0f9d719674296c26afe7fd9bfe327Christian Maeder ])
36a493b7eec0f9d719674296c26afe7fd9bfe327Christian Maeder
5b3e0bbb6a776c60dc14113435a44e7b13d2fa01Christian MaedergetContent2 :: String -> [String] -> [(String, String)]
5b3e0bbb6a776c60dc14113435a44e7b13d2fa01Christian MaedergetContent2 x = map (\ m -> (x, m))
5b3e0bbb6a776c60dc14113435a44e7b13d2fa01Christian Maeder
5b3e0bbb6a776c60dc14113435a44e7b13d2fa01Christian MaedergetContent4 :: [String] -> [String]
5b3e0bbb6a776c60dc14113435a44e7b13d2fa01Christian MaedergetContent4 s = map ((!! 1) . words) s
5b3e0bbb6a776c60dc14113435a44e7b13d2fa01Christian Maeder
5b3e0bbb6a776c60dc14113435a44e7b13d2fa01Christian MaedergetContent5 :: [String] -> [String]
5b3e0bbb6a776c60dc14113435a44e7b13d2fa01Christian MaedergetContent5 = map $ fst . break (== '(')
36a493b7eec0f9d719674296c26afe7fd9bfe327Christian Maeder
0c92a39a4adf3c1cbe173e3b16c65c159a1ce612Christian MaedergetContent6 :: [[String]] ->[[String]]
7fe976d9f9c4af1aa7636c568d9919859523de0aChristian MaedergetContent6 = map $ (filter (elem '.')) . getContent5 . getContent4
38f35f2c4a3b6a778f4f68e7af047a174e93abbeChristian Maeder
38f35f2c4a3b6a778f4f68e7af047a174e93abbeChristian MaederisIn3 :: (Eq a)=> [(a, a)] -> [(a, a)]
13140d161d2d2d11d87283d01d57ee3a738a833dChristian MaederisIn3 = filter (\(x,y) -> x /= y)
38f35f2c4a3b6a778f4f68e7af047a174e93abbeChristian Maeder