{-# LANGUAGE CPP #-}
{- |
Module      :  ./GUI/ShowGraph.hs
Copyright   :  (c) Uni Bremen 2002-2005
License     :  GPLv2 or higher, see LICENSE.txt

Maintainer  :  Christian.Maeder@dfki.de
Stability   :  provisional
Portability :  non-portable (Logic)

display the final graph
-}

module GUI.ShowGraph
    (showGraph)
where

import Driver.Options (HetcatsOpts, putIfVerbose)
import Static.DevGraph
import Common.LibName

import GUI.GraphDisplay
import GUI.GraphTypes
import GUI.ShowLibGraph
#ifdef GTKGLADE
import Graphics.UI.Gtk
#endif

import Reactor.InfoBus (shutdown)
import HTk.Toolkit.DialogWin (useHTk)
import Util.WBFiles
-- Uni Utils
import Events.Destructible

import Data.IORef
import Control.Concurrent
import Control.Exception
import Control.Monad
import Common.ProverTools

import Interfaces.DataTypes

import System.Directory
import System.FilePath

-- | show development graph of a given library name in a window
showGraph :: FilePath -> HetcatsOpts -> Maybe (LibName, LibEnv) -> IO ()
showGraph :: FilePath -> HetcatsOpts -> Maybe (LibName, LibEnv) -> IO ()
showGraph file :: FilePath
file opts :: HetcatsOpts
opts env :: Maybe (LibName, LibEnv)
env = case Maybe (LibName, LibEnv)
env of
  Just (ln :: LibName
ln, le :: LibEnv
le) -> do
    FilePath
ws <- IO FilePath
getWishPath
    HetcatsOpts -> Int -> FilePath -> IO ()
putIfVerbose HetcatsOpts
opts 3 (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ "wish is: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
ws
    Bool
noWish <- FilePath -> IO Bool
missingExecutableInPath FilePath
ws
    FilePath
dv <- IO FilePath
getDaVinciPath
    HetcatsOpts -> Int -> FilePath -> IO ()
putIfVerbose HetcatsOpts
opts 3 (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ "uDrawGraph is: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
dv
    Bool
noUDrawGraph <- FilePath -> IO Bool
missingExecutableInPath FilePath
dv
    FilePath
home <- IO FilePath
getHomeDirectory
    let uDrawFile :: FilePath
uDrawFile = FilePath
home FilePath -> FilePath -> FilePath
</> ".uDrawGraph3.1.1"
    Bool
hasUDrawFile <- FilePath -> IO Bool
doesFileExist FilePath
uDrawFile
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
hasUDrawFile (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
       HetcatsOpts -> Int -> FilePath -> IO ()
putIfVerbose HetcatsOpts
opts 2 (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ "creating file " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
uDrawFile
       FilePath -> FilePath -> IO ()
writeFile FilePath
uDrawFile ""
    if Bool
noWish Bool -> Bool -> Bool
|| Bool
noUDrawGraph then
      FilePath -> IO ()
forall a. HasCallStack => FilePath -> a
error (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ (if Bool
noWish then "wish" else "uDrawGraph") FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ " is missing"
      else do
      HetcatsOpts -> Int -> FilePath -> IO ()
putIfVerbose HetcatsOpts
opts 2 (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ "Displaying " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
file FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ " in a graphical window"
      HetcatsOpts -> Int -> FilePath -> IO ()
putIfVerbose HetcatsOpts
opts 3 "Initializing Converter"
      let thr :: IO ()
thr = FilePath -> HetcatsOpts -> LibName -> LibEnv -> IO ()
workThread FilePath
file HetcatsOpts
opts LibName
ln LibEnv
le
#ifdef GTKGLADE
      Either SomeException [FilePath]
eitherGTK <- IO [FilePath] -> IO (Either SomeException [FilePath])
forall e a. Exception e => IO a -> IO (Either e a)
try IO [FilePath]
unsafeInitGUIForThreadedRTS
      ThreadId
_ <- IO () -> IO ThreadId
forkIO IO ()
thr
      case Either SomeException [FilePath]
eitherGTK of
        Right _ -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Left e :: SomeException
e -> do
          HetcatsOpts -> Int -> FilePath -> IO ()
putIfVerbose HetcatsOpts
opts 5 (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ "Error: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ SomeException -> FilePath
forall a. Show a => a -> FilePath
show (SomeException
e :: SomeException)
          FilePath -> IO ()
forall a. HasCallStack => FilePath -> a
error (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ "Can't initialize GTK."
      IO ()
mainGUI
#else
      thr
#endif
      IO ()
shutdown
  Nothing -> HetcatsOpts -> Int -> FilePath -> IO ()
putIfVerbose HetcatsOpts
opts 0
    "missing development graph to display in a window"

workThread :: FilePath -> HetcatsOpts -> LibName -> LibEnv -> IO ()
workThread :: FilePath -> HetcatsOpts -> LibName -> LibEnv -> IO ()
workThread file :: FilePath
file opts :: HetcatsOpts
opts ln :: LibName
ln le :: LibEnv
le = do
        Either SomeException (GInfo, HTk)
eitherHTK <- IO (GInfo, HTk) -> IO (Either SomeException (GInfo, HTk))
forall e a. Exception e => IO a -> IO (Either e a)
try IO (GInfo, HTk)
initializeConverter
        (gInfo :: GInfo
gInfo, wishInst :: HTk
wishInst) <- case Either SomeException (GInfo, HTk)
eitherHTK of
          Right a :: (GInfo, HTk)
a -> (GInfo, HTk) -> IO (GInfo, HTk)
forall (m :: * -> *) a. Monad m => a -> m a
return (GInfo, HTk)
a
          Left e :: SomeException
e -> do
            HetcatsOpts -> Int -> FilePath -> IO ()
putIfVerbose HetcatsOpts
opts 5 (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ "Error: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ SomeException -> FilePath
forall a. Show a => a -> FilePath
show (SomeException
e :: SomeException)
            FilePath -> IO (GInfo, HTk)
forall a. HasCallStack => FilePath -> a
error "Can't initialize GUI (wish)."
        IO ()
useHTk -- use TK from this point on
        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
        let 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
ist
                    { i_libEnv :: LibEnv
i_libEnv = LibEnv
le
                    , i_ln :: LibName
i_ln = LibName
ln }
                , filename :: FilePath
filename = FilePath
file }
        IORef IntState -> IntState -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (GInfo -> IORef IntState
intState GInfo
gInfo) IntState
nwst
        let gInfo' :: GInfo
gInfo' = GInfo
gInfo
              { hetcatsOpts :: HetcatsOpts
hetcatsOpts = HetcatsOpts
opts
              , libName :: LibName
libName = LibName
ln }
        LibFunc
showLibGraph GInfo
gInfo'
        GInfo -> LibName -> IO ()
mShowGraph GInfo
gInfo' LibName
ln
        MVar () -> IO ()
forall a. MVar a -> IO a
takeMVar (MVar () -> IO ()) -> MVar () -> IO ()
forall a b. (a -> b) -> a -> b
$ GInfo -> MVar ()
exitMVar GInfo
gInfo'
        LibFunc
closeOpenWindows GInfo
gInfo'
        HTk -> IO ()
forall o. Destroyable o => o -> IO ()
destroy HTk
wishInst
#ifdef GTKGLADE
        IO () -> IO ()
forall a. IO a -> IO a
postGUISync IO ()
mainQuit
#endif