diff --git a/hpage.cabal b/hpage.cabal --- a/hpage.cabal +++ b/hpage.cabal @@ -1,5 +1,5 @@ name: hpage -version: 0.4.3 +version: 0.4.4 cabal-version: >=1.6 build-type: Custom license: BSD3 diff --git a/res/help/helpPage.hs b/res/help/helpPage.hs --- a/res/help/helpPage.hs +++ b/res/help/helpPage.hs @@ -6,8 +6,8 @@ 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 +-- Now you can place your cursor on any of them and then press the [Interpret] button below +-- or just use Ctrl-I to get their values or types -- You can also type in Type names, like... @@ -15,16 +15,16 @@ IO --- ...to see their kind, using the [Kind] button below +-- ...to see their kind, using the same mechanism -- 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 +-- Now if you place your cursor on the next expression, you can ask for its interpretation fact 20 --- If you don't want to use the whole page content in an evaluation, you can mark the exact page zone you want to evaluate +-- If you don't want to use the whole page content in an evaluation, you can mark the exact page zone you want to evaluate and then press [Interpret] -- That's just to start up... you can do some serious stuff with this application, just surf the different menues diff --git a/src/HPage/Control.hs b/src/HPage/Control.hs --- a/src/HPage/Control.hs +++ b/src/HPage/Control.hs @@ -29,6 +29,7 @@ -- EDITION CONTROLS -- undo, redo, -- HINT CONTROLS -- + interpret, interpretNth, Interpretation, intKind, intValue, intType, isIntType, valueOf, valueOfNth, kindOf, kindOfNth, typeOf, typeOfNth, loadModules, reloadModules, getLoadedModules, @@ -80,6 +81,13 @@ import Distribution.ModuleName import Distribution.Compiler +data Interpretation = Type {intKind :: String} | Expr {intValue :: String, intType :: String} + deriving (Eq, Show) + +isIntType :: Interpretation -> Bool +isIntType Type{} = True +isIntType Expr{} = False + data ModuleDescription = ModDesc {modName :: String, modInterpreted :: Bool} deriving (Eq) @@ -409,11 +417,32 @@ currentExpr = currentExpr p}) in page{undoActions = undoAct : undoActions page, redoActions = accs}) + +interpret :: HPage (Either Hint.InterpreterError Interpretation) +interpret = getPage >>= interpretNth . currentExpr valueOf, kindOf, typeOf :: HPage (Either Hint.InterpreterError String) valueOf = getPage >>= valueOfNth . currentExpr kindOf = getPage >>= kindOfNth . currentExpr typeOf = getPage >>= typeOfNth . currentExpr + +interpretNth :: Int -> HPage (Either Hint.InterpreterError Interpretation) +interpretNth i = + do + typeRes <- typeOfNth i + case typeRes of + Left terr -> + do + kindRes <- kindOfNth i + case kindRes of + Left _ -> return $ Left terr + Right k -> return $ Right $ Type{intKind = k} + Right t -> + do + valueRes <- valueOfNth i + case valueRes of + Left verr -> return $ Left verr + Right v -> return $ Right $ Expr{intValue = v, intType = t} valueOfNth, kindOfNth, typeOfNth :: Int -> HPage (Either Hint.InterpreterError String) valueOfNth = runInExprNthWithLets Hint.eval 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 @@ -7,6 +7,7 @@ module HPage.GUI.FreeTextWindow ( gui ) where +-- import Control.Concurrent.Process import System.FilePath import System.Directory import System.IO.Error hiding (try) @@ -43,12 +44,13 @@ helpFile :: IO FilePath helpFile = getDataFileName "res/help/helpPage.hs" -data GUIResultRow = GUIRRow { grrButton :: Button (), - grrText :: TextCtrl ()} - -data GUIResults = GUIRes { resValue :: GUIResultRow, - resType :: GUIResultRow, - resKind :: GUIResultRow } +data GUIResults = GUIRes { resPanel :: Panel (), + resButton :: Button (), + resLabel :: StaticText (), + resValue :: TextCtrl (), + res4Dots :: StaticText (), + resType :: TextCtrl (), + resKind :: TextCtrl () } data GUIContext = GUICtx { guiWin :: Frame (), guiPages :: SingleListBox (), @@ -94,33 +96,37 @@ lstPkgModules <- singleListBox pnlPMs [style := wxLB_NEEDED_SB] - -- Results list - txtValue <- textEntry win [style := wxTE_READONLY] - txtType <- textEntry win [style := wxTE_READONLY] - txtKind <- textEntry win [style := wxTE_READONLY] - + -- Results panel + pnlRes <- panel win [] + txtValue <- textEntry pnlRes [style := wxTE_READONLY] + txtType <- textEntry pnlRes [style := wxTE_READONLY] + txtKind <- textEntry pnlRes [style := wxTE_READONLY, visible := False] + btnInterpret <- button pnlRes [text := "Interpret"] + lblInterpret <- staticText pnlRes [text := "Value:"] + lbl4Dots <- staticText pnlRes [text := " :: "] + set pnlRes [layout := fill $ + row 5 [widget btnInterpret, + centre $ widget lblInterpret, + fill $ widget txtValue, + centre $ widget lbl4Dots, + fill $ widget txtType]] + -- Status bar... status <- statusField [text := "hello... this is λPage! type in your instructions :)"] + set win [statusBar := [status]] + + -- Timer ... refreshTimer <- timer win [interval := 1000000, on command := debugIO "Inactivity detected"] varTimer <- varCreate refreshTimer - set win [statusBar := [status]] - btnGetValue <- button win [text := "Value"] - btnGetType <- button win [text := "Type"] - btnGetKind <- button win [text := "Kind"] - + -- Search ... search <- findReplaceDataCreate wxFR_DOWN - let grrValue = GUIRRow btnGetValue txtValue - let grrType = GUIRRow btnGetType txtType - let grrKind = GUIRRow btnGetKind txtKind - let guiRes = GUIRes grrValue grrType grrKind + let guiRes = GUIRes pnlRes btnInterpret lblInterpret txtValue lbl4Dots txtType txtKind let guiCtx = GUICtx win lstPages lstPkgModules lstLoadedModules txtCode guiRes status varTimer search let onCmd name acc = traceIO ("onCmd", name) >> acc model guiCtx - set btnGetValue [on command := onCmd "getValue" getValue] - set btnGetType [on command := onCmd "getType" getType] - set btnGetKind [on command := onCmd "getKind" getKind] + set btnInterpret [on command := onCmd "interpret" interpret] -- Events set lstPages [on select := onCmd "pageChange" pageChange] @@ -139,7 +145,6 @@ _ -> 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 @@ -174,9 +179,7 @@ menuAppend mnuHask wxId_HASK_ADD "Import modules...\tCtrl-Shift-i" "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_INTERPRET "&Interpret\tCtrl-i" "Interpret the Current Expression" False mnuHelp <- menuHelp [] menuAppend mnuHelp wxId_HELP "&Help page\tCtrl-h" "Open the Help Page" False @@ -205,9 +208,7 @@ evtHandlerOnMenuCommand win wxId_HASK_LOAD_FAST $ onCmd "loadModulesByNameFast" loadModulesByNameFast 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_HASK_INTERPRET $ onCmd "interpret" interpret evtHandlerOnMenuCommand win wxId_HELP $ onCmd "help" openHelpPage -- Tool bar... @@ -246,12 +247,9 @@ 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] - resultsGridL= hfill $ boxed "Expression" $ grid 5 0 [valueRowL, typeRowL, kindRowL] leftL = tabs ntbkL [lddModsTabL, pkgModsTabL, pagesTabL] - rightL = minsize (sz 485 100) $ column 5 [txtCodeL, resultsGridL] + resultsL = hfill $ boxed "Expression" $ fill $ widget pnlRes + rightL = minsize (sz 485 100) $ column 5 [txtCodeL, resultsL] set win [layout := fill $ row 10 [leftL, rightL], clientSize := sz 800 600] @@ -266,7 +264,6 @@ justFind, justFindNext, justFindPrev, findReplace, textContextMenu, pkgModuleContextMenu, restartTimer, killTimer, - getValue, getType, getKind, loadPackage, loadModules, importModules, loadModulesByName, loadModulesByNameFast, reloadModules, configure, openHelpPage :: HPS.ServerHandle -> GUIContext -> IO () @@ -332,9 +329,7 @@ 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 + menuAppend contextMenu wxId_HASK_INTERPRET "&Interpret\tCtrl-i" "Interpret the Current Expression" False propagateEvent pointWithinWindow <- windowGetMousePosition win @@ -356,15 +351,6 @@ menuPopup contextMenu pointWithinWindow win objectDelete contextMenu -getValue model guiCtx@GUICtx{guiResults = GUIRes{resValue = grrValue}} = - runTxtHP HP.valueOf model guiCtx grrValue - -getType model guiCtx@GUICtx{guiResults = GUIRes{resType = grrType}} = - runTxtHP HP.typeOf model guiCtx grrType - -getKind model guiCtx@GUICtx{guiResults = GUIRes{resKind = grrKind}} = - runTxtHP HP.kindOf model guiCtx grrKind - pageChange model guiCtx@GUICtx{guiPages = lstPages} = do i <- get lstPages selection @@ -614,31 +600,67 @@ Right () -> refreshPage model guiCtx -runTxtHP, runTxtHPPointer :: HP.HPage (Either HP.InterpreterError String) -> - HPS.ServerHandle -> GUIContext -> GUIResultRow -> IO () -runTxtHPSelection :: String -> HP.HPage (Either HP.InterpreterError String) -> - HPS.ServerHandle -> GUIContext -> GUIResultRow -> IO () -runTxtHP hpacc model guiCtx@GUICtx{guiCode = txtCode} guiRow = +interpret model guiCtx@GUICtx{guiResults = GUIRes{resPanel = pnlRes, + resLabel = lblInterpret, + resButton = btnInterpret, + resValue = txtValue, + res4Dots = lbl4Dots, + resType = txtType, + resKind = txtKind}, + guiCode = txtCode, guiWin = win} = do sel <- textCtrlGetStringSelection txtCode let runner = case sel of - "" -> runTxtHPPointer + "" -> tryIn sl -> runTxtHPSelection sl - runner hpacc model guiCtx guiRow - -runTxtHPSelection s hpacc model guiCtx@GUICtx{guiWin = win, - guiStatus = status} - GUIRRow{grrButton = btn, - grrText = txtBox} = - do refreshExpr model guiCtx False + set btnInterpret [enabled := False] + res <- runner model HP.interpret + case res of + Left err -> + do + warningDialog win "Error" err + set btnInterpret [enabled := True] + Right interp -> + if HP.isIntType interp + then do + set btnInterpret [enabled := True] + set txtValue [visible := False] + set lbl4Dots [visible := False] + set txtType [visible := False] + set txtKind [visible := True, text := HP.intKind interp] + set lblInterpret [text := "Kind:"] + set pnlRes [layout := fill $ centre $ + row 5 [widget btnInterpret, + centre $ widget lblInterpret, + hfill $ widget txtKind]] + repaint pnlRes + else do + set btnInterpret [enabled := True] + set txtValue [visible := True, text := HP.intValue interp] + set lbl4Dots [visible := True, text := " :: "] + set txtType [visible := True, text := HP.intType interp] + set txtKind [visible := False] + set lblInterpret [text := "Value:"] + set pnlRes [layout := fill $ + row 5 [widget btnInterpret, + centre $ widget lblInterpret, + hfill $ widget txtValue, + centre $ widget lbl4Dots, + hfill $ widget txtType]] + repaint pnlRes + +runTxtHPSelection :: String -> HPS.ServerHandle -> + HP.HPage (Either HP.InterpreterError HP.Interpretation) -> IO (Either ErrorString HP.Interpretation) +runTxtHPSelection s model hpacc = + do debugIO ("evaluating selection", s) piRes <- tryIn' model HP.getPageIndex added <- tryIn' model $ HP.addPage case added of Left err -> - warningDialog win "Error" err - Right _ -> + return $ Left err + Right () -> do let cpi = case piRes of Left err -> 0 @@ -646,25 +668,12 @@ newacc = HP.setPageText s (length s) >> hpacc res <- tryIn model newacc tryIn' model $ HP.closePage >> HP.setPageIndex cpi - case res of - Left err -> warningDialog win "Error" err - Right val -> set txtBox [text := val] - -runTxtHPPointer hpacc model guiCtx@GUICtx{guiWin = win, - guiStatus = status} - GUIRRow{grrButton = btn, - grrText = txtBox} = - do - refreshExpr model guiCtx False - res <- tryIn model hpacc - case res of - Left err -> warningDialog win "Error" err - Right val -> set txtBox [text := val] + return res refreshExpr :: HPS.ServerHandle -> GUIContext -> Bool -> IO () -refreshExpr model guiCtx@GUICtx{guiResults = GUIRes{resValue = grrValue, - resType = grrType, - resKind = grrKind}, +refreshExpr model guiCtx@GUICtx{guiResults = GUIRes{resValue = txtValue, + resType = txtType, + resKind = txtKind}, guiCode = txtCode, guiWin = win} forceClear = do @@ -678,7 +687,7 @@ warningDialog win "Error" err Right changed -> if changed || forceClear - then mapM_ (flip set [text := ""] . grrText) [grrValue, grrType, grrKind] + then mapM_ (flip set [text := ""]) [txtValue, txtType, txtKind] else debugIO "dummy refreshExpr" killTimer model guiCtx diff --git a/src/HPage/GUI/IDs.hs b/src/HPage/GUI/IDs.hs --- a/src/HPage/GUI/IDs.hs +++ b/src/HPage/GUI/IDs.hs @@ -32,15 +32,13 @@ wxId_CLOSE_ALL = 5018 wxId_HASK_LOAD, wxId_HASK_LOADNAME, wxId_HASK_LOAD_FAST, wxId_HASK_RELOAD, - wxId_HASK_VALUE, wxId_HASK_TYPE, wxId_HASK_KIND, + wxId_HASK_INTERPRET, wxId_HASK_ADD, wxId_HASK_LOAD_PKG, 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_LOAD_PKG = 5308 -wxId_HASK_LOAD_FAST = 5309 +wxId_HASK_INTERPRET = 5303 +wxId_HASK_ADD = 5304 +wxId_HASK_LOAD_PKG = 5305 +wxId_HASK_LOAD_FAST = 5306 wxId_HASK_MENUELEM = 5310