module GUIMonad (module GUIMonad,GUIInfo) where
import TclGUI (GUIInfo)
import IO
import qualified TclGUI as T
import IOExts
import Utils
import TclPrimExports (WPath)

newtype GUI a = GUI (GUIInfo -> IO a)

type Remover = GUI ()

updateGUIInfo :: (GUIInfo -> IO GUIInfo) -> GUI ()
updateGUIInfo f = GUI $ \info -> do info <- f info;return ()

getGUIInfo :: GUI GUIInfo
getGUIInfo = GUI $ \info -> return info

withGUIInfo :: (GUIInfo -> IO a) -> GUI a
withGUIInfo f = GUI $ \info -> f info

runGUI :: GUIInfo -> GUI a -> IO a
runGUI info (GUI a) =  a info

fromGUI :: GUI a -> GUI (IO a)
fromGUI (GUI a) = GUI $ \info -> return ( a info)

liftIO :: IO a -> GUI a
liftIO io = GUI $ \info -> do v <- io;return v

proc :: IO a -> GUI a
proc = liftIO 

instance Monad GUI where
 return a = GUI $ \info -> return a
 (GUI a) >>= f = GUI $ \info ->  do
		  v <- a info
		  case f v of 
                    GUI a -> a info
 fail s = GUI $ const $ fail s

instance Functor GUI where
 fmap f a = do
	v <- a
	return $ f v

failGUI :: IOError -> GUI a
failGUI err = GUI (\_ -> ioError err)

tryGUI :: GUI a -> GUI (Either IOError a)
tryGUI (GUI f) = GUI (\st -> do res <- try (f st)
			        case res of
				   Left err -> return (Left err)
				   Right v -> return (Right v))

catchGUI :: GUI a -> (IOError -> GUI a) -> GUI a
catchGUI (GUI gui) hdl = GUI gui'
      where
	gui' st = catch (gui st) (hdl' st)

	hdl' st err = case hdl err of
		        GUI hdl_gui -> hdl_gui st

type GUIRef a = IORef a

newState :: a -> GUI (GUIRef a)
newState a = liftIO $ newIORef a

readState :: GUIRef a -> GUI a
readState = liftIO . readIORef

writeState :: GUIRef a -> a -> GUI ()
writeState ref f = liftIO $ writeIORef ref f

modState :: GUIRef a -> (a -> a) -> GUI ()
modState ref f = liftIO $ updIORef ref f

type GUIArray a = IOArray Int a

newGUIArray :: Int -> a -> GUI (GUIArray a)
newGUIArray n x = proc (newIOArray (0,n-1) x)

readGUIArray :: GUIArray a -> Int -> GUI a
readGUIArray arr i = proc (readIOArray arr i)

writeGUIArray :: GUIArray a -> Int -> a -> GUI ()
writeGUIArray arr i x = proc (writeIOArray arr i x)

modGUIArray :: GUIArray a -> Int -> (a->a) -> GUI ()
modGUIArray arr i f = do x <- readGUIArray arr i; writeGUIArray arr i (f x)

tcl :: [String] -> GUI String
tcl xs = withGUIInfo $ \g -> T.tcl g xs 

tcl_ :: [String] -> GUI ()
tcl_ xs = withGUIInfo $ \g -> T.tcl_ g xs 

tcl_newWgtName :: GUI WPath
tcl_newWgtName = withGUIInfo T.tcl_newWgtName

tcl_newName :: GUI Int
tcl_newName = withGUIInfo T.tcl_newName