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
67e98e69
Commit
67e98e69
authored
Nov 29, 2013
by
Andrew Gibiansky
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Adding parser... Modified code from @avogt
parent
c0d97abb
Changes
4
Expand all
Hide whitespace changes
Inline
Side-by-side
Showing
4 changed files
with
392 additions
and
8 deletions
+392
-8
IHaskell.cabal
IHaskell.cabal
+3
-1
Display.hs
IHaskell/Display.hs
+12
-0
Evaluate.hs
IHaskell/Eval/Evaluate.hs
+31
-7
Parser.hs
IHaskell/Eval/Parser.hs
+346
-0
No files found.
IHaskell.cabal
View file @
67e98e69
...
@@ -82,6 +82,7 @@ executable IHaskell
...
@@ -82,6 +82,7 @@ executable IHaskell
IHaskell.Eval.Completion
IHaskell.Eval.Completion
IHaskell.Eval.Info
IHaskell.Eval.Info
IHaskell.Eval.Evaluate
IHaskell.Eval.Evaluate
IHaskell.Eval.Parser
IHaskell.IPython
IHaskell.IPython
IHaskell.Message.Parser
IHaskell.Message.Parser
IHaskell.Message.UUID
IHaskell.Message.UUID
...
@@ -118,7 +119,8 @@ executable IHaskell
...
@@ -118,7 +119,8 @@ executable IHaskell
directory,
directory,
here,
here,
system-filepath,
system-filepath,
text ==0.11.*
text ==0.11.*,
mtl == 2.1.*
Test-Suite doctests
Test-Suite doctests
Type: exitcode-stdio-1.0
Type: exitcode-stdio-1.0
...
...
IHaskell/Display.hs
0 → 100644
View file @
67e98e69
{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}
module
IHaskell.Display
(
IHaskellDisplay
(
..
),
MimeType
(
..
),
DisplayData
(
..
),
)
where
import
IHaskell.Types
-- | A class for displayable Haskell types.
class
IHaskellDisplay
a
where
display
::
a
->
[
DisplayData
]
IHaskell/Eval/Evaluate.hs
View file @
67e98e69
...
@@ -11,11 +11,12 @@ module IHaskell.Eval.Evaluate (
...
@@ -11,11 +11,12 @@ module IHaskell.Eval.Evaluate (
)
where
)
where
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.List
(
findIndex
)
import
Data.String.Utils
import
Data.String.Utils
import
Text.Printf
import
Text.Printf
import
Data.Char
as
Char
import
Language.Haskell.Exts.Parser
hiding
(
parseType
)
import
Language.Haskell.Exts.Parser
hiding
(
parseType
)
import
Language.Haskell.Exts.Pretty
import
Language.Haskell.Exts.Pretty
...
@@ -27,8 +28,10 @@ import GhcMonad (liftIO)
...
@@ -27,8 +28,10 @@ import GhcMonad (liftIO)
import
GHC
hiding
(
Stmt
,
TypeSig
)
import
GHC
hiding
(
Stmt
,
TypeSig
)
import
GHC.Paths
import
GHC.Paths
import
Exception
hiding
(
evaluate
)
import
Exception
hiding
(
evaluate
)
import
Outputable
import
Outputable
import
Packages
import
Module
import
qualified
System.IO.Strict
as
StrictIO
import
qualified
System.IO.Strict
as
StrictIO
import
IHaskell.Types
import
IHaskell.Types
...
@@ -36,7 +39,7 @@ import IHaskell.Types
...
@@ -36,7 +39,7 @@ import IHaskell.Types
data
ErrorOccurred
=
Success
|
Failure
data
ErrorOccurred
=
Success
|
Failure
debug
::
Bool
debug
::
Bool
debug
=
Fals
e
debug
=
Tru
e
ignoreTypePrefixes
::
[
String
]
ignoreTypePrefixes
::
[
String
]
ignoreTypePrefixes
=
[
"GHC.Types"
,
"GHC.Base"
,
"GHC.Show"
,
"System.IO"
,
ignoreTypePrefixes
=
[
"GHC.Types"
,
"GHC.Base"
,
"GHC.Show"
,
"System.IO"
,
...
@@ -110,14 +113,35 @@ interpret action = runGhc (Just libdir) $ do
...
@@ -110,14 +113,35 @@ interpret action = runGhc (Just libdir) $ do
dflags
<-
getSessionDynFlags
dflags
<-
getSessionDynFlags
void
$
setSessionDynFlags
$
dflags
{
hscTarget
=
HscInterpreted
,
ghcLink
=
LinkInMemory
}
void
$
setSessionDynFlags
$
dflags
{
hscTarget
=
HscInterpreted
,
ghcLink
=
LinkInMemory
}
-- Load packages that start with ihaskell-* and aren't just IHaskell.
displayPackages
<-
liftIO
$
do
(
dflags
,
_
)
<-
initPackages
dflags
let
Just
db
=
pkgDatabase
dflags
packageNames
=
map
(
packageIdString
.
packageConfigId
)
db
initStr
=
"ihaskell-"
ihaskellPkgs
=
filter
(
startswith
initStr
)
packageNames
displayPkgs
=
filter
(
isAlpha
.
(
!!
(
length
initStr
+
1
)))
ihaskellPkgs
return
displayPkgs
-- Generate import statements all Display modules.
let
capitalize
::
String
->
String
capitalize
(
first
:
rest
)
=
Char
.
toUpper
first
:
rest
importFmt
=
"import IHaskell.Display.%s"
toImportStmt
::
String
->
String
toImportStmt
=
printf
importFmt
.
capitalize
.
(
!!
1
)
.
split
"-"
displayImports
=
map
toImportStmt
displayPackages
-- Import modules.
-- Import modules.
imports
<-
mapM
parseImportDecl
global
Imports
imports
<-
mapM
parseImportDecl
$
globalImports
++
display
Imports
setContext
$
map
IIDecl
imports
setContext
$
map
IIDecl
imports
-- Give a value for `it`. This is required due to the way we handle `it`
-- Give a value for `it`. This is required due to the way we handle `it`
-- in the wrapper statements - if it doesn't exist, the first statement
-- in the wrapper statements - if it doesn't exist, the first statement
-- will fail.
-- will fail.
runStmt
"
()
"
RunToCompletion
runStmt
"
putStrLn
\"\"
"
RunToCompletion
-- Run the rest of the interpreter
-- Run the rest of the interpreter
action
action
...
@@ -148,7 +172,7 @@ joinDisplays displays =
...
@@ -148,7 +172,7 @@ joinDisplays displays =
plains
=
filter
isPlain
displays
plains
=
filter
isPlain
displays
other
=
filter
(
not
.
isPlain
)
displays
other
=
filter
(
not
.
isPlain
)
displays
getText
(
Display
PlainText
text
)
=
text
getText
(
Display
PlainText
text
)
=
text
joinedPlains
=
Display
PlainText
$
concat
$
m
ap
getText
plains
in
joinedPlains
=
Display
PlainText
$
concat
M
ap
getText
plains
in
case
length
plains
of
case
length
plains
of
0
->
other
0
->
other
_
->
joinedPlains
:
other
_
->
joinedPlains
:
other
...
@@ -192,7 +216,7 @@ parseCommands code = joinMultilineDeclarations $ concatMap makeCommands pieces
...
@@ -192,7 +216,7 @@ parseCommands code = joinMultilineDeclarations $ concatMap makeCommands pieces
makeCommands
str
makeCommands
str
|
isDirective
str
=
[
createDirective
str
]
|
isDirective
str
=
[
createDirective
str
]
|
isImport
str
=
[
Import
$
strip
str
]
|
isImport
str
=
[
Import
$
strip
str
]
|
length
rest
>
0
&&
isTypeDeclaration
first
=
|
not
(
null
rest
)
&&
isTypeDeclaration
first
=
let
(
firstStmt
:
restStmts
)
=
makeCommands
$
unlines
rest
in
let
(
firstStmt
:
restStmts
)
=
makeCommands
$
unlines
rest
in
case
firstStmt
of
case
firstStmt
of
Declaration
decl
->
Declaration
(
first
++
decl
)
:
restStmts
Declaration
decl
->
Declaration
(
first
++
decl
)
:
restStmts
...
...
IHaskell/Eval/Parser.hs
0 → 100644
View file @
67e98e69
This diff is collapsed.
Click to expand it.
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