hpage 0.3.3 → 0.3.4
raw patch · 7 files changed
+74/−47 lines, 7 filesbinary-added
Files
- hpage.cabal +3/−12
- res/images/compiled.png binary
- res/images/imported.png binary
- res/images/interpreted.png binary
- src/HPage/Control.hs +1/−1
- src/HPage/GUI/FreeTextWindow.hs +69/−33
- src/HPage/Test/Server.hs +1/−1
hpage.cabal view
@@ -1,5 +1,5 @@ name: hpage-version: 0.3.3+version: 0.3.4 cabal-version: >=1.6 build-type: Custom license: BSD3@@ -47,15 +47,9 @@ hint-server >= 1.0.0, hint-server < 2 main-is: Main.hs buildable: True- build-tools:- cpp-options:- cc-options:- ld-options:- pkgconfig-depends:- frameworks:- c-sources:+ if os(windows)+ cpp-options: -DWIN32 extensions: CPP- install-includes: hs-source-dirs: src other-modules: HPage.GUI.IDs,@@ -71,6 +65,3 @@ ghc-prof-options: -auto-all -prof ghc-shared-options: -auto-all -prof ghc-options: -fwarn-unused-imports -fwarn-missing-fields -fwarn-incomplete-patterns- hugs-options:- nhc98-options:- jhc-options:
+ res/images/compiled.png view
binary file changed (absent → 1138 bytes)
+ res/images/imported.png view
binary file changed (absent → 1687 bytes)
+ res/images/interpreted.png view
binary file changed (absent → 2156 bytes)
src/HPage/Control.hs view
@@ -520,7 +520,7 @@ let pkgdesc = localPkgDescr lbinfo pkgname = package pkgdesc bldinfos= allBuildInfo pkgdesc- dirs = uniq $ concatMap hsSourceDirs bldinfos+ dirs = ("dist" </> "build" </> "autogen") : (uniq $ concatMap hsSourceDirs bldinfos) exts = uniq . map (read . show) $ concatMap extensions bldinfos opts = uniq $ concatMap (hcOptions GHC) bldinfos mods = uniq . map (joinWith "." . components) $ exeModules pkgdesc ++ (libModules pkgdesc)
src/HPage/GUI/FreeTextWindow.hs view
@@ -34,7 +34,13 @@ import Paths_hpage -- cabal locations of data files imageFile :: FilePath -> IO FilePath-imageFile = getDataFileName . ("res/images/"++)+imageFile fp = do+ path <- getDataFileName $ "res/images/" ++ fp+ real <- doesFileExist path+ if real then return path+ else do+ errorIO ("file not found", path)+ fail (path ++ " does not exist") helpFile :: IO FilePath helpFile = getDataFileName "res/help/helpPage.hs"@@ -49,7 +55,7 @@ data GUIContext = GUICtx { guiWin :: Frame (), guiPages :: SingleListBox (), guiPkgModules :: SingleListBox (),- guiLoadedModules :: SingleListBox (),+ guiLoadedModules :: ListCtrl (), guiCode :: TextCtrl (), guiResults :: GUIResults, guiStatus :: StatusField,@@ -78,10 +84,18 @@ txtCode <- textCtrl win [font := fontFixed, text := ""] -- Document Selector- lstPkgModules <- singleListBox pnlPMs [style := wxLB_NEEDED_SB]- lstLoadedModules <- singleListBox pnlLMs [style := wxLB_NEEDED_SB] lstPages <- singleListBox pnlPs [style := wxLB_NEEDED_SB, outerSize := sz 400 600]+ + -- Modules Lists+ imageFiles <- mapM imageFile ["imported.png", "interpreted.png", "compiled.png"]+ imagePaths <- mapM getAbsoluteFilePath imageFiles+ images <- imageListFromFiles (sz 16 16) imagePaths+ lstLoadedModules <- listCtrlEx pnlLMs (wxLC_NO_HEADER + wxLC_SINGLE_SEL)+ [columns := [("Module", AlignLeft, 200)]]+ listCtrlSetImageList lstLoadedModules images wxIMAGE_LIST_SMALL + lstPkgModules <- singleListBox pnlPMs [style := wxLB_NEEDED_SB]+ -- Results list txtValue <- textEntry win [style := wxTE_READONLY] txtType <- textEntry win [style := wxTE_READONLY]@@ -118,11 +132,12 @@ MouseLeftDClick _ _ -> onCmd "mouseEvent" restartTimer >> propagateEvent MouseRightDown _ _ -> onCmd "textContextMenu" textContextMenu _ -> propagateEvent]- set lstLoadedModules [on mouse := \e -> case e of- MouseLeftUp _ _ -> onCmd "browseModule" browseModule >> propagateEvent- _ -> propagateEvent]+ set lstLoadedModules [on listEvent := \e -> case e of+ ListItemSelected idx -> onCmd "browseModule" (browseModule idx)+ _ -> propagateEvent] set lstPkgModules [on mouse := \e -> case e of MouseRightUp _ _ -> onCmd "pkgModuleContextMenu" pkgModuleContextMenu >> propagateEvent+ MouseLeftDClick _ _ -> onCmd "loadModulesByNameFast" loadModulesByNameFast _ -> propagateEvent] -- Menu bar...@@ -230,9 +245,9 @@ -- Layout settings let txtCodeL = fill $ widget txtCode- pagesTabL = tab "Pages" $ container pnlPs $ fill $ widget lstPages- pkgModsTabL = tab "Package" $ container pnlPMs $ fill $ widget lstPkgModules- lddModsTabL = tab "Modules" $ container pnlLMs $ fill $ widget lstLoadedModules+ pagesTabL = tab "Pages" $ container pnlPs $ fill $ margin 5 $ widget lstPages+ pkgModsTabL = tab "Package" $ container pnlPMs $ fill $ margin 5 $ widget lstPkgModules+ lddModsTabL = tab "Modules" $ container pnlLMs $ fill $ margin 5 $ widget lstLoadedModules valueRowL = [widget btnGetValue, hfill $ widget txtValue] typeRowL = [widget btnGetType, hfill $ widget txtType] kindRowL = [widget btnGetKind, hfill $ widget txtKind]@@ -251,34 +266,29 @@ refreshPage, savePageAs, savePage, openPage, pageChange, copy, cut, paste, justFind, justFindNext, justFindPrev, findReplace,- textContextMenu, pkgModuleContextMenu, browseModule,+ textContextMenu, pkgModuleContextMenu, restartTimer, killTimer, getValue, getType, getKind, loadPackage, loadModules, importModules, loadModulesByName, loadModulesByNameFast, reloadModules, configure, openHelpPage :: HPS.ServerHandle -> GUIContext -> IO () -browseModule model guiCtx@GUICtx{guiWin = win, guiLoadedModules = lstLoadedModules, guiCode = txtCode} =+browseModule :: Int -> HPS.ServerHandle -> GUIContext -> IO ()++browseModule i model guiCtx@GUICtx{guiWin = win, guiLoadedModules = lstLoadedModules, guiCode = txtCode} = do contextMenu <- menuPane []- i <- get lstLoadedModules selection- case i of- (-1) -> propagateEvent- _ -> do- mnText <- listBoxGetString lstLoadedModules 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+ mn <- listCtrlGetItemText lstLoadedModules i+ 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@@ -286,11 +296,25 @@ menuItemSetText item $ show fn menuItemSetId item wxId_HASK_MENUELEM menuAppendItem m item + createMenuItem m HP.MEClass{HP.clsName = cn, HP.clsFuns = []} =+ do+ item <- menuItemCreate+ menuItemSetCheckable item False+ menuItemSetText item $ "class " ++ cn+ 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 = []} =+ do+ item <- menuItemCreate+ menuItemSetCheckable item False+ menuItemSetText item $ "data " ++ dn+ menuItemSetId item wxId_HASK_MENUELEM+ menuAppendItem m item createMenuItem m HP.MEData{HP.datName = dn, HP.datCtors = dcs} = do subMenu <- menuPane []@@ -555,15 +579,27 @@ Just fn -> takeFileName $ dropExtension fn in itemAppend lstPages $ prefix ++ name set lstPages [selection := i]+ -- Refresh the modules lists+ --NOTE: we know 0 == "imported" / 1 == "interpreted" / 2 == "compiled" images+ --TODO: move that to some kind of constants or so+ let ims' = map (\m -> (0, m)) ims+ ms' = map (\m -> (1, m)) ms --TODO: Verify if it is intrepreted+ allms = zip [0..] (ims' ++ ms') itemsDelete lstLoadedModules- (flip mapM) ims $ itemAppend lstLoadedModules- (flip mapM) ms $ itemAppend lstLoadedModules . ('*':)+ (flip mapM) allms $ \(idx, (img, m)) ->+ listCtrlInsertItemWithLabel lstLoadedModules idx m img >> + set lstLoadedModules [item idx := [m]]+ itemsDelete lstPkgModules (flip mapM) pms $ \pm -> itemAppend lstPkgModules (if pm `elem` ms then ('*':pm) else pm)+ -- Refresh the current text set txtCode [text := t]+ + -- Clean the status bar set status [text := ""]+ -- Refresh the current expression box refreshExpr model guiCtx True
src/HPage/Test/Server.hs view
@@ -220,7 +220,7 @@ 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)+ -- 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))