diff --git a/hpage.cabal b/hpage.cabal --- a/hpage.cabal +++ b/hpage.cabal @@ -1,5 +1,5 @@ name: hpage -version: 0.2.2 +version: 0.3.0 cabal-version: >=1.6 build-type: Custom license: BSD3 @@ -59,7 +59,7 @@ install-includes: hs-source-dirs: src other-modules: Control.Concurrent.Process, - Graphics.UI.WXCore.WxcDefs.ExtraIdentities + HPage.GUI.IDs, HPage.GUI.FreeTextWindow, HPage.GUI.Dialogs, HPage.Control, diff --git a/src/Graphics/UI/WXCore/WxcDefs/ExtraIdentities.hs b/src/Graphics/UI/WXCore/WxcDefs/ExtraIdentities.hs deleted file mode 100644 --- a/src/Graphics/UI/WXCore/WxcDefs/ExtraIdentities.hs +++ /dev/null @@ -1,20 +0,0 @@ - -module Graphics.UI.WXCore.WxcDefs.ExtraIdentities where - -wxID_REPLACE, wxID_REPLACE_ALL, wxID_PREFERENCES, - wxID_CLOSE_ALL :: Int -wxID_REPLACE = 5038 -wxID_REPLACE_ALL = 5039 -wxID_PREFERENCES = 5022 -wxID_CLOSE_ALL = 5018 - -wxID_HASK_LOAD, wxID_HASK_LOADNAME, wxID_HASK_RELOAD, - wxID_HASK_VALUE, wxID_HASK_TYPE, wxID_HASK_KIND, - wxID_HASK_ADD :: Int -wxID_HASK_LOAD = 5300 -wxID_HASK_LOADNAME = 5301 -wxID_HASK_RELOAD = 5302 -wxID_HASK_VALUE = 5304 -wxID_HASK_TYPE = 5305 -wxID_HASK_KIND = 5306 -wxID_HASK_ADD = 5307 diff --git a/src/HPage/Control.hs b/src/HPage/Control.hs --- a/src/HPage/Control.hs +++ b/src/HPage/Control.hs @@ -31,12 +31,14 @@ -- HINT CONTROLS -- valueOf, valueOfNth, kindOf, kindOfNth, typeOf, typeOfNth, loadModules, reloadModules, getLoadedModules, importModules, getImportedModules, + getModuleExports, getLanguageExtensions, setLanguageExtensions, getSourceDirs, setSourceDirs, getGhcOpts, setGhcOpts, loadPrefsFromCabal, valueOf', valueOfNth', kindOf', kindOfNth', typeOf', typeOfNth', loadModules', reloadModules', getLoadedModules', importModules', getImportedModules', + getModuleExports', getLanguageExtensions', setLanguageExtensions', getSourceDirs', setSourceDirs', getGhcOpts', setGhcOpts', @@ -45,6 +47,7 @@ cancel, Hint.InterpreterError, Hint.prettyPrintError, Hint.availableExtensions, Hint.Extension(..), + ModuleElemDesc(..), -- DEBUG -- ctxString ) where @@ -76,6 +79,22 @@ import Distribution.PackageDescription import Distribution.Compiler +data ModuleElemDesc = MEFun {funName :: String, + funType :: String} | + MEClass {clsName :: String, + clsFuns :: [ModuleElemDesc]} | + MEData {datName :: String, + datCtors :: [ModuleElemDesc]} + deriving (Eq) + +instance Show ModuleElemDesc where + show MEFun{funName = fn, funType = []} = fn + show MEFun{funName = fn, funType = ft} = fn ++ " :: " ++ ft + show MEClass{clsName = cn, clsFuns = []} = "class " ++ cn + show MEClass{clsName = cn, clsFuns = cfs} = "class " ++ cn ++ " where " ++ joinWith "\n" (map show cfs) + show MEData{datName = dn, datCtors = []} = "data " ++ dn + show MEData{datName = dn, datCtors = dcs} = "data " ++ dn ++ " = " ++ joinWith " | " (map show dcs) + data PageDescription = PageDesc {pIndex :: Int, pPath :: Maybe FilePath, pIsModified :: Bool} @@ -439,6 +458,14 @@ getImportedModules :: HPage [Hint.ModuleName] getImportedModules = confirmRunning >>= return . toList . importedModules +getModuleExports :: Hint.ModuleName -> HPage (Either Hint.InterpreterError [ModuleElemDesc]) +getModuleExports mn = do + confirmRunning + let action = do + exs <- Hint.getModuleExports mn + mapM moduleElemDesc exs + syncRun action + getLanguageExtensions :: HPage (Either Hint.InterpreterError [Hint.Extension]) getLanguageExtensions = confirmRunning >> syncRun (Hint.get Hint.languageExtensions) @@ -575,6 +602,9 @@ getImportedModules' :: HPage (MVar [Hint.ModuleName]) getImportedModules' = confirmRunning >>= liftIO . newMVar . toList . importedModules +getModuleExports' :: Hint.ModuleName -> HPage (MVar (Either Hint.InterpreterError [Hint.ModuleElem])) +getModuleExports' mn = confirmRunning >> asyncRun (Hint.getModuleExports mn) + getLanguageExtensions' :: HPage (MVar (Either Hint.InterpreterError [Hint.Extension])) getLanguageExtensions' = confirmRunning >> asyncRun (Hint.get Hint.languageExtensions) @@ -817,3 +847,15 @@ letsToString :: [Expression] -> String letsToString [] = "" letsToString exs = "let " ++ joinWith "; " (map exprText exs) ++ " in " + +moduleElemDesc :: Hint.ModuleElem -> Hint.InterpreterT IO ModuleElemDesc +moduleElemDesc (Hint.Fun fn) = do + t <- (Hint.typeOf fn) `catchError` (\e -> return []) + return MEFun{funName = fn, funType = t} +moduleElemDesc (Hint.Class cn cfs) = do + mcfs <- flip mapM cfs $ moduleElemDesc . Hint.Fun + return MEClass{clsName = cn, clsFuns = mcfs} +moduleElemDesc (Hint.Data dn dcs) = do + mdcs <- flip mapM dcs $ moduleElemDesc . Hint.Fun + return MEData{datName = dn, datCtors = mdcs} + diff --git a/src/HPage/GUI/Dialogs.hs b/src/HPage/GUI/Dialogs.hs --- a/src/HPage/GUI/Dialogs.hs +++ b/src/HPage/GUI/Dialogs.hs @@ -7,6 +7,7 @@ import Graphics.UI.WX import Graphics.UI.WXCore import Graphics.UI.WXCore.WxcClasses +import HPage.GUI.IDs import qualified HPage.Control as HP data Preferences = Prefs {languageExtensions :: [HP.Extension], @@ -21,10 +22,10 @@ do let availExts = sort HP.availableExtensions dlg <- dialog win [text := caption] - btnok <- button dlg [text := "Ok", identity := wxID_OK] + btnok <- button dlg [text := "Ok", identity := wxId_OK] buttonSetDefault btnok - btnimport <- button dlg [text := "Import", identity := wxID_OPEN, tooltip := "Import settings from a setup-config file"] - btnnok <- button dlg [text := "Cancel", identity := wxID_CANCEL] + btnimport <- button dlg [text := "Import", identity := wxId_OPEN, tooltip := "Import settings from a setup-config file"] + btnnok <- button dlg [text := "Cancel", identity := wxId_CANCEL] lstExts <- multiListBox dlg [items := map show availExts] let selIndexes = foldr (\option acc -> diff --git a/src/HPage/GUI/FreeTextWindow.hs b/src/HPage/GUI/FreeTextWindow.hs --- a/src/HPage/GUI/FreeTextWindow.hs +++ b/src/HPage/GUI/FreeTextWindow.hs @@ -20,7 +20,6 @@ import Control.Monad.Loops import Graphics.UI.WX import Graphics.UI.WXCore -import Graphics.UI.WXCore.WxcDefs.ExtraIdentities import Graphics.UI.WXCore.Types import Graphics.UI.WXCore.Dialogs import Graphics.UI.WXCore.Events @@ -28,6 +27,7 @@ import qualified HPage.Control as HP import qualified HPage.Server as HPS import HPage.GUI.Dialogs +import HPage.GUI.IDs import Utils.Log import Paths_hpage -- cabal locations of data files @@ -113,85 +113,87 @@ on mouse := \e -> case e of MouseLeftUp _ _ -> onCmd "mouseEvent" restartTimer >> propagateEvent MouseLeftDClick _ _ -> onCmd "mouseEvent" restartTimer >> propagateEvent + MouseRightDown _ _ -> onCmd "textContextMenu" textContextMenu _ -> propagateEvent] + set lstModules [on select := onCmd "browseModule" browseModule >> propagateEvent] -- Menu bar... -- menuBar win [] mnuPage <- menuPane [text := "Page"] - menuAppend mnuPage wxID_NEW "&New\tCtrl-n" "New Page" False - menuAppend mnuPage wxID_CLOSE "&Close\tCtrl-w" "Close Page" False - menuAppend mnuPage wxID_CLOSE_ALL "&Close All\tCtrl-Shift-w" "Close All Pages" False + menuAppend mnuPage wxId_NEW "&New\tCtrl-n" "New Page" False + menuAppend mnuPage wxId_CLOSE "&Close\tCtrl-w" "Close Page" False + menuAppend mnuPage wxId_CLOSE_ALL "&Close All\tCtrl-Shift-w" "Close All Pages" False menuAppendSeparator mnuPage - menuAppend mnuPage wxID_OPEN "&Open...\tCtrl-o" "Open Page" False - menuAppend mnuPage wxID_SAVE "&Save\tCtrl-s" "Save Page" False - menuAppend mnuPage wxID_SAVEAS "&Save as...\tCtrl-Shift-s" "Save Page as" False + menuAppend mnuPage wxId_OPEN "&Open...\tCtrl-o" "Open Page" False + menuAppend mnuPage wxId_SAVE "&Save\tCtrl-s" "Save Page" False + menuAppend mnuPage wxId_SAVEAS "&Save as...\tCtrl-Shift-s" "Save Page as" False menuAppendSeparator mnuPage menuQuit mnuPage [] mnuEdit <- menuPane [text := "Edit"] - menuAppend mnuEdit wxID_UNDO "&Undo\tCtrl-z" "Undo" False - menuAppend mnuEdit wxID_REDO "&Redo\tCtrl-Shift-z" "Redo" False + menuAppend mnuEdit wxId_UNDO "&Undo\tCtrl-z" "Undo" False + menuAppend mnuEdit wxId_REDO "&Redo\tCtrl-Shift-z" "Redo" False menuAppendSeparator mnuEdit - menuAppend mnuEdit wxID_CUT "C&ut\tCtrl-x" "Cut" False - menuAppend mnuEdit wxID_COPY "&Copy\tCtrl-c" "Copy" False - menuAppend mnuEdit wxID_PASTE "&Paste\tCtrl-v" "Paste" False + menuAppend mnuEdit wxId_CUT "C&ut\tCtrl-x" "Cut" False + menuAppend mnuEdit wxId_COPY "&Copy\tCtrl-c" "Copy" False + menuAppend mnuEdit wxId_PASTE "&Paste\tCtrl-v" "Paste" False menuAppendSeparator mnuEdit - menuAppend mnuEdit wxID_FIND "&Find...\tCtrl-f" "Find" False - menuAppend mnuEdit wxID_FORWARD "Find &Next\tCtrl-g" "Find Next" False - menuAppend mnuEdit wxID_BACKWARD "Find &Previous\tCtrl-Shift-g" "Find Previous" False - menuAppend mnuEdit wxID_REPLACE "&Replace...\tCtrl-Shift-r" "Replace" False + menuAppend mnuEdit wxId_FIND "&Find...\tCtrl-f" "Find" False + menuAppend mnuEdit wxId_FORWARD "Find &Next\tCtrl-g" "Find Next" False + menuAppend mnuEdit wxId_BACKWARD "Find &Previous\tCtrl-Shift-g" "Find Previous" False + menuAppend mnuEdit wxId_REPLACE "&Replace...\tCtrl-Shift-r" "Replace" False menuAppendSeparator mnuEdit - menuAppend mnuEdit wxID_PREFERENCES "&Preferences...\tCtrl-," "Preferences" False + menuAppend mnuEdit wxId_PREFERENCES "&Preferences...\tCtrl-," "Preferences" False mnuHask <- menuPane [text := "Haskell"] - menuAppend mnuHask wxID_HASK_LOAD "&Load modules...\tCtrl-l" "Load Modules" False - menuAppend mnuHask wxID_HASK_LOADNAME "Load modules by &name...\tCtrl-Shift-l" "Load Modules by Name" False - menuAppend mnuHask wxID_HASK_ADD "Import modules...\tCtrl-Shift-l" "Import Packaged Modules by Name" False - menuAppend mnuHask wxID_HASK_RELOAD "&Reload\tCtrl-r" "Reload Modules" False + menuAppend mnuHask wxId_HASK_LOAD "&Load modules...\tCtrl-l" "Load Modules" False + menuAppend mnuHask wxId_HASK_LOADNAME "Load modules by &name...\tCtrl-Shift-l" "Load Modules by Name" False + menuAppend mnuHask wxId_HASK_ADD "Import modules...\tCtrl-Shift-l" "Import Packaged Modules by Name" False + menuAppend mnuHask wxId_HASK_RELOAD "&Reload\tCtrl-r" "Reload Modules" False menuAppendSeparator mnuHask - menuAppend mnuHask wxID_HASK_VALUE "&Value\tCtrl-e" "Get the Value of the Current Expression" False - menuAppend mnuHask wxID_HASK_TYPE "&Type\tCtrl-t" "Get the Type of the Current Expression" False - menuAppend mnuHask wxID_HASK_KIND "&Kind\tCtrl-k" "Get the Kind of the Current Expression" False + menuAppend mnuHask wxId_HASK_VALUE "&Value\tCtrl-e" "Get the Value of the Current Expression" False + menuAppend mnuHask wxId_HASK_TYPE "&Type\tCtrl-t" "Get the Type of the Current Expression" False + menuAppend mnuHask wxId_HASK_KIND "&Kind\tCtrl-k" "Get the Kind of the Current Expression" False mnuHelp <- menuHelp [] - menuAppend mnuHelp wxID_HELP "&Help page\tCtrl-h" "Open the Help Page" False + menuAppend mnuHelp wxId_HELP "&Help page\tCtrl-h" "Open the Help Page" False menuAbout mnuHelp [on command := infoDialog win "About hPage" "Author: Fernando Brujo Benavides"] set win [menuBar := [mnuPage, mnuEdit, mnuHask, mnuHelp]] - evtHandlerOnMenuCommand win wxID_NEW $ onCmd "runHP' addPage" $ runHP' HP.addPage - evtHandlerOnMenuCommand win wxID_CLOSE $ onCmd "runHP' closePage" $ runHP' HP.closePage - evtHandlerOnMenuCommand win wxID_CLOSE_ALL $ onCmd "runHP' closeAllPages" $ runHP' HP.closeAllPages - evtHandlerOnMenuCommand win wxID_OPEN $ onCmd "openPage" openPage - evtHandlerOnMenuCommand win wxID_SAVE $ onCmd "savePage" savePage - evtHandlerOnMenuCommand win wxID_SAVEAS $ onCmd "savePageAs" savePageAs - evtHandlerOnMenuCommand win wxID_UNDO $ onCmd "runHP' undo" $ runHP' HP.undo - evtHandlerOnMenuCommand win wxID_REDO $ onCmd "runHP' redo" $ runHP' HP.redo - evtHandlerOnMenuCommand win wxID_CUT $ onCmd "cut" cut - evtHandlerOnMenuCommand win wxID_COPY $ onCmd "copy" copy - evtHandlerOnMenuCommand win wxID_PASTE $ onCmd "paste" paste - evtHandlerOnMenuCommand win wxID_FIND $ onCmd "justFind" justFind - evtHandlerOnMenuCommand win wxID_FORWARD $ onCmd "findNext" justFindNext - evtHandlerOnMenuCommand win wxID_BACKWARD $ onCmd "findPrev" justFindPrev - evtHandlerOnMenuCommand win wxID_REPLACE $ onCmd "findReplace" findReplace - evtHandlerOnMenuCommand win wxID_HASK_LOAD $ onCmd "loadModules" loadModules - evtHandlerOnMenuCommand win wxID_HASK_ADD $ onCmd "importModules" importModules - evtHandlerOnMenuCommand win wxID_HASK_LOADNAME $ onCmd "loadModulesByName" loadModulesByName - evtHandlerOnMenuCommand win wxID_HASK_RELOAD $ onCmd "reloadModules" reloadModules - evtHandlerOnMenuCommand win wxID_PREFERENCES $ onCmd "preferences" configure - evtHandlerOnMenuCommand win wxID_HASK_VALUE $ onCmd "getValue" getValue - evtHandlerOnMenuCommand win wxID_HASK_TYPE $ onCmd "getType" getType - evtHandlerOnMenuCommand win wxID_HASK_KIND $ onCmd "getKind" getKind - evtHandlerOnMenuCommand win wxID_HELP $ onCmd "help" openHelpPage + evtHandlerOnMenuCommand win wxId_NEW $ onCmd "runHP' addPage" $ runHP' HP.addPage + evtHandlerOnMenuCommand win wxId_CLOSE $ onCmd "runHP' closePage" $ runHP' HP.closePage + evtHandlerOnMenuCommand win wxId_CLOSE_ALL $ onCmd "runHP' closeAllPages" $ runHP' HP.closeAllPages + evtHandlerOnMenuCommand win wxId_OPEN $ onCmd "openPage" openPage + evtHandlerOnMenuCommand win wxId_SAVE $ onCmd "savePage" savePage + evtHandlerOnMenuCommand win wxId_SAVEAS $ onCmd "savePageAs" savePageAs + evtHandlerOnMenuCommand win wxId_UNDO $ onCmd "runHP' undo" $ runHP' HP.undo + evtHandlerOnMenuCommand win wxId_REDO $ onCmd "runHP' redo" $ runHP' HP.redo + evtHandlerOnMenuCommand win wxId_CUT $ onCmd "cut" cut + evtHandlerOnMenuCommand win wxId_COPY $ onCmd "copy" copy + evtHandlerOnMenuCommand win wxId_PASTE $ onCmd "paste" paste + evtHandlerOnMenuCommand win wxId_FIND $ onCmd "justFind" justFind + evtHandlerOnMenuCommand win wxId_FORWARD $ onCmd "findNext" justFindNext + evtHandlerOnMenuCommand win wxId_BACKWARD $ onCmd "findPrev" justFindPrev + evtHandlerOnMenuCommand win wxId_REPLACE $ onCmd "findReplace" findReplace + evtHandlerOnMenuCommand win wxId_HASK_LOAD $ onCmd "loadModules" loadModules + evtHandlerOnMenuCommand win wxId_HASK_ADD $ onCmd "importModules" importModules + evtHandlerOnMenuCommand win wxId_HASK_LOADNAME $ onCmd "loadModulesByName" loadModulesByName + evtHandlerOnMenuCommand win wxId_HASK_RELOAD $ onCmd "reloadModules" reloadModules + evtHandlerOnMenuCommand win wxId_PREFERENCES $ onCmd "preferences" configure + evtHandlerOnMenuCommand win wxId_HASK_VALUE $ onCmd "getValue" getValue + evtHandlerOnMenuCommand win wxId_HASK_TYPE $ onCmd "getType" getType + evtHandlerOnMenuCommand win wxId_HASK_KIND $ onCmd "getKind" getKind + evtHandlerOnMenuCommand win wxId_HELP $ onCmd "help" openHelpPage -- Tool bar... tbMain <- toolBarEx win True True [] - mitNew <- menuFindItem mnuPage wxID_NEW - mitOpen <- menuFindItem mnuPage wxID_OPEN - mitSave <- menuFindItem mnuPage wxID_SAVE - mitCut <- menuFindItem mnuEdit wxID_CUT - mitCopy <- menuFindItem mnuEdit wxID_COPY - mitPaste <- menuFindItem mnuEdit wxID_PASTE - mitReload <- menuFindItem mnuHask wxID_HASK_RELOAD + mitNew <- menuFindItem mnuPage wxId_NEW + mitOpen <- menuFindItem mnuPage wxId_OPEN + mitSave <- menuFindItem mnuPage wxId_SAVE + mitCut <- menuFindItem mnuEdit wxId_CUT + mitCopy <- menuFindItem mnuEdit wxId_COPY + mitPaste <- menuFindItem mnuEdit wxId_PASTE + mitReload <- menuFindItem mnuHask wxId_HASK_RELOAD newPath <- imageFile "new.png" openPath <- imageFile "open.png" savePath <- imageFile "save.png" @@ -232,11 +234,74 @@ refreshPage, savePageAs, savePage, openPage, pageChange, copy, cut, paste, justFind, justFindNext, justFindPrev, findReplace, + textContextMenu, browseModule, restartTimer, killTimer, getValue, getType, getKind, loadModules, importModules, loadModulesByName, reloadModules, configure, openHelpPage :: HPS.ServerHandle -> GUIContext -> IO () +browseModule model guiCtx@GUICtx{guiWin = win, guiModules = lstModules, guiCode = txtCode} = + do + contextMenu <- menuPane [] + i <- get lstModules selection + case i of + (-1) -> propagateEvent + _ -> do + mnText <- listBoxGetString lstModules i + let mn = case mnText of + '*':rest -> rest + fullname -> fullname + hpsRes <- tryIn model $ HP.getModuleExports mn + case hpsRes of + Left err -> + propagateEvent >> warningDialog win "Error" err + Right mes -> + do + flip mapM_ mes $ createMenuItem contextMenu + propagateEvent + pointWithinWindow <- windowGetMousePosition win + menuPopup contextMenu pointWithinWindow win + objectDelete contextMenu + where createMenuItem m fn@(HP.MEFun _ _) = + do + item <- menuItemCreate + menuItemSetCheckable item False + menuItemSetText item $ show fn + menuItemSetId item wxId_HASK_MENUELEM + menuAppendItem m item + createMenuItem m HP.MEClass{HP.clsName = cn, HP.clsFuns = cfs} = + do + subMenu <- menuPane [] + flip mapM_ cfs $ createMenuItem subMenu + menuAppendSub m wxId_HASK_MENUELEM ("class " ++ cn) subMenu "" + createMenuItem m HP.MEData{HP.datName = dn, HP.datCtors = dcs} = + do + subMenu <- menuPane [] + flip mapM_ dcs $ createMenuItem subMenu + menuAppendSub m wxId_HASK_MENUELEM ("data " ++ dn) subMenu "" + +textContextMenu model guiCtx@GUICtx{guiWin = win, guiCode = txtCode} = + do + contextMenu <- menuPane [] + sel <- textCtrlGetStringSelection txtCode + case sel of + "" -> + return () + _ -> + do + menuAppend contextMenu wxId_CUT "C&ut\tCtrl-x" "Cut" False + menuAppend contextMenu wxId_COPY "&Copy\tCtrl-c" "Copy" False + menuAppend contextMenu wxId_PASTE "&Paste\tCtrl-v" "Paste" False + menuAppendSeparator contextMenu + menuAppend contextMenu wxId_HASK_VALUE "&Value\tCtrl-e" "Get the Value of the Current Expression" False + menuAppend contextMenu wxId_HASK_TYPE "&Type\tCtrl-t" "Get the Type of the Current Expression" False + menuAppend contextMenu wxId_HASK_KIND "&Kind\tCtrl-k" "Get the Kind of the Current Expression" False + + propagateEvent + pointWithinWindow <- windowGetMousePosition win + menuPopup contextMenu pointWithinWindow win + objectDelete contextMenu + getValue model guiCtx@GUICtx{guiResults = GUIRes{resValue = grrValue}} = runTxtHP HP.valueOf' model guiCtx grrValue @@ -472,12 +537,16 @@ do refreshExpr model guiCtx False debugIO ("evaluating selection", s) - let newacc = do + piRes <- tryIn' model HP.getPageIndex + let cpi = case piRes of + Left err -> 0 + Right cp -> cp + newacc = do HP.addPage HP.setPageText s $ length s hpacc res <- tryIn' model newacc - tryIn' model HP.closePage + tryIn' model $ HP.closePage >> HP.setPageIndex cpi case res of Left err -> warningDialog win "Error" err Right var -> do diff --git a/src/HPage/GUI/IDs.hs b/src/HPage/GUI/IDs.hs new file mode 100644 --- /dev/null +++ b/src/HPage/GUI/IDs.hs @@ -0,0 +1,44 @@ +-- | This module is needed because the ids in WXCore.WxcDefs weren,t matching +-- | those on wxMac-2.8.10 +module HPage.GUI.IDs where + +wxId_OK, wxId_CANCEL :: Int +wxId_OK = 5100 +wxId_CANCEL = 5101 + +wxId_BACKWARD, wxId_CLOSE, wxId_COPY, wxId_CUT, wxId_FIND, wxId_FORWARD, + wxId_HELP, wxId_NEW, wxId_OPEN, wxId_PASTE, wxId_REDO, wxId_SAVE, + wxId_SAVEAS, wxId_UNDO :: Int +wxId_OPEN = 5000 +wxId_CLOSE = 5001 +wxId_NEW = 5002 +wxId_SAVE = 5003 +wxId_SAVEAS = 5004 +wxId_UNDO = 5007 +wxId_REDO = 5008 +wxId_HELP = 5009 +wxId_CUT = 5031 +wxId_COPY = 5032 +wxId_PASTE = 5033 +wxId_FIND = 5035 +wxId_FORWARD = 5106 +wxId_BACKWARD = 5107 + +wxId_REPLACE, wxId_REPLACE_ALL, wxId_PREFERENCES, + wxId_CLOSE_ALL :: Int +wxId_REPLACE = 5038 +wxId_REPLACE_ALL = 5039 +wxId_PREFERENCES = 5022 +wxId_CLOSE_ALL = 5018 + +wxId_HASK_LOAD, wxId_HASK_LOADNAME, wxId_HASK_RELOAD, + wxId_HASK_VALUE, wxId_HASK_TYPE, wxId_HASK_KIND, + wxId_HASK_ADD, wxId_HASK_MENUELEM :: Int +wxId_HASK_LOAD = 5300 +wxId_HASK_LOADNAME = 5301 +wxId_HASK_RELOAD = 5302 +wxId_HASK_VALUE = 5304 +wxId_HASK_TYPE = 5305 +wxId_HASK_KIND = 5306 +wxId_HASK_ADD = 5307 +wxId_HASK_MENUELEM = 5310 diff --git a/src/HPage/Test/Server.hs b/src/HPage/Test/Server.hs --- a/src/HPage/Test/Server.hs +++ b/src/HPage/Test/Server.hs @@ -142,6 +142,7 @@ , run $ prop_import_module hps , run $ prop_reload_modules hps hs , run $ prop_get_loaded_modules hps hs + , run $ prop_get_module_exports hps hs ] runTests "Cancelation" options [ run $ prop_sequential hps @@ -213,6 +214,17 @@ mn `elem` r2 && mn `elem` r4 +prop_get_module_exports :: HPS.ServerHandle -> HS.ServerHandle -> KnownModuleName -> Bool +prop_get_module_exports hps hs kmn = + unsafePerformIO $ do + let mn = kmnString kmn + Right hpsr <- HPS.runIn hps $ HP.importModules [mn] >> HP.getModuleExports mn + Right hsr <- HS.runIn hs $ Hint.setImports ["Prelude", mn] >> Hint.getModuleExports mn + liftDebugIO (hpsr, hsr) + return $ all match $ zip hpsr hsr + where match ((HP.MEFun fn _), (Hint.Fun fn2)) = fn == fn2 + match ((HP.MEClass cn cfs), (Hint.Class cn2 cfs2)) = cn == cn2 && all match (zip cfs (map Hint.Fun cfs2)) + match ((HP.MEData dn dcs), (Hint.Data dn2 dcs2)) = dn == dn2 && all match (zip dcs (map Hint.Fun dcs2)) prop_load_module :: HPS.ServerHandle -> HS.ServerHandle -> ModuleName -> Property prop_load_module hps hs mn =