{- |
Module      :  ./GUI/GraphDisplay.hs
Description :  Central GUI for Hets, with display of development graph
Copyright   :  (c) Jorina Freya Gerken, Till Mossakowski, Uni Bremen 2002-2006
License     :  GPLv2 or higher, see LICENSE.txt

Maintainer  :  till@informatik.uni-bremen.de
Stability   :  provisional
Portability :  non-portable (imports Logic)

Conversion of development graphs from Logic.DevGraph
   to abstract graphs of the graph display interface

A composition table is used when abstracting the graph and composing
multiple edges. It looks like this

@
 [(\"normal\",\"normal\",\"normal\"),
 (\"normal\",\"inclusion\",\"normal\"),
 (\"inclusion\",\"normal\",\"normal\"),
 (\"inclusion\",\"inclusion\",\"inclusion\")]
@

A ginfo can be created with initgraphs. The graph is then created with
addnode and addlink.

-}

module GUI.GraphDisplay
    (convertGraph, initializeConverter)
    where

import Static.DevGraph

import GUI.GraphMenu
import GUI.GraphTypes
import GUI.GraphLogic (updateGraph)
import GUI.GraphAbstraction

import qualified GUI.HTkUtils as HTk

import Data.IORef
import qualified Data.Map as Map (lookup)

import Control.Monad

import Interfaces.DataTypes

initializeConverter :: IO (GInfo, HTk.HTk)
initializeConverter :: IO (GInfo, HTk)
initializeConverter = do
  HTk
wishInst <- [Config HTk] -> IO HTk
HTk.initHTk [Config HTk
HTk.withdrawMainWin]
  GInfo
gInfo <- IO GInfo
emptyGInfo
  (GInfo, HTk) -> IO (GInfo, HTk)
forall (m :: * -> *) a. Monad m => a -> m a
return (GInfo
gInfo, HTk
wishInst)

{- | converts the development graph given by its libname into an
    abstract graph and returns the descriptor of the latter, the
    graphInfo it is contained in and the conversion maps. -}
convertGraph :: ConvFunc
convertGraph :: ConvFunc
convertGraph gInfo :: GInfo
gInfo title :: String
title showLib :: LibFunc
showLib = do
 let ln :: LibName
ln = GInfo -> LibName
libName GInfo
gInfo
 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
gInfo
 case IntState -> Maybe IntIState
i_state IntState
ost of
  Nothing -> String -> IO ()
forall a. HasCallStack => String -> a
error "Something went wrong, no library loaded"
  Just ist :: IntIState
ist -> do
   let libEnv :: LibEnv
libEnv = IntIState -> LibEnv
i_libEnv IntIState
ist
   case LibName -> LibEnv -> Maybe DGraph
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup LibName
ln LibEnv
libEnv of
    Just dgraph :: DGraph
dgraph -> do
            ConvFunc
initializeGraph GInfo
gInfo String
title LibFunc
showLib
            Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (DGraph -> Bool
isEmptyDG DGraph
dgraph) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ GInfo -> [DGChange] -> IO ()
updateGraph GInfo
gInfo (DGraph -> [DGChange]
convert DGraph
dgraph)
    Nothing -> String -> IO ()
forall a. HasCallStack => String -> a
error (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ "development graph with libname " String -> String -> String
forall a. [a] -> [a] -> [a]
++ LibName -> String
forall a. Show a => a -> String
show LibName
ln
                       String -> String -> String
forall a. [a] -> [a] -> [a]
++ " does not exist"

{- | initializes an empty abstract graph with the needed node and edge types,
return type equals the one of convertGraph -}
initializeGraph :: GInfo -> String -> LibFunc -> IO ()
initializeGraph :: ConvFunc
initializeGraph gInfo :: GInfo
gInfo title :: String
title showLib :: LibFunc
showLib = 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
gInfo
 case IntState -> Maybe IntIState
i_state IntState
ost of
  Nothing -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  Just _ -> do
   let title' :: String
title' = String
title String -> String -> String
forall a. [a] -> [a] -> [a]
++ " for " String -> String -> String
forall a. [a] -> [a] -> [a]
++ LibName -> String
forall a. Show a => a -> String
show (GInfo -> LibName
libName GInfo
gInfo)
   GInfo -> String -> ConvFunc -> LibFunc -> IO ()
createGraph GInfo
gInfo String
title' ConvFunc
convertGraph LibFunc
showLib