diff --git a/README b/README --- a/README +++ b/README @@ -1,3 +1,35 @@ -we've reach our first alpha release!! +Welcome to hPage! -This file will contain information about how to install the system in the different platforms, but for now it's here just to show happiness :) +-- INSTALL ------------------------------------------------------------------------------------------------------- +The easiest way to install hPage is through cabal-install: +1. Install wxWidgets 2.8.10 (or superior) from http://wxwidgets.org +2. Install Cabal from http://www.haskell.org/cabal/ +3. Run $ sudo cabal install hpage +4. Run $ ~/.cabal/bin/hpage + +-- USE ----------------------------------------------------------------------------------------------------------- +To start using it, just write some haskell expressions separated by empty lines like the following ones: + +12 + 30 + +length [0..41] + +Now you can place your cursor on any of them and then press the [Value] or [Type] buttons to get their values or types +You can also type in Type names, like... + +Int + +IO + +...to see their kind, using the [Kind] button + +You can define functions, let's try out the well known fact... + +fact x = foldl (*) 1 [1..x] + +Now if you place your cursor on something like... + +fact 20 + +... you can ask for its value or type +That's just to start up... you can do some serious stuff with this application, just check out the different menues diff --git a/Setup.hs b/Setup.hs --- a/Setup.hs +++ b/Setup.hs @@ -87,5 +87,5 @@ hPageTestRunner :: Args -> Bool -> PackageDescription -> LocalBuildInfo -> IO () hPageTestRunner _ _ _ _ = do - system "runhaskell -i./src src/HPage/Test/Server.hs" + system "cd src && runhaskell HPage/Test/Server.hs" return () diff --git a/hpage.cabal b/hpage.cabal --- a/hpage.cabal +++ b/hpage.cabal @@ -1,5 +1,5 @@ name: hpage -version: 0.1.6 +version: 0.2.0 cabal-version: >=1.6 build-type: Custom license: BSD3 @@ -22,6 +22,7 @@ res/images/icon/hpage.jpg res/images/icon/hpage.png res/images/icon/hpage.tif + res/help/helpPage.hs data-dir: "" extra-source-files: Setup.hs extra-tmp-files: @@ -42,7 +43,9 @@ directory >=1.0.0, directory < 1.1, wxcore >=0.11.1, wxcore < 0.12, wx >=0.11.1, wx < 0.12, - filepath >=1.1.0, filepath < 1.2 + filepath >=1.1.0, filepath < 1.2, + Cabal >= 1.6, Cabal < 1.7, + MissingH >= 1.1, MissingH < 1.2 main-is: Main.hs buildable: True build-tools: @@ -56,9 +59,9 @@ install-includes: hs-source-dirs: src other-modules: Control.Concurrent.Process, - Graphics.UI.WX.Dialogs.Extra Graphics.UI.WXCore.WxcDefs.ExtraIdentities HPage.GUI.FreeTextWindow, + HPage.GUI.Dialogs, HPage.Control, HPage.Server, HPage.Test.Server, diff --git a/res/help/helpPage.hs b/res/help/helpPage.hs new file mode 100644 --- /dev/null +++ b/res/help/helpPage.hs @@ -0,0 +1,29 @@ +-- Welcome to hPage! +-- To start using it, just write some haskell expressions separated by empty lines +-- like the following ones: + +12 + 30 + +length [0..41] + +-- Now you can place your cursor on any of them and then press the [Value] or [Type] buttons below +-- to get their values or types + +-- You can also type in Type names, like... + +Int + +IO + +-- ...to see their kind, using the [Kind] button below + +-- You can define functions too, let's try (once again) with the well known fact... + +fact x = foldl (*) 1 [1..x] + +-- Now if you place your cursor on the next instruction, you can ask for their values or types + +fact 20 + + +-- That's just to start up... you can do some serious stuff with this application, just surf the different menues diff --git a/src/Graphics/UI/WX/Dialogs/Extra.hs b/src/Graphics/UI/WX/Dialogs/Extra.hs deleted file mode 100644 --- a/src/Graphics/UI/WX/Dialogs/Extra.hs +++ /dev/null @@ -1,60 +0,0 @@ - -module Graphics.UI.WX.Dialogs.Extra (optionDialog, multiOptionsDialog) where - -import Data.List -import Graphics.UI.WX -import Graphics.UI.WX.Dialogs -import Graphics.UI.WXCore -import Graphics.UI.WXCore.WxcClasses - --- | Retrieve an option from a list. Returns 'Nothing' on cancel. Usage: --- --- > optionsDialog window message caption options selectedOption --- -optionDialog :: (Eq t, Show t) => Window a -> String -> String -> [t] -> Maybe t -> IO (Maybe t) -optionDialog win message caption options selectedOption = - do - dlg <- dialog win [text := caption] - btnok <- button dlg [text := "Ok", identity := wxID_OK] - btnnok <- button dlg [text := "Cancel", identity := wxID_CANCEL] - cboOpts <- comboBoxEx dlg wxCB_READONLY [items := map show options] - case selectedOption of - Nothing -> - set cboOpts [selection := -1] - Just option -> - case elemIndex option options of - Nothing -> - set cboOpts [selection := -1] - Just ind -> - set cboOpts [selection := ind] - let cboL = fill $ column 5 [margin 5 $ label message, fill $ widget cboOpts] - btnsL = margin 5 $ floatRight $ row 5 [widget btnnok, widget btnok] - set dlg [layout := fill $ column 5 [cboL, btnsL]] - showModal dlg $ \stopFun -> do - focusOn cboOpts - set btnok [on command := get cboOpts selection >>= stopFun . Just . (options !!)] - set btnnok [on command := stopFun Nothing] - --- | Retrieve a list of options from a list of possible ones. Returns 'Nothing' on cancel. Usage: --- --- > multiOptionsDialog window message caption options selectedOptions --- -multiOptionsDialog :: (Eq t, Show t) => Window a -> String -> String -> [t] -> [t] -> IO (Maybe [t]) -multiOptionsDialog win message caption options selectedOptions = - do - dlg <- dialog win [text := caption] - btnok <- button dlg [text := "Ok", identity := wxID_OK] - btnnok <- button dlg [text := "Cancel", identity := wxID_CANCEL] - lstOpts <- multiListBox dlg [items := map show options] - let selIndexes = foldr (\option acc -> - case elemIndex option options of - Nothing -> acc - Just ind -> ind : acc) [] selectedOptions - set lstOpts [selections := selIndexes] - let cboL = fill $ column 5 [margin 5 $ label message, fill $ widget lstOpts] - btnsL = margin 5 $ floatRight $ row 5 [widget btnnok, widget btnok] - set dlg [layout := fill $ column 5 [cboL, btnsL]] - showModal dlg $ \stopFun -> do - focusOn lstOpts - set btnok [on command := get lstOpts selections >>= stopFun . Just . map (options !!)] - set btnnok [on command := stopFun Nothing] diff --git a/src/Graphics/UI/WXCore/WxcDefs/ExtraIdentities.hs b/src/Graphics/UI/WXCore/WxcDefs/ExtraIdentities.hs --- a/src/Graphics/UI/WXCore/WxcDefs/ExtraIdentities.hs +++ b/src/Graphics/UI/WXCore/WxcDefs/ExtraIdentities.hs @@ -1,20 +1,18 @@ module Graphics.UI.WXCore.WxcDefs.ExtraIdentities where -wxID_REPLACE, wxID_REPLACE_ALL :: Int +wxID_REPLACE, wxID_REPLACE_ALL, wxID_PREFERENCES, + wxID_CLOSE_ALL :: Int wxID_REPLACE = 5038 wxID_REPLACE_ALL = 5039 - -wxID_CLOSE_ALL :: Int -wxID_CLOSE_ALL = 5201 +wxID_PREFERENCES = 5019 +wxID_CLOSE_ALL = 5018 wxID_HASK_LOAD, wxID_HASK_LOADNAME, wxID_HASK_RELOAD, - wxID_HASK_EXTENSIONS, wxID_HASK_VALUE, wxID_HASK_TYPE, wxID_HASK_KIND :: Int wxID_HASK_LOAD = 5300 wxID_HASK_LOADNAME = 5301 wxID_HASK_RELOAD = 5302 -wxID_HASK_EXTENSIONS= 5303 wxID_HASK_VALUE = 5304 wxID_HASK_TYPE = 5305 wxID_HASK_KIND = 5306 diff --git a/src/HPage/Control.hs b/src/HPage/Control.hs --- a/src/HPage/Control.hs +++ b/src/HPage/Control.hs @@ -35,11 +35,13 @@ getLanguageExtensions, setLanguageExtensions, getSourceDirs, setSourceDirs, getGhcOpts, setGhcOpts, + loadPrefsFromCabal, valueOf', valueOfNth', kindOf', kindOfNth', typeOf', typeOfNth', loadModules', reloadModules', getLoadedModules', getLanguageExtensions', setLanguageExtensions', getSourceDirs', setSourceDirs', getGhcOpts', setGhcOpts', + loadPrefsFromCabal', reset, reset', cancel, Hint.InterpreterError, Hint.prettyPrintError, @@ -50,6 +52,7 @@ import System.IO import System.Directory +import System.FilePath import Data.Set (Set, empty, union, fromList, toList) import Data.Char import Control.Monad.Loops @@ -64,9 +67,15 @@ import qualified Language.Haskell.Interpreter.Server as HS import Utils.Log import Data.List (isPrefixOf) +import Data.List.Utils import qualified Data.List as List import qualified Data.ByteString.Char8 as Str -import Language.Haskell.Exts.Parser +import qualified Language.Haskell.Exts.Parser as Parser +import Distribution.Simple.Configure +import Distribution.Simple.LocalBuildInfo +import Distribution.Package +import Distribution.PackageDescription +import Distribution.Compiler data PageDescription = PageDesc {pIndex :: Int, pPath :: Maybe FilePath, @@ -85,6 +94,9 @@ SetGhcOpts { settingGhcOpts :: String, runningAction :: Hint.InterpreterT IO () } | + LoadingCabal { settingSrcDirs :: [FilePath], + settingGhcOpts :: String, + runningAction :: Hint.InterpreterT IO () } | Reset data Page = Page { -- Display -- @@ -447,6 +459,34 @@ liftErrorIO $ ("Error setting ghc opts dirs", opts, e) return res +loadPrefsFromCabal :: FilePath -> HPage (Either Hint.InterpreterError PackageIdentifier) +loadPrefsFromCabal file = do + let dir = dropFileName file + lbinfo <- liftIO $ getPersistBuildConfig dir + let pkgdesc = localPkgDescr lbinfo + pkgname = package pkgdesc + bldinfos= allBuildInfo pkgdesc + dirs = uniq $ concatMap hsSourceDirs bldinfos + exts = uniq . map (read . show) $ concatMap extensions bldinfos + opts = uniq $ concatMap (hcOptions GHC) bldinfos + action = do + liftTraceIO $ "loading package: " ++ show pkgname + Hint.unsafeSetGhcOption "-i" + Hint.unsafeSetGhcOption "-i." + forM_ dirs $ Hint.unsafeSetGhcOption . ("-i" ++) + Hint.set [Hint.languageExtensions := exts] + forM_ opts $ \opt -> Hint.unsafeSetGhcOption opt `catchError` (\_ -> return ()) + return pkgname + res <- syncRun action + case res of + Right _ -> + modify (\ctx -> ctx{extraSrcDirs = dirs, + ghcOptions = (ghcOptions ctx) ++ " " ++ (joinWith " " opts), + recoveryLog = recoveryLog ctx >> action >> return ()}) + Left e -> + liftErrorIO $ ("Error loading package", pkgname, e) + return res + reset :: HPage (Either Hint.InterpreterError ()) reset = do res <- syncRun $ do @@ -531,6 +571,28 @@ modify $ \ctx -> ctx{running = Just $ SetGhcOpts opts action} return res +loadPrefsFromCabal' :: FilePath -> HPage (MVar (Either Hint.InterpreterError PackageIdentifier)) +loadPrefsFromCabal' file = do + let dir = dropFileName file + lbinfo <- liftIO $ getPersistBuildConfig dir + let pkgdesc = localPkgDescr lbinfo + pkgname = package pkgdesc + bldinfos= allBuildInfo pkgdesc + dirs = uniq $ concatMap hsSourceDirs bldinfos + exts = uniq . map (read . show) $ concatMap extensions bldinfos + opts = joinWith " " . uniq $ concatMap (hcOptions GHC) bldinfos + action = do + liftTraceIO $ "loading package: " ++ show pkgname + Hint.unsafeSetGhcOption "-i" + Hint.unsafeSetGhcOption "-i." + forM_ dirs $ Hint.unsafeSetGhcOption . ("-i" ++) + Hint.set [Hint.languageExtensions := exts] + Hint.unsafeSetGhcOption opts + return pkgname + res <- asyncRun action + modify $ \ctx -> ctx{running = Just $ LoadingCabal dirs opts $ action >> return ()} + return res + reset' :: HPage (MVar (Either Hint.InterpreterError ())) reset' = do res <- asyncRun $ do @@ -653,13 +715,15 @@ c{extraSrcDirs = ssds, recoveryLog = (recoveryLog c) >> ra} apply (Just SetGhcOpts{settingGhcOpts = opts, runningAction = ra}) c = c{ghcOptions = (ghcOptions c) ++ " " ++ opts, recoveryLog = (recoveryLog c) >> ra} +apply (Just LoadingCabal{settingSrcDirs = ssds, settingGhcOpts = opts, runningAction = ra}) c = + c{extraSrcDirs = ssds, ghcOptions = (ghcOptions c) ++ " " ++ opts, recoveryLog = (recoveryLog c) >> ra} fromString :: String -> [Expression] fromString s = map Exp $ splitOn "\n\n" s isNamedExpr :: Expression -> Bool -isNamedExpr e = case parseDecl (exprText e) of - ParseOk _ -> True +isNamedExpr e = case Parser.parseDecl (exprText e) of + Parser.ParseOk _ -> True _ -> False fromString' :: String -> Int -> ([Expression], Int) diff --git a/src/HPage/GUI/Dialogs.hs b/src/HPage/GUI/Dialogs.hs new file mode 100644 --- /dev/null +++ b/src/HPage/GUI/Dialogs.hs @@ -0,0 +1,84 @@ + +module HPage.GUI.Dialogs where + +import System.FilePath +import Data.List +import Control.Monad.Error +import Graphics.UI.WX +import Graphics.UI.WXCore +import Graphics.UI.WXCore.WxcClasses +import qualified HPage.Control as HP + +data Preferences = Prefs {languageExtensions :: [HP.Extension], + sourceDirs :: [FilePath], + ghcOptions :: String} + deriving (Eq, Show) + +data Result = SetPrefs Preferences | LoadPrefs FilePath + +preferencesDialog :: Window a -> String -> Preferences -> IO (Maybe Result) +preferencesDialog win caption currentPrefs = + do + let availExts = sort HP.availableExtensions + dlg <- dialog win [text := caption] + 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] + + lstExts <- multiListBox dlg [items := map show availExts] + let selIndexes = foldr (\option acc -> + case elemIndex option availExts of + Nothing -> acc + Just ind -> ind : acc) [] $ languageExtensions currentPrefs + set lstExts [selections := selIndexes] + + lstDirs <- singleListBox dlg [style := wxLB_NEEDED_SB, items := sourceDirs currentPrefs] + btnadd <- smallButton dlg [text := "+", on command := addDir win lstDirs, tooltip := "Add a directory to search for haskell sources"] + btndel <- smallButton dlg [text := "-", on command := delDir lstDirs, tooltip := "Remove the selected directory"] + + txtGhcOld <- textEntry dlg [text := ghcOptions currentPrefs, style := wxTE_READONLY] + txtGhcNew <- textEntry dlg [text := ""] + + let lesL = fill $ boxed "Extensions" $ fill $ widget lstExts + sdsL = fill $ boxed "Source Dirs" $ fill $ row 5 [fill $ widget lstDirs, + column 5 [widget btnadd, expand $ widget btndel]] + gosL = fill $ boxed "Ghc Options" $ fill $ grid 5 5 [[label "Applied", fill $ widget txtGhcOld], + [label "New", fill $ widget txtGhcNew]] + btnsL = margin 5 $ floatRight $ row 5 [widget btnimport, widget btnnok, widget btnok] + set dlg [layout := fill $ column 5 [lesL, sdsL, gosL, btnsL], + clientSize := sz 500 300] + showModal dlg $ \stopFun -> do + focusOn lstExts + buttonOnCommand btnimport $ openSetupFile dlg >>= stopFun + buttonOnCommand btnok $ getCurrentPrefs lstExts lstDirs txtGhcNew >>= stopFun . Just . SetPrefs + buttonOnCommand btnnok $ stopFun Nothing + where getCurrentPrefs e d g = do + let availExts = sort HP.availableExtensions + les_ <- get e selections + let les = map (availExts !!) les_ + sds <- get d items + gos <- get g text + return $ Prefs les sds gos + openSetupFile dlg = do + res <- fileOpenDialog dlg True True "Select the setup-config file for your project..." + [("setup-config",["setup-config"])] "dist" "setup-config" + case res of + Nothing -> + return Nothing + Just setupConfig -> + return . Just $ LoadPrefs setupConfig + addDir w lstDirs = do + res <- dirOpenDialog w False "Choose directory to add" "" + case res of + Nothing -> + return () + Just dir -> + itemAppend lstDirs dir + delDir lstDirs = do + sel <- get lstDirs selection + case sel of + -1 -> + return () + it -> + itemDelete lstDirs it 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 @@ -14,10 +14,11 @@ import Data.List import Data.Bits import Data.Char (toLower) +import Data.Version +import Distribution.Package import Control.Monad.Error import Control.Monad.Loops import Graphics.UI.WX -import Graphics.UI.WX.Dialogs.Extra import Graphics.UI.WXCore import Graphics.UI.WXCore.WxcDefs.ExtraIdentities import Graphics.UI.WXCore.Types @@ -26,6 +27,7 @@ import Graphics.UI.WXCore.WxcClasses import qualified HPage.Control as HP import qualified HPage.Server as HPS +import HPage.GUI.Dialogs import Utils.Log import Paths_hpage -- cabal locations of data files @@ -33,6 +35,9 @@ imageFile :: FilePath -> IO FilePath imageFile = getDataFileName . ("res/images/"++) +helpFile :: IO FilePath +helpFile = getDataFileName "res/help/helpPage.hs" + data GUIResultRow = GUIRRow { grrButton :: Button (), grrText :: TextCtrl ()} @@ -63,7 +68,7 @@ -- Containers pnl <- panel win [] splLR <- splitterWindow pnl [] - pnlL <- panel splLR [] + pnlL <- panel splLR [clientSize := sz 200 600] pnlR <- panel splLR [] -- Text page... @@ -135,19 +140,20 @@ 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 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_RELOAD "&Reload\tCtrl-r" "Reload Modules" False menuAppendSeparator mnuHask - menuAppend mnuHask wxID_HASK_EXTENSIONS "&Extensions...\tCtrl-Shift-x" "Configure Extensions" 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 mnuHelp <- menuHelp [] + 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]] @@ -169,10 +175,11 @@ evtHandlerOnMenuCommand win wxID_HASK_LOAD $ onCmd "loadModules" loadModules evtHandlerOnMenuCommand win wxID_HASK_LOADNAME $ onCmd "loadModulesByName" loadModulesByName evtHandlerOnMenuCommand win wxID_HASK_RELOAD $ onCmd "reloadModules" reloadModules - evtHandlerOnMenuCommand win wxID_HASK_EXTENSIONS $ onCmd "extensions" configureExtensions + 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 [] @@ -209,13 +216,14 @@ typeRowL = [widget btnGetType, hfill $ widget txtType] kindRowL = [widget btnGetKind, hfill $ widget txtKind] resultsGridL= hfill $ boxed "Expression" $ grid 5 0 [valueRowL, typeRowL, kindRowL] - leftL = container pnlL $ column 5 [lstPagesL, lstModulesL] + leftL = container pnlL $ hfill $ column 5 [lstPagesL, lstModulesL] rightL = container pnlR $ column 5 [txtCodeL, resultsGridL] set win [layout := container pnl $ fill $ vsplit splLR 7 400 leftL rightL, clientSize := sz 800 600] -- ...and RUN! refreshPage model guiCtx + onCmd "start" openHelpPage focusOn txtCode -- EVENT HANDLERS -------------------------------------------------------------- @@ -225,7 +233,7 @@ restartTimer, killTimer, getValue, getType, getKind, loadModules, loadModulesByName, reloadModules, - configureExtensions :: HPS.ServerHandle -> GUIContext -> IO () + configure, openHelpPage :: HPS.ServerHandle -> GUIContext -> IO () getValue model guiCtx@GUICtx{guiResults = GUIRes{resValue = grrValue}} = runTxtHP HP.valueOf' model guiCtx grrValue @@ -327,22 +335,54 @@ set status [text := "loading..."] runHP (HP.loadModules $ words mns) model guiCtx -configureExtensions model guiCtx@GUICtx{guiWin = win, guiStatus = status} = +configure model guiCtx@GUICtx{guiWin = win, guiStatus = status} = do - hpsRes <- tryIn model HP.getLanguageExtensions + hpsRes <- tryIn model $ do + les <- HP.getLanguageExtensions + sds <- HP.getSourceDirs + gos <- HP.getGhcOpts + case les of + Left e -> return $ Left e + Right l -> return $ Right (l, sds, gos) case hpsRes of Left err -> warningDialog win "Error" err - Right exs -> + Right (les, sds, gos) -> do - res <- multiOptionsDialog win "Choose the language extensions to activate" "Extensions" (sort HP.availableExtensions) exs + res <- preferencesDialog win "Preferences" $ Prefs les sds gos case res of Nothing -> return () - Just newexs -> + Just (LoadPrefs file) -> do set status [text := "setting..."] - runHP (HP.setLanguageExtensions newexs) model guiCtx + loadres <- tryIn model (HP.loadPrefsFromCabal file) + case loadres of + Left err -> + warningDialog win "Error" err + Right pkg -> + infoDialog win "hPage" $ "Settings from package " ++ prettyShow pkg ++ " succesfully loaded" + refreshPage model guiCtx + Just (SetPrefs newps) -> + do + set status [text := "setting..."] + runHP (do + HP.setLanguageExtensions $ languageExtensions newps + HP.setSourceDirs $ sourceDirs newps + case ghcOptions newps of + "" -> return $ Right () + newopts -> HP.setGhcOpts newopts + ) model guiCtx + where prettyShow PackageIdentifier{pkgName = PackageName pkgname, + pkgVersion = pkgvsn} = pkgname ++ "-" ++ showVersion pkgvsn + +openHelpPage model guiCtx@GUICtx{guiCode = txtCode} = + do + f <- helpFile + txt <- readFile f + set txtCode [text := txt] + -- Refresh the current expression box + refreshExpr model guiCtx True refreshPage model guiCtx@GUICtx{guiWin = win, guiPages = lstPages, 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