Skip to content

Commit 65128aa

Browse files
mmhelloworldmmhelloworld
committed
frege-repl-3 Show Java source, documentation support
1 parent f0886be commit 65128aa

File tree

2 files changed

+272
-36
lines changed

2 files changed

+272
-36
lines changed

‎src/main/frege/frege/repl/FregeRepl.fr

+184-36
Original file line numberDiff line numberDiff line change
@@ -1,13 +1,18 @@
11
module frege.repl.FregeRepl where
22

3-
import frege.compiler.Data
4-
import frege.compiler.Import
3+
import Compiler.Data
4+
import Compiler.Import
55
import frege.Version
6-
import frege.java.Net
6+
import Java.Net
77
import Data.List
8-
import frege.interpreter.FregeScriptCompiler hiding(compile)
9-
import frege.interpreter.FregeInterpreter
10-
import frege.compiler.EclipseUtil as EU()
8+
import Interpreter.FregeScriptCompiler hiding(compile)
9+
import Interpreter.FregeInterpreter
10+
import Compiler.Utilities as U()
11+
import Compiler.EclipseUtil as EU()
12+
import Compiler.DocUtils as DU(docit, docSym, DL, Doc, emitHtml)
13+
import Java.Swing (JFrame, invokeLater)
14+
import Java.Awt (Component, ActionListener)
15+
import Repl.Gui
1116

1217
data ReplState = ReplState {
1318
lastExternalScript :: Maybe String,
@@ -19,6 +24,7 @@ data Repl a = Repl {un :: StateT ReplState Interpreter a} where
1924
get = Repl $ StateT (\s -> return (s, s))
2025
put s = Repl $ StateT (\_ -> return ((), s))
2126
modify f = Repl $ StateT (\s -> return ((), f s))
27+
run repl state = evalStateT (Repl.un repl) state
2228

2329
instance Monad Repl where
2430
return = Repl . return
@@ -59,7 +65,7 @@ evalScript (Eval line) = do
5965
Repl . lift . Interpreter.put $ s.{currentScript <- (++ newLine ++ line)}
6066
return NoOutput
6167
Expression{variableName=var} -> do
62-
res <- Repl . lift $ evalShow line
68+
res <- Repl . lift $ showVariable line var g
6369
Repl . lift $ Interpreter.put oldInterpState
6470
case res of
6571
Left err -> return $ ReplError err
@@ -121,8 +127,9 @@ evalScript (Load filePath) = do
121127

122128
evalScript Java = do
123129
state <- Repl.get
124-
return $ ReplSuccess (maybe "" id state.lastJavaSource)
125-
130+
showgui s = liftIO $ Runnable.new (javaSourceGUI s) >>= invokeLater >> return NoOutput
131+
maybe (return NoOutput) showgui state.lastJavaSource
132+
126133
evalScript Reload = do
127134
state <- Repl.get
128135
case state.lastExternalScript of
@@ -141,10 +148,87 @@ evalScript Reset = do
141148

142149
evalScript Skip = return NoOutput
143150
evalScript Help = return $ ReplSuccess help
151+
152+
evalScript (HelpDoc source) = do
153+
fregecRes <- Repl . lift $ compile "\"\"" -- Import current definitions
154+
let response = maybe (return errmsg) (\m -> liftIO (gui m) >> return NoOutput)
155+
errmsg = ReplError [source ++ " cannot be resolved!"]
156+
gui content = invokeLater =<< Runnable.new (helpGUI source content)
157+
case fregecRes of
158+
CompilationSuccess (c@CompilationInfo{state=global}) -> oneof [helpdoc, packDoc] where
159+
helpdoc = fst $ StG.run (helpDoc source) global
160+
packDoc = fst $ StG.run (packDocumentation source) global
161+
oneof = response . listToMaybe . catMaybes
162+
_ -> response $ Just ""
163+
144164
evalScript Version = Repl.get >>= (\s -> return $ ReplSuccess version)
145165
evalScript DefMulti = return NoOutput
146166
evalScript Quit = return NoOutput
147167

168+
sNameToQName sName = do
169+
g <- getST
170+
qNames <- U.resolve (VName g.thisPack) Position.null sName
171+
return (listToMaybe qNames) -- Just taking first resolved
172+
173+
helpDoc :: String -> StG (Maybe String)
174+
helpDoc source = do
175+
global <- getST
176+
qNameMay <- sNameToQName (createSName source)
177+
let symMay = qNameMay >>= (\qname -> qname.findit global)
178+
maybe (return Nothing) (\sym -> symbolDocumentation sym >>= return . Just) symMay
179+
180+
createSName s
181+
| Just (Just ns : Just ty : Just id : _) <- s `match` #^(.*)\.(.*)\.(\p{Lu}.*)$# = with2con ns ty id
182+
| Just (Just ns : Just ty : Just id : _) <- s `match` #^(.*)\.(.*)\.(.*)$# = with2var ns ty id
183+
| Just (Just ty : Just id : _) <- s `match` #^(.*)\.(\p{Lu}.*)$# = with1con ty id
184+
| Just (Just ty : Just id : _) <- s `match` #^(.*)\.(.*)$# = with1var ty id
185+
| s ~ #^\p{Lu}.*$# = Simple (Token CONID s 1 0 0 [])
186+
| otherwise = Simple (Token VARID s 1 0 0 [])
187+
where with2con ns ty id = With2 (qual ns) (qual ty) (con id)
188+
with2var ns ty id = With2 (qual ns) (qual ty) (var id)
189+
with1con ty id = With1 (qual ty) (con id)
190+
with1var ty id = With1 (qual ty) (var id)
191+
qual name = Token QUALIFIER name 1 0 0 []
192+
con name = Token CONID name 1 0 0 []
193+
var name = Token VARID name 1 0 0 []
194+
195+
symbolDocumentation :: Symbol -> StG String
196+
symbolDocumentation sym = do
197+
sw <- doio $ StringWriter.new ()
198+
p <- doio $ StringWriter.printer sw
199+
changeST Global.{gen <- GenSt.{printer=p}}
200+
g <- getST
201+
let ds = docSym g sym
202+
dl = DL (Just "func") [ds]
203+
doc = Doc [dl]
204+
emitHtml false doc -- html without CSS, swing does not understand
205+
doio $ g.printer.close
206+
result <- doio $ sw.toString
207+
return result
208+
209+
packDocumentation :: String -> StG (Maybe String)
210+
packDocumentation pack = do
211+
g <- getST
212+
r <- getFP pack
213+
case r of
214+
Right (Just fp) -> case fp.doc of
215+
"" -> return . Just $ ("Undocumented package " ++ pack)
216+
text -> do
217+
let doc = Doc $ docit g (Just text)
218+
sw <- doio $ StringWriter.new ()
219+
p <- doio $ StringWriter.printer sw
220+
changeST Global.{gen <- GenSt.{printer=p}}
221+
emitHtml false doc -- html without CSS, swing does not understand
222+
doio $ g.printer.close
223+
result <- doio $ sw.toString
224+
return . Just $ result
225+
Left ex -> return Nothing
226+
sonst -> return . Just $ ("(java class?) " ++ pack)
227+
228+
match s regex = groups <$> s =~ regex where groups m = [m.group i | i <- [1..groupCount m]]
229+
230+
pure native groupCount :: Matcher -> Int
231+
148232
ioException :: IOException -> Repl ReplResult
149233
ioException e = return $ ReplError [Throwable.getMessage e]
150234

@@ -176,7 +260,7 @@ showVariable source var g = do
176260
case symbolMay of
177261
Nothing -> return . Left $ ["Not found: " ++ var]
178262
Just symbol -> showSymbol source var symbol g
179-
263+
180264
showSymbol source var symbol g | isVariable g symbol = do
181265
state <- Interpreter.get
182266
if isString g symbol then do
@@ -185,7 +269,7 @@ showSymbol source var symbol g | isVariable g symbol = do
185269
Left err -> return $ Left [err.getMessage]
186270
Right value -> return . Right $ toString value
187271
else do
188-
Interpreter.put $ state.{currentScript <- (++ newLine ++ var ++ " = " ++ source)}
272+
Interpreter.put $ state.{currentScript <- (++ newLine ++ (variableDeclScript var source))}
189273
let showScript = buildShowScript var g symbol
190274
showResult <- evalShow showScript
191275
return showResult
@@ -223,18 +307,20 @@ positionAndName a b = case Symbol.pos a <=> Symbol.pos b of
223307
Eq -> comparing (QName.base • Symbol.name) a b
224308
ne -> ne
225309

226-
cmdHelp = [(":type <expression>", "Display the type of an expression"),
227-
(":{", "Start multiline definitions"),
228-
(":}", "End multiline defintions"),
310+
cmdHelp = [(":type <expression>", "Display the type of an expression."),
229311
(":browse <module name>", "Display the names in a module if " ++
230-
"a module name is provided otherwise display the names in the default REPL module"),
231-
(":load <url or file>", "Load Frege code snippets from an URL or file"),
232-
(":r", "Reload the last script file"),
233-
(":history", "Display the source history for definitions in the default REPL module"),
234-
(":reset", "Reset the session discarding all evaluated scripts"),
235-
(":version", "Display Frege version"),
236-
(":q or :quit", "Quit REPL"),
237-
(":help", "Display this help message")]
312+
"a module name is provided otherwise display the names in the default REPL module."),
313+
(":load <url or file>", "Load Frege code snippets from an URL or file."),
314+
(":java", "View Java translation of last compiled Frege source."),
315+
(":r", "Reload the last script file."),
316+
(":history", "Display the source history for definitions in the default REPL module."),
317+
(":reset", "Reset the session discarding all evaluated scripts."),
318+
(":version", "Display Frege version."),
319+
(":{", "Start multiline definitions."),
320+
(":}", "End multiline defintions."),
321+
(":help <name>", "Display the documentation for the given name." ++
322+
" If the name is not provided, display this help message."),
323+
(":q or :quit", "Quit REPL")]
238324

