|
sourcecode:
|
module Coosy.GUI (main) where
import Control.Monad ( unless )
import System.FilePath ( (</>) )
import Graphics.UI
import Observe ( clearLogFile, ensureCoosyLogDir )
import Coosy.ShowObserve ( readAndPrintEvents, ViewConf(..) )
import Coosy.Trace ( logDir, logFileClear )
import Coosy.Derive ( deriveFile )
import Coosy.PackageConfig ( packagePath )
------------------------------------------------------------------------------
main :: IO ()
main = do
ensureCoosyLogDir
-- write path info for PAKCS:
writeFile (logDir </> "SRCPATH") (packagePath </> "src\n")
writeFile (logDir </> "READY") "" -- for synchronization with PAKCS
runGUI "COOSy" addlineGUI
-- The COOSy GUI.
addlineGUI :: Widget
addlineGUI =
Col [] [
Label [Text "Curry Object Observation System",
Background "blue", Foreground "white", FillX],
Row [CenterAlign]
[Label [FillX],
Button clearTrace [Text "Clear"],
Button (showBusy showObserve) [Text "Show"],
CheckButton [Text "show bound logical variables",
CheckInit "1",
WRef logVarCheck,
Cmd showObserve],
Label [FillX],
Button (showBusy addObservers) [Text "Add observers"],
Button exitGUI [Text "Exit"],
MenuButton
[Text "Infos...",
Menu [MButton help "How to use COOSy",
MButton about "About COOSy"]]],
TextEditScroll [WRef rtxt, Height 40, Text initMsg, Background "white"],
Label [WRef status, Text "Status: ready", Background "green", FillX]
]
where
rtxt,status,logVarCheck free
clearTrace wp = do
clearLogFile
writeFile logFileClear "1"
setValue rtxt "Logfiles cleared." wp
showObserve wp = do
setValue rtxt "" wp
logVarSel <- getValue logVarCheck wp
catch (readAndPrintEvents (\s -> appendValues rtxt wp s)
(toViewConf logVarSel))
(\e -> putStrLn (show e) >> appendValue rtxt failMsg wp)
addObservers wp = do
filename <- getOpenFileWithTypes curryFileTypes
unless (null filename) $ do
msg <- catch (deriveFile filename)
(\e -> return $ "Error occurred: " ++ show e)
setValue rtxt msg wp
showBusy handler wp = do
setValue status "Status: running" wp
setConfig status (Background "red") wp
handler wp
setValue status "Status: waiting" wp
setConfig status (Background "green") wp
help wp = do
helptext <- readFile (packagePath </> "include" </> "Help.txt")
setValue rtxt helptext wp
return []
about wp = do
helptext <- readFile (packagePath </> "README.md")
setValue rtxt helptext wp
return []
appendValues :: WidgetRef -> GuiPort -> String -> IO ()
appendValues _ _ [] = return ()
appendValues rtxt wp (s:ss) =
if elem (chr 7) (s:ss) then appendGray rtxt wp (s:ss)
else appendStyledValue rtxt (s:ss) [Fg Black] wp
appendGray :: WidgetRef -> GuiPort -> String -> IO ()
appendGray _ _ [] = return ()
appendGray rtxt wp (s:ss) = do
appendStyledValue rtxt gray [Fg Gray] wp
appendBlack rtxt wp rest
where
(gray,rest) = span (/= (chr 7)) (s:ss)
appendBlack :: WidgetRef -> GuiPort -> String -> IO ()
appendBlack _ _ [] = return ()
appendBlack rtxt wp (_:ss) = do
appendValue rtxt black wp
appendGray rtxt wp rest
where
(black,_:rest) = span (/= (chr 7)) ss
toViewConf :: String -> ViewConf
toViewConf "1" = ShowLogVarBinds
toViewConf "0" = HideLogVarBinds
-- Curry file types:
curryFileTypes :: [(String,String)]
curryFileTypes = [("Curry Files",".curry"),
("Literate Curry files",".lcurry")]
initMsg :: String
initMsg =
"IMPORTANT NOTE:\n\n" ++
"Don't forget to press 'clear' before you observe a new program execution!"
failMsg :: String
failMsg =
"Failure occurred during reading of trace file!\n\n"++
"Press 'clear' button and run again your program."
------------------------------------------------------------------------------
|