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
9d23edbb
Commit
9d23edbb
authored
Oct 20, 2013
by
Andrew Gibiansky
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Switched to non-lazy IO for reading.
parent
692860f6
Changes
3
Hide whitespace changes
Inline
Side-by-side
Showing
3 changed files
with
45 additions
and
24 deletions
+45
-24
IHaskell.cabal
IHaskell.cabal
+3
-1
Evaluate.hs
IHaskell/Eval/Evaluate.hs
+39
-20
ZeroMQ.hs
IHaskell/ZeroMQ.hs
+3
-3
No files found.
IHaskell.cabal
View file @
9d23edbb
...
@@ -74,4 +74,6 @@ executable IHaskell
...
@@ -74,4 +74,6 @@ executable IHaskell
ghc-paths ==0.1.*,
ghc-paths ==0.1.*,
knob ==0.1.*,
knob ==0.1.*,
directory ==1.2.*,
directory ==1.2.*,
deepseq ==1.3.*
deepseq ==1.3.*,
random ==1.0.*,
strict ==0.3.*
IHaskell/Eval/Evaluate.hs
View file @
9d23edbb
...
@@ -8,8 +8,10 @@ module IHaskell.Eval.Evaluate (
...
@@ -8,8 +8,10 @@ module IHaskell.Eval.Evaluate (
import
ClassyPrelude
hiding
(
liftIO
,
hGetContents
)
import
ClassyPrelude
hiding
(
liftIO
,
hGetContents
)
import
Prelude
(
putChar
,
tail
,
init
)
import
Prelude
(
putChar
,
tail
,
init
)
import
Data.List.Utils
import
Data.List.Utils
import
Data.List
(
findIndex
)
import
Data.String.Utils
import
Data.String.Utils
import
Text.Printf
import
Text.Printf
import
System.Random
import
Language.Haskell.Exts.Parser
import
Language.Haskell.Exts.Parser
import
Language.Haskell.Exts.Pretty
import
Language.Haskell.Exts.Pretty
...
@@ -22,10 +24,15 @@ import GHC hiding (Stmt)
...
@@ -22,10 +24,15 @@ import GHC hiding (Stmt)
import
GHC.Paths
import
GHC.Paths
import
Exception
hiding
(
evaluate
)
import
Exception
hiding
(
evaluate
)
import
qualified
System.IO.Strict
as
StrictIO
import
IHaskell.Types
import
IHaskell.Types
debug
::
Bool
debug
=
False
write
::
GhcMonad
m
=>
String
->
m
()
write
::
GhcMonad
m
=>
String
->
m
()
write
x
=
liftIO
$
hPutStrLn
stderr
x
write
x
=
when
debug
$
liftIO
$
hPutStrLn
stderr
x
type
LineNumber
=
Int
type
LineNumber
=
Int
type
ColumnNumber
=
Int
type
ColumnNumber
=
Int
...
@@ -89,19 +96,27 @@ parseCommands code = concatMap makeCommands pieces
...
@@ -89,19 +96,27 @@ parseCommands code = concatMap makeCommands pieces
-- Pieces can be declarations, statement lists, or directives.
-- Pieces can be declarations, statement lists, or directives.
-- We distinguish declarations from statements via the first line an
-- We distinguish declarations from statements via the first line an
-- indentation, and directives based on the first character.
-- indentation, and directives based on the first character.
samePiece
x
y
=
not
(
isDirective
x
||
isDirective
y
)
&&
indentLevel
x
<=
indentLevel
y
indentLevel
(
' '
:
str
)
=
1
+
indentLevel
str
indentLevel
(
' '
:
str
)
=
1
+
indentLevel
str
indentLevel
_
=
0
::
Int
indentLevel
_
=
0
::
Int
pieces
=
groupBy
samePiece
$
lines
code
makePieces
::
[
String
]
->
[
String
]
makePieces
[]
=
[]
makePieces
(
first
:
rest
)
|
isDirective
first
=
first
:
makePieces
rest
|
otherwise
=
unlines
(
first
:
take
endOfBlock
rest
)
:
makePieces
(
drop
endOfBlock
rest
)
where
endOfBlock
=
fromMaybe
(
length
rest
)
$
findIndex
(
\
x
->
indentLevel
x
<=
indentLevel
first
)
rest
pieces
=
trace
(
show
$
makePieces
$
lines
code
)
$
makePieces
$
lines
code
makeCommands
lines
makeCommands
lines
|
any
isDirective
lines
=
map
createDirective
lines
|
isDirective
lines
=
[
createDirective
lines
]
|
any
isDeclaration
lines
=
|
isDeclaration
lines
=
case
parseDecl
$
unlines
lines
of
case
parseDecl
$
trace
(
"Decl<"
++
lines
++
"<>>>"
)
lines
of
ParseOk
declaration
->
[
Declaration
$
prettyPrint
declaration
]
ParseOk
declaration
->
[
Declaration
$
prettyPrint
declaration
]
ParseFailed
srcLoc
errMsg
->
[
ParseError
(
srcLine
srcLoc
)
(
srcColumn
srcLoc
)
errMsg
]
ParseFailed
srcLoc
errMsg
->
[
ParseError
(
srcLine
srcLoc
)
(
srcColumn
srcLoc
)
errMsg
]
|
otherwise
=
|
otherwise
=
case
parseStmts
$
trace
(
show
$
unlines
lines
)
$
unlines
lines
of
case
parseStmts
$
trace
(
"STMT<"
++
lines
++
"<s>>"
)
lines
of
Left
(
srcLine
,
srcColumn
,
errMsg
)
->
[
ParseError
srcLine
srcColumn
errMsg
]
Left
(
srcLine
,
srcColumn
,
errMsg
)
->
[
ParseError
srcLine
srcColumn
errMsg
]
Right
stmts
->
map
(
Statement
.
prettyPrint
)
$
init
stmts
Right
stmts
->
map
(
Statement
.
prettyPrint
)
$
init
stmts
isDeclaration
line
=
any
(`
isInfixOf
`
line
)
[
"type"
,
"newtype"
,
"data"
]
isDeclaration
line
=
any
(`
isInfixOf
`
line
)
[
"type"
,
"newtype"
,
"data"
]
...
@@ -127,7 +142,6 @@ evalCommand (Directive directive) = do
...
@@ -127,7 +142,6 @@ evalCommand (Directive directive) = do
evalCommand
(
Statement
stmt
)
=
do
evalCommand
(
Statement
stmt
)
=
do
write
$
"Statement: "
++
stmt
write
$
"Statement: "
++
stmt
ghandle
handler
$
do
ghandle
handler
$
do
(
printed
,
result
)
<-
capturedStatement
stmt
(
printed
,
result
)
<-
capturedStatement
stmt
case
result
of
case
result
of
RunOk
_
->
RunOk
_
->
...
@@ -156,10 +170,13 @@ evalCommand (ParseError line col err) =
...
@@ -156,10 +170,13 @@ evalCommand (ParseError line col err) =
return
[
Display
MimeHtml
$
makeError
$
printf
"Error (line %d, column %d): %s"
line
col
err
]
return
[
Display
MimeHtml
$
makeError
$
printf
"Error (line %d, column %d): %s"
line
col
err
]
capturedStatement
::
String
->
Interpreter
(
String
,
RunResult
)
capturedStatement
::
String
->
Interpreter
(
String
,
RunResult
)
capturedStatement
stmt
=
capturedStatement
stmt
=
do
let
fileVariable
=
"ridiculous"
::
String
-- Generate random variable names to use so that we cannot accidentally
fileName
=
".capture"
::
String
-- override the variables by using the right names in the terminal.
oldVariable
=
fileVariable
++
"'"
::
String
randStr
<-
liftIO
$
show
.
abs
<$>
(
randomIO
::
IO
Int
)
let
fileVariable
=
"file_var_"
++
randStr
::
String
fileName
=
".ihaskell_capture"
::
String
oldVariable
=
fileVariable
++
"_old"
::
String
initStmts
::
[
String
]
initStmts
::
[
String
]
initStmts
=
[
initStmts
=
[
printf
"%s <- openFile
\"
%s
\"
WriteMode"
fileVariable
fileName
,
printf
"%s <- openFile
\"
%s
\"
WriteMode"
fileVariable
fileName
,
...
@@ -167,19 +184,21 @@ capturedStatement stmt =
...
@@ -167,19 +184,21 @@ capturedStatement stmt =
printf
"hDuplicateTo %s stdout"
fileVariable
]
printf
"hDuplicateTo %s stdout"
fileVariable
]
postStmts
::
[
String
]
postStmts
::
[
String
]
postStmts
=
[
postStmts
=
[
"hFlush stdout"
,
"hFlush stdout"
,
printf
"hDuplicateTo %s stdout"
oldVariable
,
printf
"hDuplicateTo %s stdout"
oldVariable
,
printf
"hClose %s"
fileVariable
]
printf
"hClose %s"
fileVariable
]
goStmt
s
=
runStmt
s
RunToCompletion
in
do
goStmt
s
=
runStmt
s
RunToCompletion
forM_
initStmts
goStmt
forM_
initStmts
goStmt
result
<-
goStmt
stmt
result
<-
goStmt
stmt
forM_
postStmts
goStmt
forM_
postStmts
goStmt
printedOutput
<-
liftIO
$
readFile
$
fpFromString
fileName
-- We must use strict IO, because we write to that file again if we
liftIO
$
print
printedOutput
-- execute more statements. If we read lazily, we may cause errors when
-- trying to open the file for writing later.
printedOutput
<-
liftIO
$
StrictIO
.
readFile
fileName
return
(
printedOutput
,
result
)
return
(
printedOutput
,
result
)
parseStmts
::
String
->
Either
(
LineNumber
,
ColumnNumber
,
String
)
[
Stmt
]
parseStmts
::
String
->
Either
(
LineNumber
,
ColumnNumber
,
String
)
[
Stmt
]
parseStmts
code
=
parseStmts
code
=
...
...
IHaskell/ZeroMQ.hs
View file @
9d23edbb
-- | The "ZeroMQ" module abstracts away the low-level 0MQ based interface with IPython,
-- | The "ZeroMQ" module abstracts away the low-level 0MQ based interface with IPython,
--
|
replacing it instead with a Haskell Channel based interface. The `serveProfile` function
-- replacing it instead with a Haskell Channel based interface. The `serveProfile` function
--
|
takes a IPython profile specification and returns the channel interface to use.
-- takes a IPython profile specification and returns the channel interface to use.
module
IHaskell.ZeroMQ
(
module
IHaskell.ZeroMQ
(
ZeroMQInterface
(
..
),
ZeroMQInterface
(
..
),
serveProfile
serveProfile
...
@@ -17,7 +17,7 @@ import IHaskell.Types
...
@@ -17,7 +17,7 @@ import IHaskell.Types
import
IHaskell.Message.Parser
import
IHaskell.Message.Parser
import
IHaskell.Message.Writer
import
IHaskell.Message.Writer
-- The channel interface to the ZeroMQ sockets. All communication is done via
--
|
The channel interface to the ZeroMQ sockets. All communication is done via
-- Messages, which are encoded and decoded into a lower level form before being
-- Messages, which are encoded and decoded into a lower level form before being
-- transmitted to IPython. These channels should functionally serve as
-- transmitted to IPython. These channels should functionally serve as
-- high-level sockets which speak Messages instead of ByteStrings.
-- high-level sockets which speak Messages instead of ByteStrings.
...
...
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