239325
f `on` g = \x \y -> f (g x) (g y)
240326

@@ -247,7 +333,7 @@ renderCmdHelp cmdHelp = map render cmdHelp where
247333
help = intercalate newLine $ header ++ body where
248334
header = ["At the prompt, you can enter Frege code snippets to get them evaluated.",
249335
"The output or compilation errors will be printed below the prompt.",
250-
"In addition to Frege code, the following commands are supported:"]
336+
"In addition to Frege code, the following commands are supported:\n"]
251337
body = renderCmdHelp cmdHelp
252338

253339
runFile :: String -> Repl ()
@@ -289,25 +375,87 @@ urlContents url = do
289375
inStream <- URL.openStream url
290376
scanner <- Scanner.new inStream
291377
scanner.useDelimiter "\\Z"
292-
scanner.next
378+
scanner.next `finally` scanner.close
293379

294380
fileContents filePath = do
295381
file <- File.new filePath
296382
scanner <- Scanner.fromFile file "utf-8"
297383
scanner.useDelimiter "\\Z"
298-
scanner.next
384+
scanner.next `finally` scanner.close
299385

300386
data Scanner = mutable native java.util.Scanner where
301387
native new :: InputStream -> IO Scanner
302388
native fromFile new :: MutableIO File -> String -> IO Scanner throws FileNotFoundException
303389
native useDelimiter :: Scanner -> String -> IO ()
304390
native next :: Scanner -> IO String
305-
306-
runRepl repl state = evalStateT (Repl.un repl) state
391+
392+
javaSourceGUI :: String -> IO ()
393+
javaSourceGUI javaSource = do
394+
frame::JFrame <- JFrame.new "Java Source"
395+
newContentPane::JPanel <- BorderLayout.new () >>= JPanel.new
396+
frame.setDefaultCloseOperation JFrame.dispose_on_close
397+
editor::JEditorPane <- JEditorPane.new "text/plain" javaSource
398+
editor.setEditable false
399+
scrollPane <- JScrollPane.new editor
400+
dimension <- Dimension.new 600 600
401+
JComponent.setPreferredSize scrollPane dimension
402+
Container.add newContentPane scrollPane (asObject BorderLayout.center)
403+
frame.setContentPane newContentPane
404+
frame.pack
405+
frame.setVisible true
406+
407+
408+
helpGUI :: String -> String -> IO ()
409+
helpGUI title content = do
410+
frame <- JFrame.new (title ++ " - Documentation")
411+
frame.setDefaultCloseOperation JFrame.dispose_on_close
412+
newContentPane:: JPanel <- BorderLayout.new () >>= JPanel.new
413+
let html :: String
414+
html = substring content $ indexOf content "<HTML>" -- Skip DOCTYPE
415+
editor::JEditorPane <- JEditorPane.new "text/html" html
416+
editor.setEditable false
417+
helpLinksListener <- FregeJavaProxy.with showDesktop HyperlinkListener.clazz
418+
editor.addHyperlinkListener helpLinksListener
419+
scrollPane <- JScrollPane.new editor
420+
dimension <- Dimension.new 600 600
421+
JComponent.setPreferredSize scrollPane dimension
422+
Container.add newContentPane scrollPane (asObject BorderLayout.center)
423+
newContentPane.setOpaque true
424+
frame.setContentPane newContentPane
425+
frame.pack
426+
frame.setVisible true
427+
428+
data FregeJavaProxy = pure native frege.memoryjavac.FregeJavaProxy where
429+
native with frege.memoryjavac.FregeJavaProxy.with :: (Object -> Method -> ObjectArr -> ST s a) -> Class c -> IO c
430+
431+
showDesktop :: Object -> Method -> ObjectArr -> IO ()
432+
showDesktop _ _ args = do
433+
event <- return $ asHyperlinkEvent $ args.elemAt 0
434+
d <- Desktop.getDesktop ()
435+
desktopSupported <- d.isDesktopSupported
436+
let url = HyperlinkEvent.getURL event
437+
navigateRelative = either throw d.browse . URI.new $ fixHelpLink event.getDescription
438+
navigate = maybe navigateRelative (\u -> toURI u >>= d.browse) url
439+
when (event.getEventType == HyperlinkEvent_EventType.activated) navigate
440+
441+
442+
fixHelpLink (m~#^\.\.(.*)$#) = maybe helpRoot (\s -> helpRoot ++ s) $ m.group 1
443+
fixHelpLink s = s
444+
445+
helpRoot = "http://try.frege-lang.org/doc"
446+
447+
native toURI :: URL -> ST s URI throws URISyntaxException
448+
pure native asObject "(java.lang.Object)" :: a -> Object
449+
307450

308451
pure native isEmpty :: String -> Bool
452+
pure native replaceAll :: String -> String -> String -> String
453+
pure native indexOf :: String -> String -> Int
454+
pure native substring :: String -> Int -> String
455+
| String -> Int -> Int -> String
309456

310-
data Command = Version | Help | Browse | BrowseModule String | Type String | Load String | Eval String |
457+
data Command = Version | Help | HelpDoc String | Browse |
458+
BrowseModule String | Type String | Load String | Eval String |
311459
Java | DefMulti | History | Reload | Reset | Skip | Quit where
312460

313461
parse :: String -> Either String Command
@@ -321,8 +469,9 @@ data Command = Version | Help | Browse | BrowseModule String | Type String | Loa
321469
parseCommand (m~#^:l.*?\s+(.*)#) =
322470
maybe (Left "Missing external script path!") (Right . Load) $ m.group 1
323471
parseCommand ":version" = Right Version
472+
parseCommand (m~#:help\s+(.*)#) = maybe (Right Help) (Right . HelpDoc) $ m.group 1
324473
parseCommand ":help" = Right Help
325-
parseCommand (m~#^:t.*?\s+(.*)#) =
474+
parseCommand (m~#^:t.*?\s+(.*)#) =
326475
maybe (Left "Missing expression!") (Right . Type) $ m.group 1
327476
parseCommand ":{" = Right DefMulti
328477
parseCommand ":history" = Right History
@@ -348,13 +497,13 @@ initInterpreterState = do
348497
urlarr <- URLArray.new 0
349498
loader <- ClassLoader.current >>= URLClassLoader.new urlarr
350499
classes <- HashMap.new ()
351-
time <- currentTimeMillis ()
500+
time <- System.currentTimeMillis ()
352501
let interpreterState = InterpreterState {
353502
loader = loader,
354503
classes = classes,
355-
moduleName = "script.Main" ++ show time,
504+
moduleName = "repl" ++ show time ++ ".Repl",
356505
currentScript = "",
357-
modulePrelude = ""
506+
transformDefs = id
358507
}
359508
return interpreterState
360509

@@ -363,7 +512,6 @@ vmName = maybe "" id $ System.getProperty "java.vm.name"
363512
javaVersion = maybe "" id $ System.getProperty "java.version"
364513

365514
pure native toString :: Object -> String
366-
native currentTimeMillis java.lang.System.currentTimeMillis :: () -> IO Long
367515

368516
welcome = "Welcome to Frege " ++ version ++ " (" ++ vmVendor ++ " " ++ vmName ++
369517
", " ++ javaVersion ++ ")"
@@ -375,12 +523,12 @@ printResult _ NoOutput = return ()
375523

376524
main [file] = do
377525
interpreterState <- initInterpreterState
378-
evalInterpreter (runRepl (runFile file) initReplState) interpreterState
526+
evalInterpreter (Repl.run (runFile file) initReplState) interpreterState
379527
main _ = do
380528
console <- ConsoleReader.new ()
381529
console.setPrompt initReplState.prompt
382530
console.setExpandEvents false
383531
console.println welcome
384532
interpreterState <- initInterpreterState
385-
evalInterpreter (runRepl (repl console) initReplState) interpreterState
386-
533+
evalInterpreter (Repl.run (repl console) initReplState) interpreterState
534+
System.exit 0

0 commit comments

Comments
 (0)