{- |
Module      :  ./GUI/ShowLibGraph.hs
Copyright   :  (c) Uni Bremen 2003-2007
License     :  GPLv2 or higher, see LICENSE.txt

Maintainer  :  raider@informatik.uni-bremen.de
Stability   :  unstable
Portability :  non-portable

This Modul provides a function to display a Library Dependency Graph.
-}

module GUI.ShowLibGraph
  ( showLibGraph
  , mShowGraph
  , closeOpenWindows
  ) where

import Driver.Options (HetcatsOpts (outtypes, verbose))
import Driver.ReadFn
import Driver.WriteFn
import Driver.AnaLib

import Static.DevGraph
import Static.History
import Static.ToXml as ToXml
import Static.ApplyChanges

import GUI.UDGUtils as UDG
import GUI.Utils

import GUI.GraphTypes
import GUI.GraphLogic (translateGraph, showDGraph)
import GUI.ShowLogicGraph
import GUI.GraphDisplay
import qualified GUI.GraphAbstraction as GA

import Common.LibName
import qualified Common.Lib.Rel as Rel
import Common.Result
import Common.ResultT
import Common.XmlDiff

import Text.XML.Light

import Data.IORef
import qualified Data.Map as Map
import qualified Data.Set as Set

import Control.Concurrent.MVar
import Control.Monad

import Interfaces.DataTypes
import Interfaces.Utils

type NodeEdgeList = ([DaVinciNode LibName], [DaVinciArc (IO String)])

{- | Creates a  new uDrawGraph Window and shows the Library Dependency Graph of
     the given LibEnv. -}
showLibGraph :: LibFunc
showLibGraph :: LibFunc
showLibGraph gi :: GInfo
gi = do
  let lock :: MVar ()
lock = GInfo -> MVar ()
libGraphLock GInfo
gi
  Bool
