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
17582024
Commit
17582024
authored
May 29, 2015
by
Andrew Gibiansky
Browse files
Options
Browse Files
Download
Plain Diff
Merge pull request #506 from gibiansky/limit-dependencies
Get rid of system-filepath
parents
e75e4463
0996bef8
Changes
4
Hide whitespace changes
Inline
Side-by-side
Showing
4 changed files
with
63 additions
and
61 deletions
+63
-61
Hspec.hs
Hspec.hs
+33
-33
ihaskell.cabal
ihaskell.cabal
+0
-2
Evaluate.hs
src/IHaskell/Eval/Evaluate.hs
+1
-2
IPython.hs
src/IHaskell/IPython.hs
+29
-24
No files found.
Hspec.hs
View file @
17582024
{-# LANGUAGE QuasiQuotes, OverloadedStrings, ExtendedDefaultRules, CPP #-}
-- Keep all the language pragmas here so it can be compiled separately.
module
Main
where
import
Prelude
import
GHC
hiding
(
Qualified
)
import
GHC.Paths
import
Data.IORef
import
Control.Monad
import
Control.Monad.IO.Class
(
MonadIO
,
liftIO
)
import
Data.List
import
System.Directory
import
Shelly
(
Sh
,
shelly
,
cmd
,
(
</>
),
toTextIgnore
,
cd
,
withTmpDir
,
mkdir_p
,
touchfile
)
import
Prelude
import
GHC
hiding
(
Qualified
)
import
GHC.Paths
import
Data.IORef
import
Control.Monad
import
Control.Monad.IO.Class
(
MonadIO
,
liftIO
)
import
Data.List
import
System.Directory
import
Shelly
(
Sh
,
shelly
,
cmd
,
(
</>
),
toTextIgnore
,
cd
,
withTmpDir
,
mkdir_p
,
touchfile
,
fromText
)
import
qualified
Data.Text
as
T
import
qualified
Shelly
import
Control.Applicative
((
<$>
))
import
Filesystem.Path.CurrentOS
(
encodeString
)
import
System.SetEnv
(
setEnv
)
import
Data.String.Here
import
Data.String.Utils
(
strip
,
replace
)
import
Data.Monoid
import
IHaskell.Eval.Parser
import
IHaskell.Types
import
IHaskell.IPython
import
IHaskell.Eval.Evaluate
as
Eval
hiding
(
liftIO
)
import
Control.Applicative
((
<$>
))
import
System.SetEnv
(
setEnv
)
import
Data.String.Here
import
Data.String.Utils
(
strip
,
replace
)
import
Data.Monoid
import
IHaskell.Eval.Parser
import
IHaskell.Types
import
IHaskell.IPython
import
IHaskell.Eval.Evaluate
as
Eval
hiding
(
liftIO
)
import
qualified
IHaskell.Eval.Evaluate
as
Eval
(
liftIO
)
import
IHaskell.Eval.Completion
import
IHaskell.Eval.ParseShell
import
IHaskell.Eval.Completion
import
IHaskell.Eval.ParseShell
import
Debug.Trace
import
Debug.Trace
import
Test.Hspec
import
Test.Hspec.HUnit
import
Test.HUnit
(
assertBool
,
assertFailure
)
import
Test.Hspec
import
Test.Hspec.HUnit
import
Test.HUnit
(
assertBool
,
assertFailure
)
traceShowId
x
=
traceShow
x
x
...
...
@@ -166,7 +166,7 @@ inDirectory dirs files action = shelly $ withTmpDir $ \dirPath ->
do
cd
dirPath
mapM_
mkdir_p
dirs
mapM_
touchfile
files
liftIO
$
doGhc
$
wrap
(
encodeString
dirPath
)
(
action
dirPath
)
liftIO
$
doGhc
$
wrap
(
T
.
unpack
$
toTextIgnore
dirPath
)
(
action
dirPath
)
where
cdEvent
path
=
liftIO
$
setCurrentDirectory
path
--Eval.evaluate defaultKernelState (":! cd " ++ path) noPublish
wrap
::
FilePath
->
Interpreter
a
->
Interpreter
a
wrap
path
action
=
...
...
@@ -241,8 +241,8 @@ completionTests = do
"import Prel*"
`
completionHas
`
[
"Prelude"
]
it
"properly completes haskell file paths on :load directive"
$
let
loading
xs
=
":load "
++
encodeString
xs
paths
=
map
encodeString
let
loading
xs
=
":load "
++
T
.
unpack
(
toTextIgnore
xs
)
paths
=
map
(
T
.
unpack
.
toTextIgnore
)
in
do
loading
(
"dir"
</>
"file*"
)
`
shouldHaveCompletionsInDirectory
`
paths
[
"dir"
</>
"file2.hs"
,
"dir"
</>
"file2.lhs"
]
...
...
@@ -258,7 +258,7 @@ completionTests = do
,
"./"
</>
"file1.lhs"
]
it
"provides path completions on empty shell cmds "
$
":! cd *"
`
shouldHaveCompletionsInDirectory
`
map
encodeString
[
""
</>
"dir/"
":! cd *"
`
shouldHaveCompletionsInDirectory
`
map
(
T
.
unpack
.
toTextIgnore
)
[
""
</>
"dir/"
,
""
</>
"file1.hs"
,
""
</>
"file1.lhs"
]
...
...
@@ -268,7 +268,7 @@ completionTests = do
result
<-
action
setHomeEvent
$
Shelly
.
fromText
home
return
result
setHomeEvent
path
=
liftIO
$
setEnv
"HOME"
(
encodeString
path
)
setHomeEvent
path
=
liftIO
$
setEnv
"HOME"
(
T
.
unpack
$
toTextIgnore
path
)
it
"correctly interprets ~ as the environment HOME variable"
$
let
shouldHaveCompletions
::
String
->
[
String
]
->
IO
()
...
...
@@ -289,7 +289,7 @@ completionTests = do
matchText
<-
withHsHome
$
fst
<$>
uncurry
complete
(
readCompletePrompt
string
)
matchText
`
shouldBe
`
expected
setHomeEvent
path
=
liftIO
$
setEnv
"HOME"
(
encodeString
path
)
setHomeEvent
path
=
liftIO
$
setEnv
"HOME"
(
T
.
unpack
$
toTextIgnore
path
)
it
"generates the correct matchingText on `:! cd ~/*` "
$
do
":! cd ~/*"
`
shouldHaveMatchingText
`
(
"~/"
::
String
)
...
...
ihaskell.cabal
View file @
17582024
...
...
@@ -83,7 +83,6 @@ library
stm -any,
strict >=0.3,
system-argv0 -any,
system-filepath -any,
text >=0.11,
transformers -any,
unix >= 2.6,
...
...
@@ -193,7 +192,6 @@ Test-Suite hspec
stm -any,
strict >=0.3,
system-argv0 -any,
system-filepath -any,
text >=0.11,
http-client == 0.4.*,
http-client-tls == 0.2.*,
...
...
src/IHaskell/Eval/Evaluate.hs
View file @
17582024
{-# LANGUAGE No
ImplicitPrelude, DoAndIfThenElse, No
OverloadedStrings, TypeSynonymInstances, GADTs, CPP #-}
{-# LANGUAGE NoOverloadedStrings, TypeSynonymInstances, GADTs, CPP #-}
{- | Description : Wrapper around GHC API, exposing a single `evaluate` interface that runs
a statement, declaration, import, or directive.
...
...
@@ -33,7 +33,6 @@ import Data.Dynamic
import
Data.Typeable
import
qualified
Data.Serialize
as
Serialize
import
System.Directory
import
Filesystem.Path.CurrentOS
(
encodeString
)
#
if
!
MIN_VERSION_base
(
4
,
8
,
0
)
import
System.Posix.IO
(
createPipe
)
#
endif
...
...
src/IHaskell/IPython.hs
View file @
17582024
{-# LANGUAGE NoImplicitPrelude, OverloadedStrings #-}
{-# LANGUAGE DoAndIfThenElse #-}
{-# LANGUAGE CPP #-}
-- | Description : Shell scripting wrapper using @Shelly@ for the @notebook@, and
-- @console@ commands.
...
...
@@ -23,10 +22,10 @@ import qualified Data.ByteString.Char8 as CBS
import
Control.Concurrent
(
threadDelay
)
import
System.Argv0
import
System.Directory
import
qualified
Shelly
as
SH
import
qualified
Filesystem.Path.CurrentOS
as
FS
import
qualified
System.IO
as
IO
import
qualified
System.FilePath
as
FP
import
System.Directory
import
Data.List.Utils
(
split
)
import
Data.String.Utils
(
rstrip
,
endswith
,
strip
,
replace
)
import
System.Exit
(
exitFailure
)
...
...
@@ -88,11 +87,11 @@ quietRun path args = SH.runHandles path args handles nothing
handles
=
[
SH
.
InHandle
SH
.
Inherit
,
SH
.
OutHandle
SH
.
CreatePipe
,
SH
.
ErrorHandle
SH
.
CreatePipe
]
nothing
_
_
_
=
return
()
fp
::
FS
.
FilePath
->
FilePath
fp
::
SH
.
FilePath
->
FilePath
fp
=
T
.
unpack
.
SH
.
toTextIgnore
-- | Create the directory and return it.
ensure
::
SH
.
Sh
FS
.
FilePath
->
SH
.
Sh
FS
.
FilePath
ensure
::
SH
.
Sh
SH
.
FilePath
->
SH
.
Sh
SH
.
FilePath
ensure
getDir
=
do
dir
<-
getDir
SH
.
mkdir_p
dir
...
...
@@ -101,13 +100,13 @@ ensure getDir = do
-- | Return the data directory for IHaskell.
ihaskellDir
::
SH
.
Sh
FilePath
ihaskellDir
=
do
home
<-
maybe
(
error
"$HOME not defined."
)
FS
.
fromText
<$>
SH
.
get_env
"HOME"
home
<-
maybe
(
error
"$HOME not defined."
)
SH
.
fromText
<$>
SH
.
get_env
"HOME"
fp
<$>
ensure
(
return
(
home
SH
.</>
".ihaskell"
))
ipythonDir
::
SH
.
Sh
FS
.
FilePath
ipythonDir
::
SH
.
Sh
SH
.
FilePath
ipythonDir
=
ensure
$
(
SH
.</>
"ipython"
)
<$>
ihaskellDir
notebookDir
::
SH
.
Sh
FS
.
FilePath
notebookDir
::
SH
.
Sh
SH
.
FilePath
notebookDir
=
ensure
$
(
SH
.</>
"notebooks"
)
<$>
ihaskellDir
getIHaskellDir
::
IO
String
...
...
@@ -180,7 +179,7 @@ installKernelspec replace opts = void $ do
let
files
=
[
"kernel.js"
,
"logo-64x64.png"
]
forM_
files
$
\
file
->
do
src
<-
liftIO
$
Paths
.
getDataFileName
$
"html/"
++
file
SH
.
cp
(
FS
.
fromText
$
T
.
pack
src
)
(
tmp
SH
.</>
kernelName
SH
.</>
file
)
SH
.
cp
(
SH
.
fromText
$
T
.
pack
src
)
(
tmp
SH
.</>
kernelName
SH
.</>
file
)
Just
ipython
<-
SH
.
which
"ipython"
let
replaceFlag
=
[
"--replace"
|
replace
]
...
...
@@ -202,9 +201,9 @@ subHome path = SH.shelly $ do
-- | Get the path to an executable. If it doensn't exist, fail with an error message complaining
-- about it.
path
::
Text
->
SH
.
Sh
FS
.
FilePath
path
::
Text
->
SH
.
Sh
SH
.
FilePath
path
exe
=
do
path
<-
SH
.
which
$
FS
.
fromText
exe
path
<-
SH
.
which
$
SH
.
fromText
exe
case
path
of
Nothing
->
do
liftIO
$
putStrLn
$
"Could not find `"
++
T
.
unpack
exe
++
"` executable."
...
...
@@ -221,28 +220,34 @@ parseVersion versionStr =
else
Nothing
-- | Get the absolute path to this IHaskell executable.
getIHaskellPath
::
SH
.
Sh
String
getIHaskellPath
::
SH
.
Sh
FilePath
getIHaskellPath
=
do
-- Get the absolute filepath to the argument.
f
<-
liftIO
getArgv0
f
<-
T
.
unpack
<$>
SH
.
toTextIgnore
<$>
liftIO
getArgv0
-- If we have an absolute path, that's the IHaskell we're interested in.
if
F
S
.
a
bsolute
f
then
return
$
FS
.
encodeString
f
if
F
P
.
isA
bsolute
f
then
return
f
else
-- Check whether this is a relative path, or just 'IHaskell' with $PATH resolution done by
-- the shell. If it's just 'IHaskell', use the $PATH variable to find where IHaskell lives.
if
F
S
.
filen
ame
f
==
f
if
F
P
.
takeFileN
ame
f
==
f
then
do
ihaskellPath
<-
SH
.
which
"ihaskell"
case
ihaskellPath
of
Nothing
->
error
"ihaskell not on $PATH and not referenced relative to directory."
Just
path
->
return
$
FS
.
encodeString
path
else
do
-- If it's actually a relative path, make it absolute.
cd
<-
liftIO
getCurrentDirectory
return
$
FS
.
encodeString
$
FS
.
decodeString
cd
SH
.</>
f
Just
path
->
return
$
T
.
unpack
$
SH
.
toTextIgnore
path
else
liftIO
$
makeAbsolute
f
#
if
!
MIN_VERSION_directory
(
1
,
2
,
2
)
-- This is included in later versions of `directory`, but we cannot use later versions because GHC
-- library depends on a particular version of it.
makeAbsolute
::
FilePath
->
IO
FilePath
makeAbsolute
=
fmap
FP
.
normalise
.
absolutize
where
absolutize
path
-- avoid the call to `getCurrentDirectory` if we can
|
FP
.
isRelative
path
=
fmap
(
FP
.</>
path
)
getCurrentDirectory
|
otherwise
=
return
path
#
endif
getSandboxPackageConf
::
IO
(
Maybe
String
)
getSandboxPackageConf
=
SH
.
shelly
$
do
myPath
<-
getIHaskellPath
...
...
@@ -252,7 +257,7 @@ getSandboxPackageConf = SH.shelly $ do
else
do
let
pieces
=
split
"/"
myPath
sandboxDir
=
intercalate
"/"
$
takeWhile
(
/=
sandboxName
)
pieces
++
[
sandboxName
]
subdirs
<-
map
fp
<$>
SH
.
ls
(
FS
.
fromText
$
T
.
pack
sandboxDir
)
subdirs
<-
map
fp
<$>
SH
.
ls
(
SH
.
fromText
$
T
.
pack
sandboxDir
)
let
confdirs
=
filter
(
endswith
(
"packages.conf.d"
::
String
))
subdirs
case
confdirs
of
[]
->
return
Nothing
...
...
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