------------------------------------------------------------------------------
-- GUI for showing the result of observing objects in Curry programs.
------------------------------------------------------------------------------

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."

------------------------------------------------------------------------------