isEmpty <- MVar () -> IO Bool
forall a. MVar a -> IO Bool
isEmptyMVar MVar ()
lock
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isEmpty (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    MVar () -> () -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar ()
lock ()
    GInfo -> (Int -> Int) -> IO ()
updateWindowCount GInfo
gi Int -> Int
forall a. Enum a => a -> a
succ
    IORef
  (Graph
     DaVinciGraph
     DaVinciGraphParms
     DaVinciNode
     DaVinciNodeType
     DaVinciNodeTypeParms
     DaVinciArc
     DaVinciArcType
     DaVinciArcTypeParms)
graph <- Graph
  DaVinciGraph
  DaVinciGraphParms
  DaVinciNode
  DaVinciNodeType
  DaVinciNodeTypeParms
  DaVinciArc
  DaVinciArcType
  DaVinciArcTypeParms
-> IO
     (IORef
        (Graph
           DaVinciGraph
           DaVinciGraphParms
           DaVinciNode
           DaVinciNodeType
           DaVinciNodeTypeParms
           DaVinciArc
           DaVinciArcType
           DaVinciArcTypeParms))
forall a. a -> IO (IORef a)
newIORef Graph
  DaVinciGraph
  DaVinciGraphParms
  DaVinciNode
  DaVinciNodeType
  DaVinciNodeTypeParms
  DaVinciArc
  DaVinciArcType
  DaVinciArcTypeParms
daVinciSort
    IORef NodeEdgeList
nodesEdges <- NodeEdgeList -> IO (IORef NodeEdgeList)
forall a. a -> IO (IORef a)
newIORef (([], []) :: NodeEdgeList)
    let
      globalMenu :: GlobalMenu
globalMenu =
        MenuPrim (Maybe String) (IO ()) -> GlobalMenu
GlobalMenu (Maybe String
-> [MenuPrim (Maybe String) (IO ())]
-> MenuPrim (Maybe String) (IO ())
forall subMenuValue value.
subMenuValue
-> [MenuPrim subMenuValue value] -> MenuPrim subMenuValue value
UDG.Menu Maybe String
forall a. Maybe a
Nothing
          [ String -> IO () -> MenuPrim (Maybe String) (IO ())
forall subMenuValue value.
String -> value -> MenuPrim subMenuValue value
Button "Reload Library" (IO () -> MenuPrim (Maybe String) (IO ()))
-> IO () -> MenuPrim (Maybe String) (IO ())
forall a b. (a -> b) -> a -> b
$ GInfo
-> IORef
     (Graph
        DaVinciGraph
        DaVinciGraphParms
        DaVinciNode
        DaVinciNodeType
        DaVinciNodeTypeParms
        DaVinciArc
        DaVinciArcType
        DaVinciArcTypeParms)
-> IORef NodeEdgeList
-> IO ()
reloadLibGraph GInfo
gi IORef
  (Graph
     DaVinciGraph
     DaVinciGraphParms
     DaVinciNode
     DaVinciNodeType
     DaVinciNodeTypeParms
     DaVinciArc
     DaVinciArcType
     DaVinciArcTypeParms)
graph IORef NodeEdgeList
nodesEdges
          , String -> IO () -> MenuPrim (Maybe String) (IO ())
forall subMenuValue value.
String -> value -> MenuPrim subMenuValue value
Button "Experimental reload changed Library"
                       (IO () -> MenuPrim (Maybe String) (IO ()))
-> IO () -> MenuPrim (Maybe String) (IO ())
forall a b. (a -> b) -> a -> b
$ GInfo
-> IORef
     (Graph
        DaVinciGraph
        DaVinciGraphParms
        DaVinciNode
        DaVinciNodeType
        DaVinciNodeTypeParms
        DaVinciArc
        DaVinciArcType
        DaVinciArcTypeParms)
-> IORef NodeEdgeList
-> IO ()
changeLibGraph GInfo
gi IORef
  (Graph
     DaVinciGraph
     DaVinciGraphParms
     DaVinciNode
     DaVinciNodeType
     DaVinciNodeTypeParms
     DaVinciArc
     DaVinciArcType
     DaVinciArcTypeParms)
graph IORef NodeEdgeList
nodesEdges
          , String -> IO () -> MenuPrim (Maybe String) (IO ())
forall subMenuValue value.
String -> value -> MenuPrim subMenuValue value
Button "Translate Library" (IO () -> MenuPrim (Maybe String) (IO ()))
-> IO () -> MenuPrim (Maybe String) (IO ())
forall a b. (a -> b) -> a -> b
$ LibFunc
translate GInfo
gi
          , String -> IO () -> MenuPrim (Maybe String) (IO ())
forall subMenuValue value.
String -> value -> MenuPrim subMenuValue value
Button "Show Logic Graph" IO ()
showLG
          ])
      graphParms :: DaVinciGraphParms
graphParms = GlobalMenu
globalMenu GlobalMenu -> DaVinciGraphParms -> DaVinciGraphParms
forall option configuration.
HasConfig option configuration =>
option -> configuration -> configuration
$$
                   String -> GraphTitle
GraphTitle "Hets Library Graph" GraphTitle -> DaVinciGraphParms -> DaVinciGraphParms
forall option configuration.
HasConfig option configuration =>
option -> configuration -> configuration
$$
                   Bool -> OptimiseLayout
OptimiseLayout Bool
True OptimiseLayout -> DaVinciGraphParms -> DaVinciGraphParms
forall option configuration.
HasConfig option configuration =>
option -> configuration -> configuration
$$
                   IO Bool -> AllowClose
AllowClose (GInfo -> IO Bool
closeGInfo GInfo
gi) AllowClose -> DaVinciGraphParms -> DaVinciGraphParms
forall option configuration.
HasConfig option configuration =>
option -> configuration -> configuration
$$
                   FileMenuOption -> Maybe (IO ()) -> FileMenuAct
FileMenuAct FileMenuOption
ExitMenuOption (IO () -> Maybe (IO ())
forall a. a -> Maybe a
Just (LibFunc
exitGInfo GInfo
gi)) FileMenuAct -> DaVinciGraphParms -> DaVinciGraphParms
forall option configuration.
HasConfig option configuration =>
option -> configuration -> configuration
$$
                   DaVinciGraphParms
forall graphParms. GraphParms graphParms => graphParms
emptyGraphParms
    Graph
  DaVinciGraph
  DaVinciGraphParms
  DaVinciNode
  DaVinciNodeType
  DaVinciNodeTypeParms
  DaVinciArc
  DaVinciArcType
  DaVinciArcTypeParms
graph' <- Graph
  DaVinciGraph
  DaVinciGraphParms
  DaVinciNode
  DaVinciNodeType
  DaVinciNodeTypeParms
  DaVinciArc
  DaVinciArcType
  DaVinciArcTypeParms
-> DaVinciGraphParms
-> IO
     (Graph
        DaVinciGraph
        DaVinciGraphParms
        DaVinciNode
        DaVinciNodeType
        DaVinciNodeTypeParms
        DaVinciArc
        DaVinciArcType
        DaVinciArcTypeParms)
forall graph graphParms (node :: * -> *) (nodeType :: * -> *)
       (nodeTypeParms :: * -> *) (arc :: * -> *) (arcType :: * -> *)
       (arcTypeParms :: * -> *).
GraphAll
  graph
  graphParms
  node
  nodeType
  nodeTypeParms
  arc
  arcType
  arcTypeParms =>
Graph
  graph
  graphParms
  node
  nodeType
  nodeTypeParms
  arc
  arcType
  arcTypeParms
-> graphParms
-> IO
     (Graph
        graph
        graphParms
        node
        nodeType
        nodeTypeParms
        arc
        arcType
        arcTypeParms)
newGraph Graph
  DaVinciGraph
  DaVinciGraphParms
  DaVinciNode
  DaVinciNodeType
  DaVinciNodeTypeParms
  DaVinciArc
  DaVinciArcType
  DaVinciArcTypeParms
daVinciSort DaVinciGraphParms
graphParms
    GInfo
-> IORef
     (Graph
        DaVinciGraph
        DaVinciGraphParms
        DaVinciNode
        DaVinciNodeType
        DaVinciNodeTypeParms
        DaVinciArc
        DaVinciArcType
        DaVinciArcTypeParms)
-> Graph
     DaVinciGraph
     DaVinciGraphParms
     DaVinciNode
     DaVinciNodeType
     DaVinciNodeTypeParms
     DaVinciArc
     DaVinciArcType
     DaVinciArcTypeParms
-> IORef NodeEdgeList
-> IO ()
addNodesAndEdges GInfo
gi IORef
  (Graph
     DaVinciGraph
     DaVinciGraphParms
     DaVinciNode
     DaVinciNodeType
     DaVinciNodeTypeParms
     DaVinciArc
     DaVinciArcType
     DaVinciArcTypeParms)
graph Graph
  DaVinciGraph
  DaVinciGraphParms
  DaVinciNode
  DaVinciNodeType
  DaVinciNodeTypeParms
  DaVinciArc
  DaVinciArcType
  DaVinciArcTypeParms
graph' IORef NodeEdgeList
nodesEdges

closeGInfo :: GInfo -> IO Bool
closeGInfo :: GInfo -> IO Bool
closeGInfo gi :: GInfo
gi = do
  GInfo -> (Int -> Int) -> IO ()
updateWindowCount GInfo
gi Int -> Int
forall a. Enum a => a -> a
pred
  MVar () -> IO ()
forall a. MVar a -> IO a
takeMVar (GInfo -> MVar ()
libGraphLock GInfo
gi)
  Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True

-- | Reloads all Libraries and the Library Dependency Graph
reloadLibGraph :: GInfo -> IORef DaVinciGraphTypeSyn -> IORef NodeEdgeList
               -> IO ()
reloadLibGraph :: GInfo
-> IORef
     (Graph
        DaVinciGraph
        DaVinciGraphParms
        DaVinciNode
        DaVinciNodeType
        DaVinciNodeTypeParms
        DaVinciArc
        DaVinciArcType
        DaVinciArcTypeParms)
-> IORef NodeEdgeList
-> IO ()
reloadLibGraph gi :: GInfo
gi graph :: IORef
  (Graph
     DaVinciGraph
     DaVinciGraphParms
     DaVinciNode
     DaVinciNodeType
     DaVinciNodeTypeParms
     DaVinciArc
     DaVinciArcType
     DaVinciArcTypeParms)
graph nodesEdges :: IORef NodeEdgeList
nodesEdges = do
  Bool
b <- String -> String -> IO Bool
warningDialog "Reload library" String
warnTxt
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
b (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ GInfo
-> IORef
     (Graph
        DaVinciGraph
        DaVinciGraphParms
        DaVinciNode
        DaVinciNodeType
        DaVinciNodeTypeParms
        DaVinciArc
        DaVinciArcType
        DaVinciArcTypeParms)
-> IORef NodeEdgeList
-> IO ()
reloadLibGraph' GInfo
gi IORef
  (Graph
     DaVinciGraph
     DaVinciGraphParms
     DaVinciNode
     DaVinciNodeType
     DaVinciNodeTypeParms
     DaVinciArc
     DaVinciArcType
     DaVinciArcTypeParms)
graph IORef NodeEdgeList
nodesEdges

warnTxt :: String
warnTxt :: String
warnTxt = [String] -> String
unlines
  [ "Are you sure to recreate Library?"
  , "All development graph windows will be closed and proofs will be lost."
  , "", "This operation can not be undone." ]

-- | Reloads all Libraries and the Library Dependency Graph
reloadLibGraph' :: GInfo -> IORef DaVinciGraphTypeSyn -> IORef NodeEdgeList
                -> IO ()
reloadLibGraph' :: GInfo
-> IORef
     (Graph
        DaVinciGraph
        DaVinciGraphParms
        DaVinciNode
        DaVinciNodeType
        DaVinciNodeTypeParms
        DaVinciArc
        DaVinciArcType
        DaVinciArcTypeParms)
-> IORef NodeEdgeList
-> IO ()
reloadLibGraph' gi :: GInfo
gi graph :: IORef
  (Graph
     DaVinciGraph
     DaVinciGraphParms
     DaVinciNode
     DaVinciNodeType
     DaVinciNodeTypeParms
     DaVinciArc
     DaVinciArcType
     DaVinciArcTypeParms)
graph nodesEdges :: IORef NodeEdgeList
nodesEdges = do
  Graph
  DaVinciGraph
  DaVinciGraphParms
  DaVinciNode
  DaVinciNodeType
  DaVinciNodeTypeParms
  DaVinciArc
  DaVinciArcType
  DaVinciArcTypeParms
graph' <- IORef
  (Graph
     DaVinciGraph
     DaVinciGraphParms
     DaVinciNode
     DaVinciNodeType
     DaVinciNodeTypeParms
     DaVinciArc
     DaVinciArcType
     DaVinciArcTypeParms)
-> IO
     (Graph
        DaVinciGraph
        DaVinciGraphParms
        DaVinciNode
        DaVinciNodeType
        DaVinciNodeTypeParms
        DaVinciArc
        DaVinciArcType
        DaVinciArcTypeParms)
forall a. IORef a -> IO a
readIORef IORef
  (Graph
     DaVinciGraph
     DaVinciGraphParms
     DaVinciNode
     DaVinciNodeType
     DaVinciNodeTypeParms
     DaVinciArc
     DaVinciArcType
     DaVinciArcTypeParms)
graph
  (nodes :: [DaVinciNode LibName]
nodes, edges :: [DaVinciArc (IO String)]
edges) <- IORef NodeEdgeList -> IO NodeEdgeList
forall a. IORef a -> IO a
readIORef IORef NodeEdgeList
nodesEdges
  let ln :: LibName
ln = GInfo -> LibName
libName GInfo
gi
      libfile :: String
libfile = LibName -> String
libNameToFile LibName
ln
  Maybe (LibName, LibEnv)
m <- HetcatsOpts -> String -> IO (Maybe (LibName, LibEnv))
anaLib (GInfo -> HetcatsOpts
hetcatsOpts GInfo
gi) { outtypes :: [OutType]
outtypes = [] } String
libfile
  case Maybe (LibName, LibEnv)
m of
    Nothing -> String -> String -> IO ()
errorDialog "Error" (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ "Error when reloading file '"
                                     String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
libfile String -> String -> String
forall a. [a] -> [a] -> [a]
++ "'"
    Just (_, le :: LibEnv
le) -> do
      LibFunc
closeOpenWindows GInfo
gi
      (DaVinciArc (IO String) -> IO ())
-> [DaVinciArc (IO String)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Graph
  DaVinciGraph
  DaVinciGraphParms
  DaVinciNode
  DaVinciNodeType
  DaVinciNodeTypeParms
  DaVinciArc
  DaVinciArcType
  DaVinciArcTypeParms
-> DaVinciArc (IO String) -> IO ()
forall graph graphParms (node :: * -> *) (nodeType :: * -> *)
       (nodeTypeParms :: * -> *) (arc :: * -> *) (arcType :: * -> *)
       (arcTypeParms :: * -> *) value.
(GraphAll
   graph
   graphParms
   node
   nodeType
   nodeTypeParms
   arc
   arcType
   arcTypeParms,
 Typeable value) =>
Graph
  graph
  graphParms
  node
  nodeType
  nodeTypeParms
  arc
  arcType
  arcTypeParms
-> arc value -> IO ()
deleteArc Graph
  DaVinciGraph
  DaVinciGraphParms
  DaVinciNode
  DaVinciNodeType
  DaVinciNodeTypeParms
  DaVinciArc
  DaVinciArcType
  DaVinciArcTypeParms
graph') [DaVinciArc (IO String)]
edges
      (DaVinciNode LibName -> IO ()) -> [DaVinciNode LibName] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Graph
  DaVinciGraph
  DaVinciGraphParms
  DaVinciNode
  DaVinciNodeType
  DaVinciNodeTypeParms
  DaVinciArc
  DaVinciArcType
  DaVinciArcTypeParms
-> DaVinciNode LibName -> IO ()
forall graph graphParms (node :: * -> *) (nodeType :: * -> *)
       (nodeTypeParms :: * -> *) (arc :: * -> *) (arcType :: * -> *)
       (arcTypeParms :: * -> *) value.
(GraphAll
   graph
   graphParms
   node
   nodeType
   nodeTypeParms
   arc
   arcType
   arcTypeParms,
 Typeable value) =>
Graph
  graph
  graphParms
  node
  nodeType
  nodeTypeParms
  arc
  arcType
  arcTypeParms
-> node value -> IO ()
deleteNode Graph
  DaVinciGraph
  DaVinciGraphParms
  DaVinciNode
  DaVinciNodeType
  DaVinciNodeTypeParms
  DaVinciArc
  DaVinciArcType
  DaVinciArcTypeParms
graph') [DaVinciNode LibName]
nodes
      GInfo
-> IORef
     (Graph
        DaVinciGraph
        DaVinciGraphParms
        DaVinciNode
        DaVinciNodeType
        DaVinciNodeTypeParms
        DaVinciArc
        DaVinciArcType
        DaVinciArcTypeParms)
-> Graph
     DaVinciGraph
     DaVinciGraphParms
     DaVinciNode
     DaVinciNodeType
     DaVinciNodeTypeParms
     DaVinciArc
     DaVinciArcType
     DaVinciArcTypeParms
-> IORef NodeEdgeList
-> IO ()
addNodesAndEdges GInfo
gi IORef
  (Graph
     DaVinciGraph
     DaVinciGraphParms
     DaVinciNode
     DaVinciNodeType
     DaVinciNodeTypeParms
     DaVinciArc
     DaVinciArcType
     DaVinciArcTypeParms)
graph Graph
  DaVinciGraph
  DaVinciGraphParms
  DaVinciNode
  DaVinciNodeType
  DaVinciNodeTypeParms
  DaVinciArc
  DaVinciArcType
  DaVinciArcTypeParms
graph' IORef NodeEdgeList
nodesEdges
      IORef IntState -> IntState -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (GInfo -> IORef IntState
intState GInfo
gi) IntState
emptyIntState
                 { i_state :: Maybe IntIState
i_state = IntIState -> Maybe IntIState
forall a. a -> Maybe a
Just (IntIState -> Maybe IntIState) -> IntIState -> Maybe IntIState
forall a b. (a -> b) -> a -> b
$ LibEnv -> LibName -> IntIState
emptyIntIState LibEnv
le LibName
ln
                 , filename :: String
filename = String
libfile }
      GInfo -> LibName -> IO ()
mShowGraph GInfo
gi LibName
ln

changeLibGraph :: GInfo -> IORef DaVinciGraphTypeSyn -> IORef NodeEdgeList
  -> IO ()
changeLibGraph :: GInfo
-> IORef
     (Graph
        DaVinciGraph
        DaVinciGraphParms
        DaVinciNode
        DaVinciNodeType
        DaVinciNodeTypeParms
        DaVinciArc
        DaVinciArcType
        DaVinciArcTypeParms)
-> IORef NodeEdgeList
-> IO ()
changeLibGraph gi :: GInfo
gi graph :: IORef
  (Graph
     DaVinciGraph
     DaVinciGraphParms
     DaVinciNode
     DaVinciNodeType
     DaVinciNodeTypeParms
     DaVinciArc
     DaVinciArcType
     DaVinciArcTypeParms)
graph nodesEdges :: IORef NodeEdgeList
nodesEdges = do
  let ln :: LibName
ln = GInfo -> LibName
libName GInfo
gi
      opts :: HetcatsOpts
opts = GInfo -> HetcatsOpts
hetcatsOpts GInfo
gi
  IntState
ost <- IORef IntState -> IO IntState
forall a. IORef a -> IO a
readIORef (IORef IntState -> IO IntState) -> IORef IntState -> IO IntState
forall a b. (a -> b) -> a -> b
$ GInfo -> IORef IntState
intState GInfo
gi
  Graph
  DaVinciGraph
  DaVinciGraphParms
  DaVinciNode
  DaVinciNodeType
  DaVinciNodeTypeParms
  DaVinciArc
  DaVinciArcType
  DaVinciArcTypeParms
graph' <- IORef
  (Graph
     DaVinciGraph
     DaVinciGraphParms
     DaVinciNode
     DaVinciNodeType
     DaVinciNodeTypeParms
     DaVinciArc
     DaVinciArcType
     DaVinciArcTypeParms)
-> IO
     (Graph
        DaVinciGraph
        DaVinciGraphParms
        DaVinciNode
        DaVinciNodeType
        DaVinciNodeTypeParms
        DaVinciArc
        DaVinciArcType
        DaVinciArcTypeParms)
forall a. IORef a -> IO a
readIORef IORef
  (Graph
     DaVinciGraph
     DaVinciGraphParms
     DaVinciNode
     DaVinciNodeType
     DaVinciNodeTypeParms
     DaVinciArc
     DaVinciArcType
     DaVinciArcTypeParms)
graph
  (nodes :: [DaVinciNode LibName]
nodes, edges :: [DaVinciArc (IO String)]
edges) <- IORef NodeEdgeList -> IO NodeEdgeList
forall a. IORef a -> IO a
readIORef IORef NodeEdgeList
nodesEdges
  case IntState -> Maybe IntIState
i_state IntState
ost of
    Nothing -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Just ist :: IntIState
ist -> do
      let le :: LibEnv
le = IntIState -> LibEnv
i_libEnv IntIState
ist
          dg :: DGraph
dg = LibName -> LibEnv -> DGraph
lookupDGraph LibName
ln LibEnv
le
          fn :: String
fn = LibName -> String
libNameToFile LibName
ln
          dgold :: DGraph
dgold = DGraph -> DGraph
undoAllChanges DGraph
dg
          c2 :: Element
c2 = HetcatsOpts -> LibEnv -> LibName -> DGraph -> Element
ToXml.dGraph HetcatsOpts
opts LibEnv
le LibName
ln DGraph
dgold
      Maybe (LibName, LibEnv)
m <- HetcatsOpts -> String -> IO (Maybe (LibName, LibEnv))
anaLib HetcatsOpts
opts { outtypes :: [OutType]
outtypes = [] } String
fn
      case Maybe (LibName, LibEnv)
m of
        Just (nln :: LibName
nln, nle :: LibEnv
nle) | LibName
nln LibName -> LibName -> Bool
forall a. Eq a => a -> a -> Bool
== LibName
ln -> do
          let dg2 :: DGraph
dg2 = LibName -> LibEnv -> DGraph
lookupDGraph LibName
nln LibEnv
nle
              ndg :: DGraph
ndg = DGraph -> DGraph
undoAllChanges DGraph
dg2
              c3 :: Element
c3 = HetcatsOpts -> LibEnv -> LibName -> DGraph -> Element
ToXml.dGraph HetcatsOpts
opts LibEnv
nle LibName
ln DGraph
ndg
              xs :: Element
xs = Element -> Element -> Element
hetsXmlDiff Element
c2 Element
c3
          HetcatsOpts -> String -> String -> IO ()
writeVerbFile HetcatsOpts
opts (LibName -> String
libNameToFile LibName
ln String -> String -> String
forall a. [a] -> [a] -> [a]
++ ".xupdate")
            (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ Element -> String
ppTopElement Element
xs
          Result ds :: [Diagnosis]
ds mdg :: Maybe (LibName, LibEnv)
mdg <- ResultT IO (LibName, LibEnv) -> IO (Result (LibName, LibEnv))
forall (m :: * -> *) a. ResultT m a -> m (Result a)
runResultT (ResultT IO (LibName, LibEnv) -> IO (Result (LibName, LibEnv)))
-> ResultT IO (LibName, LibEnv) -> IO (Result (LibName, LibEnv))
forall a b. (a -> b) -> a -> b
$ HetcatsOpts
-> Element
-> EdgeId
-> Element
-> LibEnv
-> LibName
-> DGraph
-> ResultT IO (LibName, LibEnv)
dgXUpdateMods HetcatsOpts
opts Element
c2
            (DGraph -> EdgeId
getNewEdgeId DGraph
dgold) Element
xs LibEnv
le LibName
ln DGraph
dg
          case Maybe (LibName, LibEnv)
mdg of
                Just (nLn :: LibName
nLn, fle :: LibEnv
fle) -> do
                  LibFunc
closeOpenWindows GInfo
gi
                  (DaVinciArc (IO String) -> IO ())
-> [DaVinciArc (IO String)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Graph
  DaVinciGraph
  DaVinciGraphParms
  DaVinciNode
  DaVinciNodeType
  DaVinciNodeTypeParms
  DaVinciArc
  DaVinciArcType
  DaVinciArcTypeParms
-> DaVinciArc (IO String) -> IO ()
forall graph graphParms (node :: * -> *) (nodeType :: * -> *)
       (nodeTypeParms :: * -> *) (arc :: * -> *) (arcType :: * -> *)
       (arcTypeParms :: * -> *) value.
(GraphAll
   graph
   graphParms
   node
   nodeType
   nodeTypeParms
   arc
   arcType
   arcTypeParms,
 Typeable value) =>
Graph
  graph
  graphParms
  node
  nodeType
  nodeTypeParms
  arc
  arcType
  arcTypeParms
-> arc value -> IO ()
deleteArc Graph
  DaVinciGraph
  DaVinciGraphParms
  DaVinciNode
  DaVinciNodeType
  DaVinciNodeTypeParms
  DaVinciArc
  DaVinciArcType
  DaVinciArcTypeParms
graph') [DaVinciArc (IO String)]
edges
                  (DaVinciNode LibName -> IO ()) -> [DaVinciNode LibName] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Graph
  DaVinciGraph
  DaVinciGraphParms
  DaVinciNode
  DaVinciNodeType
  DaVinciNodeTypeParms
  DaVinciArc
  DaVinciArcType
  DaVinciArcTypeParms
-> DaVinciNode LibName -> IO ()
forall graph graphParms (node :: * -> *) (nodeType :: * -> *)
       (nodeTypeParms :: * -> *) (arc :: * -> *) (arcType :: * -> *)
       (arcTypeParms :: * -> *) value.
(GraphAll
   graph
   graphParms
   node
   nodeType
   nodeTypeParms
   arc
   arcType
   arcTypeParms,
 Typeable value) =>
Graph
  graph
  graphParms
  node
  nodeType
  nodeTypeParms
  arc
  arcType
  arcTypeParms
-> node value -> IO ()
deleteNode Graph
  DaVinciGraph
  DaVinciGraphParms
  DaVinciNode
  DaVinciNodeType
  DaVinciNodeTypeParms
  DaVinciArc
  DaVinciArcType
  DaVinciArcTypeParms
graph') [DaVinciNode LibName]
nodes
                  GInfo
-> IORef
     (Graph
        DaVinciGraph
        DaVinciGraphParms
        DaVinciNode
        DaVinciNodeType
        DaVinciNodeTypeParms
        DaVinciArc
        DaVinciArcType
        DaVinciArcTypeParms)
-> Graph
     DaVinciGraph
     DaVinciGraphParms
     DaVinciNode
     DaVinciNodeType
     DaVinciNodeTypeParms
     DaVinciArc
     DaVinciArcType
     DaVinciArcTypeParms
-> IORef NodeEdgeList
-> IO ()
addNodesAndEdges GInfo
gi IORef
  (Graph
     DaVinciGraph
     DaVinciGraphParms
     DaVinciNode
     DaVinciNodeType
     DaVinciNodeTypeParms
     DaVinciArc
     DaVinciArcType
     DaVinciArcTypeParms)
graph Graph
  DaVinciGraph
  DaVinciGraphParms
  DaVinciNode
  DaVinciNodeType
  DaVinciNodeTypeParms
  DaVinciArc
  DaVinciArcType
  DaVinciArcTypeParms
graph' IORef NodeEdgeList
nodesEdges
                  IORef IntState -> IntState -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (GInfo -> IORef IntState
intState GInfo
gi) IntState
emptyIntState
                        { i_state :: Maybe IntIState
i_state = IntIState -> Maybe IntIState
forall a. a -> Maybe a
Just (IntIState -> Maybe IntIState) -> IntIState -> Maybe IntIState
forall a b. (a -> b) -> a -> b
$ LibEnv -> LibName -> IntIState
emptyIntIState LibEnv
fle LibName
nLn
                        , filename :: String
filename = String
fn }
                  GInfo -> LibName -> IO ()
mShowGraph GInfo
gi LibName
nLn
                Nothing ->
                  String -> String -> IO ()
errorDialog "Error" (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> [Diagnosis] -> String
showRelDiags (HetcatsOpts -> Int
verbose HetcatsOpts
opts) [Diagnosis]
ds
        _ -> String -> String -> IO ()
errorDialog "Error" (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ "Error when reloading file '" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
fn String -> String -> String
forall a. [a] -> [a] -> [a]
++ "'"

-- | Translate Graph
translate :: GInfo -> IO ()
translate :: LibFunc
translate gi :: GInfo
gi = do
  Bool
b <- String -> String -> IO Bool
warningDialog "Translate library" String
warnTxt
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
b (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ LibFunc
translate' GInfo
gi

-- | Translate Graph
translate' :: GInfo -> IO ()
translate' :: LibFunc
translate' gi :: GInfo
gi = do
  Maybe LibEnv
mle <- GInfo -> IO (Maybe LibEnv)
translateGraph GInfo
gi
  case Maybe LibEnv
mle of
    Just le :: LibEnv
le -> do
      LibFunc
closeOpenWindows GInfo
gi
      let ln :: LibName
ln = GInfo -> LibName
libName GInfo
gi
          ost :: IntState
ost = IntState
emptyIntState
          nwst :: IntState
nwst = case IntState -> Maybe IntIState
i_state IntState
ost of
            Nothing -> IntState
ost
            Just ist :: IntIState
ist -> IntState
ost { i_state :: Maybe IntIState
i_state = IntIState -> Maybe IntIState
forall a. a -> Maybe a
Just (IntIState -> Maybe IntIState) -> IntIState -> Maybe IntIState
forall a b. (a -> b) -> a -> b
$ IntIState
ist { i_libEnv :: LibEnv
i_libEnv = LibEnv
le
                                                   , i_ln :: LibName
i_ln = LibName
ln }
                            , filename :: String
filename = LibName -> String
libNameToFile LibName
ln }
      IORef IntState -> IntState -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (GInfo -> IORef IntState
intState GInfo
gi) IntState
nwst
      GInfo -> LibName -> IO ()
mShowGraph GInfo
gi LibName
ln
    Nothing -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | closes the open graphs to be reopened later
closeOpenWindows :: GInfo -> IO ()
closeOpenWindows :: LibFunc
closeOpenWindows gi :: GInfo
gi = do
  let iorOpenGraphs :: IORef (Map LibName GInfo)
iorOpenGraphs = GInfo -> IORef (Map LibName GInfo)
openGraphs GInfo
gi
  Map LibName GInfo
oGraphs <- IORef (Map LibName GInfo) -> IO (Map LibName GInfo)
forall a. IORef a -> IO a
readIORef IORef (Map LibName GInfo)
iorOpenGraphs
  LibFunc -> [GInfo] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (GraphInfo -> IO ()
GA.closeGraphWindow (GraphInfo -> IO ()) -> (GInfo -> GraphInfo) -> LibFunc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GInfo -> GraphInfo
graphInfo) ([GInfo] -> IO ()) -> [GInfo] -> IO ()
forall a b. (a -> b) -> a -> b
$ Map LibName GInfo -> [GInfo]
forall k a. Map k a -> [a]
Map.elems Map LibName GInfo
oGraphs
  GInfo -> (Int -> Int) -> IO ()
updateWindowCount GInfo
gi (Int -> Int -> Int
forall a b. a -> b -> a
const 1)
  IORef (Map LibName GInfo) -> Map LibName GInfo -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Map LibName GInfo)
iorOpenGraphs Map LibName GInfo
forall k a. Map k a
Map.empty

-- | Adds the Librarys and the Dependencies to the Graph
addNodesAndEdges :: GInfo -> IORef DaVinciGraphTypeSyn -> DaVinciGraphTypeSyn
  -> IORef NodeEdgeList -> IO ()
addNodesAndEdges :: GInfo
-> IORef
     (Graph
        DaVinciGraph
        DaVinciGraphParms
        DaVinciNode
        DaVinciNodeType
        DaVinciNodeTypeParms
        DaVinciArc
        DaVinciArcType
        DaVinciArcTypeParms)
-> Graph
     DaVinciGraph
     DaVinciGraphParms
     DaVinciNode
     DaVinciNodeType
     DaVinciNodeTypeParms
     DaVinciArc
     DaVinciArcType
     DaVinciArcTypeParms
-> IORef NodeEdgeList
-> IO ()
addNodesAndEdges gi :: GInfo
gi graphR :: IORef
  (Graph
     DaVinciGraph
     DaVinciGraphParms
     DaVinciNode
     DaVinciNodeType
     DaVinciNodeTypeParms
     DaVinciArc
     DaVinciArcType
     DaVinciArcTypeParms)
graphR graph :: Graph
  DaVinciGraph
  DaVinciGraphParms
  DaVinciNode
  DaVinciNodeType
  DaVinciNodeTypeParms
  DaVinciArc
  DaVinciArcType
  DaVinciArcTypeParms
graph nodesEdges :: IORef NodeEdgeList
nodesEdges = do
 IntState
ost <- IORef IntState -> IO IntState
forall a. IORef a -> IO a
readIORef (IORef IntState -> IO IntState) -> IORef IntState -> IO IntState
forall a b. (a -> b) -> a -> b
$ GInfo -> IORef IntState
intState GInfo
gi
 case IntState -> Maybe IntIState
i_state IntState
ost of
  Nothing -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  Just ist :: IntIState
ist -> do
   let
    le :: LibEnv
le = IntIState -> LibEnv
i_libEnv IntIState
ist
    opts :: HetcatsOpts
opts = GInfo -> HetcatsOpts
hetcatsOpts GInfo
gi
    lookup' :: Map k a -> k -> a
lookup' x :: Map k a
x y :: k
y = a -> k -> Map k a -> a
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault
      (String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ "lookup2': node not found " String -> String -> String
forall a. [a] -> [a] -> [a]
++ k -> String
forall a. Show a => a -> String
show k
y) k
y Map k a
x
    keySet :: Set LibName
keySet = LibEnv -> Set LibName
forall k a. Map k a -> Set k
Map.keysSet LibEnv
le
    keys :: [LibName]
keys = Set LibName -> [LibName]
forall a. Set a -> [a]
Set.toList Set LibName
keySet
    subNodeMenu :: LocalMenu LibName
subNodeMenu = MenuPrim (Maybe String) (LibName -> IO ()) -> LocalMenu LibName
forall value.
MenuPrim (Maybe String) (value -> IO ()) -> LocalMenu value
LocalMenu (Maybe String
-> [MenuPrim (Maybe String) (LibName -> IO ())]
-> MenuPrim (Maybe String) (LibName -> IO ())
forall subMenuValue value.
subMenuValue
-> [MenuPrim subMenuValue value] -> MenuPrim subMenuValue value
UDG.Menu Maybe String
forall a. Maybe a
Nothing [
      String
-> (LibName -> IO ()) -> MenuPrim (Maybe String) (LibName -> IO ())
forall subMenuValue value.
String -> value -> MenuPrim subMenuValue value
Button "Show Graph" ((LibName -> IO ()) -> MenuPrim (Maybe String) (LibName -> IO ()))
-> (LibName -> IO ()) -> MenuPrim (Maybe String) (LibName -> IO ())
forall a b. (a -> b) -> a -> b
$ GInfo -> LibName -> IO ()
mShowGraph GInfo
gi,
      String
-> (LibName -> IO ()) -> MenuPrim (Maybe String) (LibName -> IO ())
forall subMenuValue value.
String -> value -> MenuPrim subMenuValue value
Button "Show spec/View Names" ((LibName -> IO ()) -> MenuPrim (Maybe String) (LibName -> IO ()))
-> (LibName -> IO ()) -> MenuPrim (Maybe String) (LibName -> IO ())
forall a b. (a -> b) -> a -> b
$ LibEnv -> LibName -> IO ()
showSpec LibEnv
le])
    subNodeTypeParms :: DaVinciNodeTypeParms LibName
subNodeTypeParms = LocalMenu LibName
subNodeMenu LocalMenu LibName
-> DaVinciNodeTypeParms LibName -> DaVinciNodeTypeParms LibName
forall (option :: * -> *) (configuration :: * -> *) value.
(HasConfigValue option configuration, Typeable value) =>
option value -> configuration value -> configuration value
$$$
                       Shape LibName
forall value. Shape value
Box Shape LibName
-> DaVinciNodeTypeParms LibName -> DaVinciNodeTypeParms LibName
forall (option :: * -> *) (configuration :: * -> *) value.
(HasConfigValue option configuration, Typeable value) =>
option value -> configuration value -> configuration value
$$$
                       (LibName -> IO String) -> ValueTitle LibName
forall value. (value -> IO String) -> ValueTitle value
ValueTitle (String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> IO String)
-> (LibName -> String) -> LibName -> IO String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LibName -> String
forall a. Show a => a -> String
show) ValueTitle LibName
-> DaVinciNodeTypeParms LibName -> DaVinciNodeTypeParms LibName
forall (option :: * -> *) (configuration :: * -> *) value.
(HasConfigValue option configuration, Typeable value) =>
option value -> configuration value -> configuration value
$$$
                       String -> Color LibName
forall value. String -> Color value
Color (HetcatsOpts -> Colors -> Bool -> Bool -> String
getColor HetcatsOpts
opts Colors
Green Bool
True Bool
True) Color LibName
-> DaVinciNodeTypeParms LibName -> DaVinciNodeTypeParms LibName
forall (option :: * -> *) (configuration :: * -> *) value.
(HasConfigValue option configuration, Typeable value) =>
option value -> configuration value -> configuration value
$$$
                       DaVinciNodeTypeParms LibName
forall (nodeTypeParms :: * -> *) value.
(NodeTypeParms nodeTypeParms, Typeable value) =>
nodeTypeParms value
emptyNodeTypeParms
   DaVinciNodeType LibName
subNodeType <- Graph
  DaVinciGraph
  DaVinciGraphParms
  DaVinciNode
  DaVinciNodeType
  DaVinciNodeTypeParms
  DaVinciArc
  DaVinciArcType
  DaVinciArcTypeParms
-> DaVinciNodeTypeParms LibName -> IO (DaVinciNodeType LibName)
forall graph graphParms (node :: * -> *) (nodeType :: * -> *)
       (nodeTypeParms :: * -> *) (arc :: * -> *) (arcType :: * -> *)
       (arcTypeParms :: * -> *) value.
(GraphAll
   graph
   graphParms
   node
   nodeType
   nodeTypeParms
   arc
   arcType
   arcTypeParms,
 Typeable value) =>
Graph
  graph
  graphParms
  node
  nodeType
  nodeTypeParms
  arc
  arcType
  arcTypeParms
-> nodeTypeParms value -> IO (nodeType value)
newNodeType Graph
  DaVinciGraph
  DaVinciGraphParms
  DaVinciNode
  DaVinciNodeType
  DaVinciNodeTypeParms
  DaVinciArc
  DaVinciArcType
  DaVinciArcTypeParms
graph DaVinciNodeTypeParms LibName
subNodeTypeParms
   [DaVinciNode LibName]
subNodeList <- (LibName -> IO (DaVinciNode LibName))
-> [LibName] -> IO [DaVinciNode LibName]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Graph
  DaVinciGraph
  DaVinciGraphParms
  DaVinciNode
  DaVinciNodeType
  DaVinciNodeTypeParms
  DaVinciArc
  DaVinciArcType
  DaVinciArcTypeParms
-> DaVinciNodeType LibName -> LibName -> IO (DaVinciNode LibName)
forall graph graphParms (node :: * -> *) (nodeType :: * -> *)
       (nodeTypeParms :: * -> *) (arc :: * -> *) (arcType :: * -> *)
       (arcTypeParms :: * -> *) value.
(GraphAll
   graph
   graphParms
   node
   nodeType
   nodeTypeParms
   arc
   arcType
   arcTypeParms,
 Typeable value) =>
Graph
  graph
  graphParms
  node
  nodeType
  nodeTypeParms
  arc
  arcType
  arcTypeParms
-> nodeType value -> value -> IO (node value)
newNode Graph
  DaVinciGraph
  DaVinciGraphParms
  DaVinciNode
  DaVinciNodeType
  DaVinciNodeTypeParms
  DaVinciArc
  DaVinciArcType
  DaVinciArcTypeParms
graph DaVinciNodeType LibName
subNodeType) [LibName]
keys
   let
    nodes' :: Map LibName (DaVinciNode LibName)
nodes' = [(LibName, DaVinciNode LibName)]
-> Map LibName (DaVinciNode LibName)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(LibName, DaVinciNode LibName)]
 -> Map LibName (DaVinciNode LibName))
-> [(LibName, DaVinciNode LibName)]
-> Map LibName (DaVinciNode LibName)
forall a b. (a -> b) -> a -> b
$ [LibName]
-> [DaVinciNode LibName] -> [(LibName, DaVinciNode LibName)]
forall a b. [a] -> [b] -> [(a, b)]
zip [LibName]
keys [DaVinciNode LibName]
subNodeList
    subArcMenu :: LocalMenu value
subArcMenu = MenuPrim (Maybe String) (value -> IO ()) -> LocalMenu value
forall value.
MenuPrim (Maybe String) (value -> IO ()) -> LocalMenu value
LocalMenu (Maybe String
-> [MenuPrim (Maybe String) (value -> IO ())]
-> MenuPrim (Maybe String) (value -> IO ())
forall subMenuValue value.
subMenuValue
-> [MenuPrim subMenuValue value] -> MenuPrim subMenuValue value
UDG.Menu Maybe String
forall a. Maybe a
Nothing [])
    subArcTypeParms :: DaVinciArcTypeParms (IO String)
subArcTypeParms = LocalMenu (IO String)
forall value. LocalMenu value
subArcMenu LocalMenu (IO String)
-> DaVinciArcTypeParms (IO String)
-> DaVinciArcTypeParms (IO String)
forall (option :: * -> *) (configuration :: * -> *) value.
(HasConfigValue option configuration, Typeable value) =>
option value -> configuration value -> configuration value
$$$
                      (IO String -> IO String) -> ValueTitle (IO String)
forall value. (value -> IO String) -> ValueTitle value
ValueTitle IO String -> IO String
forall a. a -> a
id ValueTitle (IO String)
-> DaVinciArcTypeParms (IO String)
-> DaVinciArcTypeParms (IO String)
forall (option :: * -> *) (configuration :: * -> *) value.
(HasConfigValue option configuration, Typeable value) =>
option value -> configuration value -> configuration value
$$$
                      String -> Color (IO String)
forall value. String -> Color value
Color (HetcatsOpts -> Colors -> Bool -> Bool -> String
getColor HetcatsOpts
opts Colors
Black Bool
False Bool
False) Color (IO String)
-> DaVinciArcTypeParms (IO String)
-> DaVinciArcTypeParms (IO String)
forall (option :: * -> *) (configuration :: * -> *) value.
(HasConfigValue option configuration, Typeable value) =>
option value -> configuration value -> configuration value
$$$
                      DaVinciArcTypeParms (IO String)
forall (arcTypeParms :: * -> *) value.
(ArcTypeParms arcTypeParms, Typeable value) =>
arcTypeParms value
emptyArcTypeParms
   DaVinciArcType (IO String)
subArcType <- Graph
  DaVinciGraph
  DaVinciGraphParms
  DaVinciNode
  DaVinciNodeType
  DaVinciNodeTypeParms
  DaVinciArc
  DaVinciArcType
  DaVinciArcTypeParms
-> DaVinciArcTypeParms (IO String)
-> IO (DaVinciArcType (IO String))
forall graph graphParms (node :: * -> *) (nodeType :: * -> *)
       (nodeTypeParms :: * -> *) (arc :: * -> *) (arcType :: * -> *)
       (arcTypeParms :: * -> *) value.
(GraphAll
   graph
   graphParms
   node
   nodeType
   nodeTypeParms
   arc
   arcType
   arcTypeParms,
 Typeable value) =>
Graph
  graph
  graphParms
  node
  nodeType
  nodeTypeParms
  arc
  arcType
  arcTypeParms
-> arcTypeParms value -> IO (arcType value)
newArcType Graph
  DaVinciGraph
  DaVinciGraphParms
  DaVinciNode
  DaVinciNodeType
  DaVinciNodeTypeParms
  DaVinciArc
  DaVinciArcType
  DaVinciArcTypeParms
graph DaVinciArcTypeParms (IO String)
subArcTypeParms
   let insertSubArc :: (LibName, LibName) -> IO (DaVinciArc (IO String))
insertSubArc (node1 :: LibName
node1, node2 :: LibName
node2) = Graph
  DaVinciGraph
  DaVinciGraphParms
  DaVinciNode
  DaVinciNodeType
  DaVinciNodeTypeParms
  DaVinciArc
  DaVinciArcType
  DaVinciArcTypeParms
-> DaVinciArcType (IO String)
-> IO String
-> DaVinciNode LibName
-> DaVinciNode LibName
-> IO (DaVinciArc (IO String))
forall graph graphParms (node :: * -> *) (nodeType :: * -> *)
       (nodeTypeParms :: * -> *) (arc :: * -> *) (arcType :: * -> *)
       (arcTypeParms :: * -> *) value nodeFromValue nodeToValue.
(GraphAll
   graph
   graphParms
   node
   nodeType
   nodeTypeParms
   arc
   arcType
   arcTypeParms,
 Typeable value, Typeable nodeFromValue, Typeable nodeToValue) =>
Graph
  graph
  graphParms
  node
  nodeType
  nodeTypeParms
  arc
  arcType
  arcTypeParms
-> arcType value
-> value
-> node nodeFromValue
-> node nodeToValue
-> IO (arc value)
newArc Graph
  DaVinciGraph
  DaVinciGraphParms
  DaVinciNode
  DaVinciNodeType
  DaVinciNodeTypeParms
  DaVinciArc
  DaVinciArcType
  DaVinciArcTypeParms
graph DaVinciArcType (IO String)
subArcType (String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return "")
                                            (Map LibName (DaVinciNode LibName) -> LibName -> DaVinciNode LibName
forall k a. (Ord k, Show k) => Map k a -> k -> a
lookup' Map LibName (DaVinciNode LibName)
nodes' LibName
node1)
                                            (Map LibName (DaVinciNode LibName) -> LibName -> DaVinciNode LibName
forall k a. (Ord k, Show k) => Map k a -> k -> a
lookup' Map LibName (DaVinciNode LibName)
nodes' LibName
node2)
   [DaVinciArc (IO String)]
subArcList <- ((LibName, LibName) -> IO (DaVinciArc (IO String)))
-> [(LibName, LibName)] -> IO [DaVinciArc (IO String)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (LibName, LibName) -> IO (DaVinciArc (IO String))
insertSubArc ([(LibName, LibName)] -> IO [DaVinciArc (IO String)])
-> [(LibName, LibName)] -> IO [DaVinciArc (IO String)]
forall a b. (a -> b) -> a -> b
$ Set LibName -> LibEnv -> [(LibName, LibName)]
getLibDeps Set LibName
keySet LibEnv
le
   IORef NodeEdgeList -> NodeEdgeList -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef NodeEdgeList
nodesEdges ([DaVinciNode LibName]
subNodeList, [DaVinciArc (IO String)]
subArcList)
   IORef
  (Graph
     DaVinciGraph
     DaVinciGraphParms
     DaVinciNode
     DaVinciNodeType
     DaVinciNodeTypeParms
     DaVinciArc
     DaVinciArcType
     DaVinciArcTypeParms)
-> Graph
     DaVinciGraph
     DaVinciGraphParms
     DaVinciNode
     DaVinciNodeType
     DaVinciNodeTypeParms
     DaVinciArc
     DaVinciArcType
     DaVinciArcTypeParms
-> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef
  (Graph
     DaVinciGraph
     DaVinciGraphParms
     DaVinciNode
     DaVinciNodeType
     DaVinciNodeTypeParms
     DaVinciArc
     DaVinciArcType
     DaVinciArcTypeParms)
graphR Graph
  DaVinciGraph
  DaVinciGraphParms
  DaVinciNode
  DaVinciNodeType
  DaVinciNodeTypeParms
  DaVinciArc
  DaVinciArcType
  DaVinciArcTypeParms
graph
   Graph
  DaVinciGraph
  DaVinciGraphParms
  DaVinciNode
  DaVinciNodeType
  DaVinciNodeTypeParms
  DaVinciArc
  DaVinciArcType
  DaVinciArcTypeParms
-> IO ()
forall graph graphParms (node :: * -> *) (nodeType :: * -> *)
       (nodeTypeParms :: * -> *) (arc :: * -> *) (arcType :: * -> *)
       (arcTypeParms :: * -> *).
GraphAll
  graph
  graphParms
  node
  nodeType
  nodeTypeParms
  arc
  arcType
  arcTypeParms =>
Graph
  graph
  graphParms
  node
  nodeType
  nodeTypeParms
  arc
  arcType
  arcTypeParms
-> IO ()
redraw Graph
  DaVinciGraph
  DaVinciGraphParms
  DaVinciNode
  DaVinciNodeType
  DaVinciNodeTypeParms
  DaVinciArc
  DaVinciArcType
  DaVinciArcTypeParms
graph

-- | Creates a list of all LibName pairs, which have a dependency
getLibDeps :: Set.Set LibName -> LibEnv -> [(LibName, LibName)]
getLibDeps :: Set LibName -> LibEnv -> [(LibName, LibName)]
getLibDeps ks :: Set LibName
ks =
  Rel LibName -> [(LibName, LibName)]
forall a. Rel a -> [(a, a)]
Rel.toList (Rel LibName -> [(LibName, LibName)])
-> (LibEnv -> Rel LibName) -> LibEnv -> [(LibName, LibName)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rel LibName -> Rel LibName
forall a. Ord a => Rel a -> Rel a
Rel.intransKernel (Rel LibName -> Rel LibName)
-> (LibEnv -> Rel LibName) -> LibEnv -> Rel LibName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rel LibName -> Set LibName -> Rel LibName
forall a. Ord a => Rel a -> Set a -> Rel a
`Rel.restrict` Set LibName
ks) (Rel LibName -> Rel LibName)
-> (LibEnv -> Rel LibName) -> LibEnv -> Rel LibName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LibEnv -> Rel LibName
getLibDepRel

mShowGraph :: GInfo -> LibName -> IO ()
mShowGraph :: GInfo -> LibName -> IO ()
mShowGraph gi :: GInfo
gi ln :: LibName
ln = GInfo -> LibName -> ConvFunc -> LibFunc -> IO ()
showDGraph GInfo
gi LibName
ln ConvFunc
convertGraph LibFunc
showLibGraph

-- | Displays the Specs of a Library in a Textwindow
showSpec :: LibEnv -> LibName -> IO ()
showSpec :: LibEnv -> LibName -> IO ()
showSpec le :: LibEnv
le ln :: LibName
ln =
  String -> String -> IO ()
createTextDisplay ("Contents of " String -> String -> String
forall a. [a] -> [a] -> [a]
++ LibName -> String
forall a. Show a => a -> String
show LibName
ln)
                    (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines ([String] -> String) -> (DGraph -> [String]) -> DGraph -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IRI -> String) -> [IRI] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map IRI -> String
forall a. Show a => a -> String
show ([IRI] -> [String]) -> (DGraph -> [IRI]) -> DGraph -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map IRI GlobalEntry -> [IRI]
forall k a. Map k a -> [k]
Map.keys (Map IRI GlobalEntry -> [IRI])
-> (DGraph -> Map IRI GlobalEntry) -> DGraph -> [IRI]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DGraph -> Map IRI GlobalEntry
globalEnv
                    (DGraph -> String) -> DGraph -> String
forall a b. (a -> b) -> a -> b
$ LibName -> LibEnv -> DGraph
lookupDGraph LibName
ln LibEnv
le