ShowLibGraph.hs revision f0c15d9d060594deb564ae4c8445664b7e7ba956
53bd0c89aa4743dc41a6394db5a90717c1ca4517Liam O'ReillyModule : $Header$
e9458b1a7a19a63aa4c179f9ab20f4d50681c168Jens ElknerCopyright : (c) Uni Bremen 2003-2007
53bd0c89aa4743dc41a6394db5a90717c1ca4517Liam O'ReillyLicense : GPLv2 or higher, see LICENSE.txt
98890889ffb2e8f6f722b00e265a211f13b5a861Corneliu-Claudiu ProdescuMaintainer : raider@informatik.uni-bremen.de
53bd0c89aa4743dc41a6394db5a90717c1ca4517Liam O'ReillyStability : unstable
53bd0c89aa4743dc41a6394db5a90717c1ca4517Liam O'ReillyPortability : non-portable
53bd0c89aa4743dc41a6394db5a90717c1ca4517Liam O'ReillyThis Modul provides a function to display a Library Dependency Graph.
53bd0c89aa4743dc41a6394db5a90717c1ca4517Liam O'Reilly ( showLibGraph
9aeda2b3ae8ce0b018955521e4ca835a8ba8a27bLiam O'Reilly , closeOpenWindows
66bc8d6e69cde43f1ccbeb76104cf7b8038acd6cChristian Maederimport Driver.Options (HetcatsOpts (outtypes, verbose))
648fe1220044aac847acbdfbc4155af5556063ebChristian Maederimport GUI.GraphLogic (translateGraph, showDGraph)
c0833539c8cf577dd3f2497792fbdd818442744cChristian Maederimport qualified GUI.GraphAbstraction as GA
7830e8fa7442fb7452af7ecdba102bc297ae367eChristian Maederimport qualified Common.Lib.Rel as Rel
b1f12c962a6fb28a298b36cf6a1dcf2ad788fb58Christian Maederimport qualified Data.Map as Map
b1f12c962a6fb28a298b36cf6a1dcf2ad788fb58Christian Maederimport qualified Data.Set as Set
648fe1220044aac847acbdfbc4155af5556063ebChristian Maedertype NodeEdgeList = ([DaVinciNode LibName], [DaVinciArc (IO String)])
648fe1220044aac847acbdfbc4155af5556063ebChristian Maeder{- | Creates a new uDrawGraph Window and shows the Library Dependency Graph of
648fe1220044aac847acbdfbc4155af5556063ebChristian Maeder the given LibEnv. -}
648fe1220044aac847acbdfbc4155af5556063ebChristian MaedershowLibGraph :: LibFunc
648fe1220044aac847acbdfbc4155af5556063ebChristian MaedershowLibGraph gi = do
648fe1220044aac847acbdfbc4155af5556063ebChristian Maeder let lock = libGraphLock gi
648fe1220044aac847acbdfbc4155af5556063ebChristian Maeder isEmpty <- isEmptyMVar lock
648fe1220044aac847acbdfbc4155af5556063ebChristian Maeder when isEmpty $ do
648fe1220044aac847acbdfbc4155af5556063ebChristian Maeder putMVar lock ()
648fe1220044aac847acbdfbc4155af5556063ebChristian Maeder updateWindowCount gi succ
ebd23ec61635b0bebf7969d14f65b9d1e39f2b26Liam O'Reilly graph <- newIORef daVinciSort
d5833d2ee7bafcbf2fdd2bdfd9a728c769b100c7Christian Maeder nodesEdges <- newIORef (([], []) :: NodeEdgeList)
9aeda2b3ae8ce0b018955521e4ca835a8ba8a27bLiam O'Reilly GlobalMenu (UDG.Menu Nothing
33bdce26495121cdbce30331ef90a1969126a840Liam O'Reilly [ Button "Reload Library" $ reloadLibGraph gi graph nodesEdges
648fe1220044aac847acbdfbc4155af5556063ebChristian Maeder , Button "Experimental reload changed Library"
648fe1220044aac847acbdfbc4155af5556063ebChristian Maeder $ changeLibGraph gi graph nodesEdges
648fe1220044aac847acbdfbc4155af5556063ebChristian Maeder , Button "Translate Library" $ translate gi
648fe1220044aac847acbdfbc4155af5556063ebChristian Maeder , Button "Show Logic Graph" showLG
648fe1220044aac847acbdfbc4155af5556063ebChristian Maeder graphParms = globalMenu $$
1a38107941725211e7c3f051f7a8f5e12199f03acmaeder GraphTitle "Library Graph" $$
33bdce26495121cdbce30331ef90a1969126a840Liam O'Reilly OptimiseLayout True $$
33bdce26495121cdbce30331ef90a1969126a840Liam O'Reilly AllowClose (closeGInfo gi) $$
33bdce26495121cdbce30331ef90a1969126a840Liam O'Reilly FileMenuAct ExitMenuOption (Just (exitGInfo gi)) $$
fa373bc327620e08861294716b4454be8d25669fChristian Maeder emptyGraphParms
648fe1220044aac847acbdfbc4155af5556063ebChristian Maeder graph' <- newGraph daVinciSort graphParms
648fe1220044aac847acbdfbc4155af5556063ebChristian Maeder addNodesAndEdges gi graph graph' nodesEdges
648fe1220044aac847acbdfbc4155af5556063ebChristian MaedercloseGInfo :: GInfo -> IO Bool
fa373bc327620e08861294716b4454be8d25669fChristian MaedercloseGInfo gi = do
fa373bc327620e08861294716b4454be8d25669fChristian Maeder updateWindowCount gi pred
fa373bc327620e08861294716b4454be8d25669fChristian Maeder takeMVar (libGraphLock gi)
648fe1220044aac847acbdfbc4155af5556063ebChristian Maeder-- | Reloads all Libraries and the Library Dependency Graph
d5833d2ee7bafcbf2fdd2bdfd9a728c769b100c7Christian MaederreloadLibGraph :: GInfo -> IORef DaVinciGraphTypeSyn -> IORef NodeEdgeList
e8d99f05c231b379be702a1aa8c7dd0b3c666928Liam O'ReillyreloadLibGraph gi graph nodesEdges = do
7857a35e3af533dfbd0f0e18638ebd211e6358a0Christian Maeder b <- warningDialog "Reload library" warnTxt
7857a35e3af533dfbd0f0e18638ebd211e6358a0Christian Maeder when b $ reloadLibGraph' gi graph nodesEdges
e8d99f05c231b379be702a1aa8c7dd0b3c666928Liam O'ReillywarnTxt :: String
e7cd36335f0f7be9ed5005e71d94c2856b588d62Christian MaederwarnTxt = unlines
e7cd36335f0f7be9ed5005e71d94c2856b588d62Christian Maeder [ "Are you sure to recreate Library?"
e7cd36335f0f7be9ed5005e71d94c2856b588d62Christian Maeder , "All development graph windows will be closed and proofs will be lost."
e7cd36335f0f7be9ed5005e71d94c2856b588d62Christian Maeder , "", "This operation can not be undone." ]
648fe1220044aac847acbdfbc4155af5556063ebChristian Maeder-- | Reloads all Libraries and the Library Dependency Graph
648fe1220044aac847acbdfbc4155af5556063ebChristian MaederreloadLibGraph' :: GInfo -> IORef DaVinciGraphTypeSyn -> IORef NodeEdgeList
33bdce26495121cdbce30331ef90a1969126a840Liam O'ReillyreloadLibGraph' gi graph nodesEdges = do
33bdce26495121cdbce30331ef90a1969126a840Liam O'Reilly graph' <- readIORef graph
648fe1220044aac847acbdfbc4155af5556063ebChristian Maeder (nodes, edges) <- readIORef nodesEdges
648fe1220044aac847acbdfbc4155af5556063ebChristian Maeder let ln = libName gi
648fe1220044aac847acbdfbc4155af5556063ebChristian Maeder libfile = libNameToFile ln
c0833539c8cf577dd3f2497792fbdd818442744cChristian Maeder m <- anaLib (hetcatsOpts gi) { outtypes = [] } libfile
c0833539c8cf577dd3f2497792fbdd818442744cChristian Maeder Nothing -> errorDialog "Error" $ "Error when reloading file '"
c0833539c8cf577dd3f2497792fbdd818442744cChristian Maeder ++ libfile ++ "'"
648fe1220044aac847acbdfbc4155af5556063ebChristian Maeder Just (_, le) -> do
648fe1220044aac847acbdfbc4155af5556063ebChristian Maeder closeOpenWindows gi
648fe1220044aac847acbdfbc4155af5556063ebChristian Maeder mapM_ (deleteArc graph') edges
33bdce26495121cdbce30331ef90a1969126a840Liam O'Reilly mapM_ (deleteNode graph') nodes
eb48217dfa67ddb87b8fbd846de293d0636bd578Christian Maeder addNodesAndEdges gi graph graph' nodesEdges
c0833539c8cf577dd3f2497792fbdd818442744cChristian Maeder writeIORef (intState gi) emptyIntState
33bdce26495121cdbce30331ef90a1969126a840Liam O'Reilly { i_state = Just $ emptyIntIState le ln
7830e8fa7442fb7452af7ecdba102bc297ae367eChristian Maeder , filename = libfile }
eb48217dfa67ddb87b8fbd846de293d0636bd578Christian Maeder mShowGraph gi ln
33bdce26495121cdbce30331ef90a1969126a840Liam O'ReillychangeLibGraph :: GInfo -> IORef DaVinciGraphTypeSyn -> IORef NodeEdgeList
eb48217dfa67ddb87b8fbd846de293d0636bd578Christian MaederchangeLibGraph gi graph nodesEdges = do
7830e8fa7442fb7452af7ecdba102bc297ae367eChristian Maeder let ln = libName gi
648fe1220044aac847acbdfbc4155af5556063ebChristian Maeder opts = hetcatsOpts gi
648fe1220044aac847acbdfbc4155af5556063ebChristian Maeder ost <- readIORef $ intState gi
7830e8fa7442fb7452af7ecdba102bc297ae367eChristian Maeder graph' <- readIORef graph
648fe1220044aac847acbdfbc4155af5556063ebChristian Maeder (nodes, edges) <- readIORef nodesEdges
648fe1220044aac847acbdfbc4155af5556063ebChristian Maeder case i_state ost of
4314e26a12954cb1c9be4dea10aa8103edac5bbbChristian Maeder Nothing -> return ()
648fe1220044aac847acbdfbc4155af5556063ebChristian Maeder Just ist -> do
ebd23ec61635b0bebf7969d14f65b9d1e39f2b26Liam O'Reilly let le = i_libEnv ist
648fe1220044aac847acbdfbc4155af5556063ebChristian Maeder dg = lookupDGraph ln le
648fe1220044aac847acbdfbc4155af5556063ebChristian Maeder fn = libNameToFile ln
ebd23ec61635b0bebf7969d14f65b9d1e39f2b26Liam O'Reilly dgold = undoAllChanges dg
648fe1220044aac847acbdfbc4155af5556063ebChristian Maeder c2 = ToXml.dGraph le ln dgold
648fe1220044aac847acbdfbc4155af5556063ebChristian Maeder m <- anaLib opts { outtypes = [] } fn
648fe1220044aac847acbdfbc4155af5556063ebChristian Maeder Just (nln, nle) | nln == ln -> do
648fe1220044aac847acbdfbc4155af5556063ebChristian Maeder let dg2 = lookupDGraph nln nle
648fe1220044aac847acbdfbc4155af5556063ebChristian Maeder ndg = undoAllChanges dg2
33bdce26495121cdbce30331ef90a1969126a840Liam O'Reilly c3 = ToXml.dGraph nle ln ndg
d5833d2ee7bafcbf2fdd2bdfd9a728c769b100c7Christian Maeder xs = hetsXmlDiff c2 c3
d5833d2ee7bafcbf2fdd2bdfd9a728c769b100c7Christian Maeder writeVerbFile opts (libNameToFile ln ++ ".xupdate")
648fe1220044aac847acbdfbc4155af5556063ebChristian Maeder $ ppTopElement xs
648fe1220044aac847acbdfbc4155af5556063ebChristian Maeder Result ds mdg <- runResultT $ dgXUpdateMods opts c2
648fe1220044aac847acbdfbc4155af5556063ebChristian Maeder (getNewEdgeId dgold) xs le ln dg
648fe1220044aac847acbdfbc4155af5556063ebChristian Maeder Just (nLn, fle) -> do
648fe1220044aac847acbdfbc4155af5556063ebChristian Maeder closeOpenWindows gi
2a5b885d9350ec6dd8bc4992ee91d2f68aa592f4Christian Maeder mapM_ (deleteArc graph') edges
7857a35e3af533dfbd0f0e18638ebd211e6358a0Christian Maeder mapM_ (deleteNode graph') nodes
7857a35e3af533dfbd0f0e18638ebd211e6358a0Christian Maeder addNodesAndEdges gi graph graph' nodesEdges
2a5b885d9350ec6dd8bc4992ee91d2f68aa592f4Christian Maeder writeIORef (intState gi) emptyIntState
648fe1220044aac847acbdfbc4155af5556063ebChristian Maeder { i_state = Just $ emptyIntIState fle nLn
2a5b885d9350ec6dd8bc4992ee91d2f68aa592f4Christian Maeder , filename = fn }
7857a35e3af533dfbd0f0e18638ebd211e6358a0Christian Maeder mShowGraph gi nLn
7857a35e3af533dfbd0f0e18638ebd211e6358a0Christian Maeder errorDialog "Error" $ showRelDiags (verbose opts) ds
7830e8fa7442fb7452af7ecdba102bc297ae367eChristian Maeder _ -> errorDialog "Error" $ "Error when reloading file '" ++ fn ++ "'"
aa4d26536fffe0153cd81d28925985892ac2f300Christian Maeder-- | Translate Graph
648fe1220044aac847acbdfbc4155af5556063ebChristian Maedertranslate :: GInfo -> IO ()
648fe1220044aac847acbdfbc4155af5556063ebChristian Maedertranslate gi = do
648fe1220044aac847acbdfbc4155af5556063ebChristian Maeder b <- warningDialog "Translate library" warnTxt
648fe1220044aac847acbdfbc4155af5556063ebChristian Maeder when b $ translate' gi
648fe1220044aac847acbdfbc4155af5556063ebChristian Maeder-- | Translate Graph
648fe1220044aac847acbdfbc4155af5556063ebChristian Maedertranslate' :: GInfo -> IO ()
bcd914850de931848b86d7728192a149f9c0108bChristian Maedertranslate' gi = do
33bdce26495121cdbce30331ef90a1969126a840Liam O'Reilly mle <- translateGraph gi
bc350328e6ac2d9074317e222b4207a6aa49afeaLiam O'Reilly Just le -> do
580f1724640a78be687e79d0ec95dd2665e77e91Liam O'Reilly closeOpenWindows gi
b1f12c962a6fb28a298b36cf6a1dcf2ad788fb58Christian Maeder let ln = libName gi
b1f12c962a6fb28a298b36cf6a1dcf2ad788fb58Christian Maeder ost = emptyIntState
b1f12c962a6fb28a298b36cf6a1dcf2ad788fb58Christian Maeder nwst = case i_state ost of
b1f12c962a6fb28a298b36cf6a1dcf2ad788fb58Christian Maeder Nothing -> ost
b1f12c962a6fb28a298b36cf6a1dcf2ad788fb58Christian Maeder Just ist -> ost { i_state = Just $ ist { i_libEnv = le
f19dc06364e8d6ea36f7c170e1f7a0677de63184Liam O'Reilly , i_ln = ln }
f21c7417bdd1c0282025cba0f5cb0ff5bc5c98eeLiam O'Reilly , filename = libNameToFile ln }
f21c7417bdd1c0282025cba0f5cb0ff5bc5c98eeLiam O'Reilly writeIORef (intState gi) nwst
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder mShowGraph gi ln
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder Nothing -> return ()
b1f12c962a6fb28a298b36cf6a1dcf2ad788fb58Christian Maeder-- | closes the open graphs to be reopened later
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von SchroedercloseOpenWindows :: GInfo -> IO ()
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von SchroedercloseOpenWindows gi = do
ee48a7a67da604356b665e51aa7545536a09b737Christian Maeder let iorOpenGraphs = openGraphs gi
ee48a7a67da604356b665e51aa7545536a09b737Christian Maeder oGraphs <- readIORef iorOpenGraphs
d381ab99d6e2e56e09030577d65d9a118f246d35Christian Maeder mapM_ (GA.closeGraphWindow . graphInfo) $ Map.elems oGraphs
d381ab99d6e2e56e09030577d65d9a118f246d35Christian Maeder updateWindowCount gi (const 1)
ee48a7a67da604356b665e51aa7545536a09b737Christian Maeder writeIORef iorOpenGraphs Map.empty
b1f12c962a6fb28a298b36cf6a1dcf2ad788fb58Christian Maeder-- | Adds the Librarys and the Dependencies to the Graph
b1f12c962a6fb28a298b36cf6a1dcf2ad788fb58Christian MaederaddNodesAndEdges :: GInfo -> IORef DaVinciGraphTypeSyn -> DaVinciGraphTypeSyn
b1f12c962a6fb28a298b36cf6a1dcf2ad788fb58Christian Maeder -> IORef NodeEdgeList -> IO ()
bc350328e6ac2d9074317e222b4207a6aa49afeaLiam O'ReillyaddNodesAndEdges gi graphR graph nodesEdges = do
bc350328e6ac2d9074317e222b4207a6aa49afeaLiam O'Reilly ost <- readIORef $ intState gi
bc350328e6ac2d9074317e222b4207a6aa49afeaLiam O'Reilly case i_state ost of
bc350328e6ac2d9074317e222b4207a6aa49afeaLiam O'Reilly Nothing -> return ()
bc350328e6ac2d9074317e222b4207a6aa49afeaLiam O'Reilly Just ist -> do
580f1724640a78be687e79d0ec95dd2665e77e91Liam O'Reilly le = i_libEnv ist
b1f12c962a6fb28a298b36cf6a1dcf2ad788fb58Christian Maeder opts = hetcatsOpts gi
b1f12c962a6fb28a298b36cf6a1dcf2ad788fb58Christian Maeder (error $ "lookup2': node not found " ++ show y) y x
7d96b1ef2b8597330aedee6713615ec15508edcfLiam O'Reilly subNodeMenu = LocalMenu (UDG.Menu Nothing [
7d96b1ef2b8597330aedee6713615ec15508edcfLiam O'Reilly Button "Show Graph" $ mShowGraph gi,
7d96b1ef2b8597330aedee6713615ec15508edcfLiam O'Reilly Button "Show spec/View Names" $ showSpec le])
7d96b1ef2b8597330aedee6713615ec15508edcfLiam O'Reilly subNodeTypeParms = subNodeMenu $$$
bc350328e6ac2d9074317e222b4207a6aa49afeaLiam O'Reilly ValueTitle (return . show) $$$
bc350328e6ac2d9074317e222b4207a6aa49afeaLiam O'Reilly Color (getColor opts Green True True) $$$
bc350328e6ac2d9074317e222b4207a6aa49afeaLiam O'Reilly emptyNodeTypeParms
bc350328e6ac2d9074317e222b4207a6aa49afeaLiam O'Reilly subNodeType <- newNodeType graph subNodeTypeParms
f19dc06364e8d6ea36f7c170e1f7a0677de63184Liam O'Reilly subNodeList <- mapM (newNode graph subNodeType) keys
f19dc06364e8d6ea36f7c170e1f7a0677de63184Liam O'Reilly nodes' = Map.fromList $ zip keys subNodeList
bc350328e6ac2d9074317e222b4207a6aa49afeaLiam O'Reilly subArcMenu = LocalMenu (UDG.Menu Nothing [])
f19dc06364e8d6ea36f7c170e1f7a0677de63184Liam O'Reilly subArcTypeParms = subArcMenu $$$
bc350328e6ac2d9074317e222b4207a6aa49afeaLiam O'Reilly ValueTitle id $$$
f19dc06364e8d6ea36f7c170e1f7a0677de63184Liam O'Reilly Color (getColor opts Black False False) $$$
f19dc06364e8d6ea36f7c170e1f7a0677de63184Liam O'Reilly emptyArcTypeParms
b1f12c962a6fb28a298b36cf6a1dcf2ad788fb58Christian Maeder subArcType <- newArcType graph subArcTypeParms
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder let insertSubArc (node1, node2) = newArc graph subArcType (return "")
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder (lookup' nodes' node1)
ee48a7a67da604356b665e51aa7545536a09b737Christian Maeder (lookup' nodes' node2)
ee48a7a67da604356b665e51aa7545536a09b737Christian Maeder subArcList <- mapM insertSubArc $ getLibDeps keySet le
ee48a7a67da604356b665e51aa7545536a09b737Christian Maeder writeIORef nodesEdges (subNodeList, subArcList)
ee48a7a67da604356b665e51aa7545536a09b737Christian Maeder writeIORef graphR graph
ee48a7a67da604356b665e51aa7545536a09b737Christian Maeder-- | Creates a list of all LibName pairs, which have a dependency
45e2bc90dd11147156ddd7f9651ce8b2ec00f2a1Christian MaedergetLibDeps :: Set.Set LibName -> LibEnv -> [(LibName, LibName)]
45e2bc90dd11147156ddd7f9651ce8b2ec00f2a1Christian MaedergetLibDeps ks =
ee48a7a67da604356b665e51aa7545536a09b737Christian Maeder Rel.toList . Rel.intransKernel . (`Rel.restrict` ks) . getLibDepRel
b1f12c962a6fb28a298b36cf6a1dcf2ad788fb58Christian MaedermShowGraph :: GInfo -> LibName -> IO ()
b1f12c962a6fb28a298b36cf6a1dcf2ad788fb58Christian MaedermShowGraph gi ln = showDGraph gi ln convertGraph showLibGraph
2a5b885d9350ec6dd8bc4992ee91d2f68aa592f4Christian Maeder-- | Displays the Specs of a Library in a Textwindow
fa373bc327620e08861294716b4454be8d25669fChristian MaedershowSpec :: LibEnv -> LibName -> IO ()
fa373bc327620e08861294716b4454be8d25669fChristian MaedershowSpec le ln =
fa373bc327620e08861294716b4454be8d25669fChristian Maeder createTextDisplay ("Contents of " ++ show ln)
fa373bc327620e08861294716b4454be8d25669fChristian Maeder $ unlines . map show . Map.keys . globalEnv
fa373bc327620e08861294716b4454be8d25669fChristian Maeder $ lookupDGraph ln le