Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Now you can browse module contents

  • Loading branch information...
commit 439aa7e668cbe1a5e588140b91150ad430f0c7cf 1 parent b152a63
Fernando Benavides authored
View
41 src/HPage/Control.hs
@@ -47,7 +47,7 @@ module HPage.Control (
cancel,
Hint.InterpreterError, Hint.prettyPrintError,
Hint.availableExtensions, Hint.Extension(..),
- Hint.ModuleElem(..),
+ ModuleElemDesc(..),
-- DEBUG --
ctxString
) where
@@ -79,6 +79,22 @@ import Distribution.Package
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}
@@ -442,8 +458,13 @@ getLoadedModules = confirmRunning >> syncRun Hint.getLoadedModules
getImportedModules :: HPage [Hint.ModuleName]
getImportedModules = confirmRunning >>= return . toList . importedModules
-getModuleExports :: Hint.ModuleName -> HPage (Either Hint.InterpreterError [Hint.ModuleElem])
-getModuleExports mn = confirmRunning >> syncRun (Hint.getModuleExports mn)
+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)
@@ -825,4 +846,16 @@ emptyPage = Page [] (-1) [] [] [] Nothing
letsToString :: [Expression] -> String
letsToString [] = ""
-letsToString exs = "let " ++ joinWith "; " (map exprText exs) ++ " in "
+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}
+
View
25 src/HPage/GUI/FreeTextWindow.hs
@@ -257,16 +257,28 @@ browseModule model guiCtx@GUICtx{guiWin = win, guiModules = lstModules, guiCode
propagateEvent >> warningDialog win "Error" err
Right mes ->
do
- flip mapM_ mes $ \me -> menuAppend contextMenu wxId_HASK_MENUELEM "" (meToString me) False
+ flip mapM_ mes $ createMenuItem contextMenu
propagateEvent
pointWithinWindow <- windowGetMousePosition win
menuPopup contextMenu pointWithinWindow win
objectDelete contextMenu
- where meToString (HP.Fun fname) = "function " ++ fname
- meToString (HP.Class cname cfuns) = "class " ++ cname ++ " where " ++
- foldl (\f a -> a ++ if a == "" then "" else ", " ++ f) "" cfuns
- meToString (HP.Data dname dcons) = "data " ++ dname ++ " = " ++
- foldl (\f a -> a ++ if a == "" then "" else " | " ++ f) "" dcons
+ 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
@@ -526,6 +538,7 @@ runTxtHPSelection s hpacc model guiCtx@GUICtx{guiWin = win,
refreshExpr model guiCtx False
debugIO ("evaluating selection", s)
let newacc = do
+ cp <- HP.getPageIndex
HP.addPage
HP.setPageText s $ length s
hpacc
View
10 src/HPage/Test/Server.hs
@@ -218,9 +218,13 @@ prop_get_module_exports :: HPS.ServerHandle -> HS.ServerHandle -> KnownModuleNam
prop_get_module_exports hps hs kmn =
unsafePerformIO $ do
let mn = kmnString kmn
- hpsr <- HPS.runIn hps $ HP.getModuleExports mn
- hsr <- HS.runIn hs $ Hint.getModuleExports mn
- return $ hpsr == hsr
+ 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 =
Please sign in to comment.
Something went wrong with that request. Please try again.