Skip to content
Projects
Groups
Snippets
Help
Loading...
Help
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
G
gargantext-ihaskell
Project
Project
Details
Activity
Releases
Cycle Analytics
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Charts
Issues
0
Issues
0
List
Board
Labels
Milestones
Merge Requests
0
Merge Requests
0
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Charts
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Charts
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
gargantext
gargantext-ihaskell
Commits
24db4b42
Commit
24db4b42
authored
Dec 12, 2013
by
Andrew Gibiansky
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
updating LICENSE and minor formatting fixes
parent
da452d9e
Changes
5
Expand all
Hide whitespace changes
Inline
Side-by-side
Showing
5 changed files
with
48 additions
and
690 deletions
+48
-690
Display.hs
IHaskell/Display.hs
+11
-2
Evaluate.hs
IHaskell/Eval/Evaluate.hs
+13
-10
Parser.hs
IHaskell/Eval/Parser.hs
+3
-3
LICENSE
LICENSE
+20
-675
Main.hs
Main.hs
+1
-0
No files found.
IHaskell/Display.hs
View file @
24db4b42
...
...
@@ -2,12 +2,21 @@
{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}
module
IHaskell.Display
(
IHaskellDisplay
(
..
),
MimeType
(
..
)
,
DisplayData
(
..
),
plain
,
html
)
where
import
ClassyPrelude
import
IHaskell.Types
-- | A class for displayable Haskell types.
class
IHaskellDisplay
a
where
display
::
a
->
[
DisplayData
]
-- | Generate a plain text display.
plain
::
String
->
DisplayData
plain
=
Display
PlainText
-- | Generate an HTML display.
html
::
String
->
DisplayData
html
=
Display
MimeHtml
IHaskell/Eval/Evaluate.hs
View file @
24db4b42
...
...
@@ -50,7 +50,7 @@ import IHaskell.Display
data
ErrorOccurred
=
Success
|
Failure
deriving
Show
debug
::
Bool
debug
=
Tru
e
debug
=
Fals
e
ignoreTypePrefixes
::
[
String
]
ignoreTypePrefixes
=
[
"GHC.Types"
,
"GHC.Base"
,
"GHC.Show"
,
"System.IO"
,
...
...
@@ -162,7 +162,7 @@ evaluate execCount code output = do
runUntilFailure
[]
=
return
()
runUntilFailure
(
cmd
:
rest
)
=
do
(
success
,
result
)
<-
evalCommand
cmd
output
result
unless
(
null
result
)
$
output
result
case
success
of
Success
->
runUntilFailure
rest
Failure
->
return
()
...
...
@@ -174,7 +174,7 @@ wrapExecution exec = ghandle handler $ exec >>= \res ->
return
(
Success
,
res
)
where
handler
::
SomeException
->
Interpreter
(
ErrorOccurred
,
[
DisplayData
])
handler
exception
=
return
(
Failure
,
[
Display
MimeHtml
$
formatError
$
show
exception
]
)
handler
exception
=
return
(
Failure
,
displayError
$
show
exception
)
-- | Return the display data for this command, as well as whether it
-- resulted in an error.
...
...
@@ -189,8 +189,8 @@ evalCommand (Import importStr) = wrapExecution $ do
evalCommand
(
Directive
GetType
expr
)
=
wrapExecution
$
do
result
<-
exprType
expr
flags
<-
getSessionDynFlags
let
typeStr
=
formatGetType
$
showSDocUnqual
flags
$
ppr
result
return
[
Display
MimeHtml
typeStr
]
let
typeStr
=
showSDocUnqual
flags
$
ppr
result
return
[
Display
PlainText
typeStr
,
Display
MimeHtml
$
formatGetType
typeStr
]
evalCommand
(
Statement
stmt
)
=
do
write
$
"Statement: "
++
stmt
...
...
@@ -204,7 +204,7 @@ evalCommand (Statement stmt) = do
return
(
Success
,
output
)
RunException
exception
->
do
write
$
"RunException: "
++
show
exception
return
(
Failure
,
[
Display
MimeHtml
$
formatError
$
show
exception
]
)
return
(
Failure
,
displayError
$
show
exception
)
RunBreak
{}
->
error
"Should not break."
where
...
...
@@ -216,7 +216,7 @@ evalCommand (Statement stmt) = do
let
(
_
,
_
,
postStmts
)
=
makeWrapperStmts
forM_
postStmts
$
\
s
->
runStmt
s
RunToCompletion
return
(
Failure
,
[
Display
MimeHtml
$
formatError
$
show
exception
]
)
return
(
Failure
,
displayError
$
show
exception
)
evalCommand
(
Expression
expr
)
=
do
-- Evaluate this expression as though it's just a statement.
...
...
@@ -264,7 +264,7 @@ evalCommand (Expression expr) = do
evalCommand
(
Declaration
decl
)
=
wrapExecution
$
runDecls
decl
>>
return
[]
evalCommand
(
ParseError
loc
err
)
=
wrapExecution
$
return
[
Display
MimeHtml
$
formatParseError
loc
err
]
return
$
displayError
$
formatParseError
loc
err
capturedStatement
::
String
->
Interpreter
(
String
,
RunResult
)
capturedStatement
stmt
=
do
...
...
@@ -305,8 +305,11 @@ formatError = printf "<span style='color: red; font-style: italic;'>%s</span>" .
useDashV
=
"
\n
Use -v to see a list of the files searched for."
formatParseError
::
StringLoc
->
String
->
ErrMsg
formatParseError
(
Loc
line
col
)
msg
=
formatError
$
printf
"Parse error (line %d, column %d): %s"
line
col
msg
formatParseError
(
Loc
line
col
)
=
printf
"Parse error (line %d, column %d): %s"
line
col
formatGetType
::
String
->
String
formatGetType
=
printf
"<span style='font-weight: bold; color: green;'>%s</span>"
displayError
::
ErrMsg
->
[
DisplayData
]
displayError
msg
=
[
Display
PlainText
msg
,
Display
MimeHtml
$
formatError
msg
]
IHaskell/Eval/Parser.hs
View file @
24db4b42
...
...
@@ -192,9 +192,9 @@ parseCodeChunk code startLine = do
-- If one of the parsers succeeded
(
result
,
used
,
remaining
)
:
_
->
if
not
.
null
.
strip
$
remaining
then
error
$
"Failed to fully
parse "
++
code
else
return
result
return
$
if
not
.
null
.
strip
$
remaining
then
ParseError
(
Loc
1
1
)
$
"Could not
parse "
++
code
else
result
where
successes
::
[
ParseOutput
a
]
->
[(
a
,
String
,
String
)]
successes
[]
=
[]
...
...
LICENSE
View file @
24db4b42
This diff is collapsed.
Click to expand it.
Main.hs
View file @
24db4b42
...
...
@@ -144,6 +144,7 @@ replyTo interface ExecuteRequest{ getCode = code } replyHeader state = do
-- Construct a function for publishing output as this is going.
let
publish
::
[
DisplayData
]
->
Interpreter
()
publish
outputs
=
do
liftIO
$
print
outputs
header
<-
dupHeader
replyHeader
DisplayDataMessage
send
$
PublishDisplayData
header
"haskell"
outputs
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment