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
1de89fb4
Commit
1de89fb4
authored
Jan 06, 2014
by
Eyal Dechter
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Added general path completion using haskeline.
parent
d01ab001
Changes
1
Hide whitespace changes
Inline
Side-by-side
Showing
1 changed file
with
48 additions
and
45 deletions
+48
-45
Completion.hs
src/IHaskell/Eval/Completion.hs
+48
-45
No files found.
src/IHaskell/Eval/Completion.hs
View file @
1de89fb4
...
@@ -33,19 +33,24 @@ import System.FilePath
...
@@ -33,19 +33,24 @@ import System.FilePath
import
MonadUtils
(
MonadIO
)
import
MonadUtils
(
MonadIO
)
import
Control.Monad
(
filterM
,
mapM
,
liftM
)
import
Control.Monad
(
filterM
,
mapM
,
liftM
)
import
System.Console.Haskeline.Completion
import
qualified
Control.Monad.IO.Class
as
MonadIO
(
MonadIO
()
,
liftIO
)
import
IHaskell.Types
import
IHaskell.Types
import
IHaskell.Eval.Evaluate
(
Interpreter
)
data
CompletionType
data
CompletionType
=
Empty
=
Empty
|
Identifier
String
|
Identifier
String
|
Extension
String
|
Extension
String
|
Qualified
String
String
|
Qualified
String
String
|
ModuleName
String
String
|
ModuleName
String
String
|
HsFilePath
String
|
HsFilePath
String
|
FilePath
String
deriving
(
Show
,
Eq
)
deriving
(
Show
,
Eq
)
complete
::
GHC
.
GhcMonad
m
=>
String
->
Int
->
m
(
String
,
[
String
])
complete
::
String
->
Int
->
Interpreter
(
String
,
[
String
])
complete
line
pos
=
do
complete
line
pos
=
do
flags
<-
getSessionDynFlags
flags
<-
getSessionDynFlags
rdrNames
<-
map
(
showPpr
flags
)
<$>
getRdrNamesInScope
rdrNames
<-
map
(
showPpr
flags
)
<$>
getRdrNamesInScope
...
@@ -61,7 +66,7 @@ complete line pos = do
...
@@ -61,7 +66,7 @@ complete line pos = do
let
target
=
completionTarget
line
pos
let
target
=
completionTarget
line
pos
matchedText
=
intercalate
"."
target
matchedText
=
intercalate
"."
target
options
<-
options
<-
case
completionType
line
target
of
case
completionType
line
target
of
Empty
->
return
[]
Empty
->
return
[]
...
@@ -87,12 +92,13 @@ complete line pos = do
...
@@ -87,12 +92,13 @@ complete line pos = do
nonames
=
map
(
"No"
++
)
names
nonames
=
map
(
"No"
++
)
names
return
$
filter
(
ext
`
isPrefixOf
`)
$
names
++
nonames
return
$
filter
(
ext
`
isPrefixOf
`)
$
names
++
nonames
HsFilePath
path
->
do
pwd
<-
liftIO
getCurrentDirectory
HsFilePath
path
->
completePathWithExtensions
[
".hs"
,
".lhs"
]
path
completePath
pwd
(
Just
[
".hs"
,
".lhs"
])
path
FilePath
path
->
completePath
path
return
(
matchedText
,
options
)
return
(
matchedText
,
options
)
getTrueModuleName
::
GhcMonad
m
=>
String
->
m
String
getTrueModuleName
::
String
->
Interpreter
String
getTrueModuleName
name
=
do
getTrueModuleName
name
=
do
-- Only use the things that were actually imported
-- Only use the things that were actually imported
let
onlyImportDecl
(
IIDecl
decl
)
=
Just
decl
let
onlyImportDecl
(
IIDecl
decl
)
=
Just
decl
...
@@ -107,20 +113,22 @@ getTrueModuleName name = do
...
@@ -107,20 +113,22 @@ getTrueModuleName name = do
let
qualifiedImports
=
filter
(
isJust
.
ideclAs
)
imports
let
qualifiedImports
=
filter
(
isJust
.
ideclAs
)
imports
hasName
imp
=
name
==
(
showPpr
flags
.
fromJust
.
ideclAs
)
imp
hasName
imp
=
name
==
(
showPpr
flags
.
fromJust
.
ideclAs
)
imp
case
find
hasName
qualifiedImports
of
case
find
hasName
qualifiedImports
of
Nothing
->
return
name
Nothing
->
return
name
Just
trueImp
->
return
$
showPpr
flags
$
unLoc
$
ideclName
trueImp
Just
trueImp
->
return
$
showPpr
flags
$
unLoc
$
ideclName
trueImp
completionType
::
String
->
[
String
]
->
CompletionType
completionType
::
String
->
[
String
]
->
CompletionType
completionType
line
[]
=
Empty
completionType
line
[]
=
Empty
completionType
line
target
completionType
line
target
|
startswith
":l"
stripped
|
startswith
":! "
stripped
=
HsFilePath
$
last
$
splitOn
" "
stripped
=
FilePath
complete_target
|
startswith
":l"
stripped
=
HsFilePath
complete_target
|
startswith
"import"
stripped
&&
isModName
|
startswith
"import"
stripped
&&
isModName
=
ModuleName
dotted
candidate
=
ModuleName
dotted
candidate
|
isModName
&&
(
not
.
null
.
init
)
target
|
isModName
&&
(
not
.
null
.
init
)
target
=
Qualified
dotted
candidate
=
Qualified
dotted
candidate
|
startswith
":e"
stripped
|
startswith
":e"
stripped
=
Extension
candidate
=
Extension
candidate
|
otherwise
|
otherwise
=
Identifier
candidate
=
Identifier
candidate
where
stripped
=
strip
line
where
stripped
=
strip
line
...
@@ -129,13 +137,14 @@ completionType line target
...
@@ -129,13 +137,14 @@ completionType line target
dots
=
intercalate
"."
.
init
dots
=
intercalate
"."
.
init
isModName
=
all
isCapitalized
(
init
target
)
isModName
=
all
isCapitalized
(
init
target
)
isCapitalized
=
isUpper
.
head
isCapitalized
=
isUpper
.
head
complete_target
=
intercalate
"."
target
-- | Get the word under a given cursor location.
-- | Get the word under a given cursor location.
completionTarget
::
String
->
Int
->
[
String
]
completionTarget
::
String
->
Int
->
[
String
]
completionTarget
code
cursor
=
expandCompletionPiece
pieceToComplete
completionTarget
code
cursor
=
expandCompletionPiece
pieceToComplete
where
where
pieceToComplete
=
map
fst
<$>
find
(
elem
cursor
.
map
snd
)
pieces
pieceToComplete
=
map
fst
<$>
find
(
elem
cursor
.
map
snd
)
pieces
pieces
=
splitAlongCursor
$
split
splitter
$
zip
code
[
1
..
]
pieces
=
splitAlongCursor
$
split
splitter
$
zip
code
[
1
..
]
splitter
=
defaultSplitter
{
splitter
=
defaultSplitter
{
...
@@ -151,7 +160,7 @@ completionTarget code cursor = expandCompletionPiece pieceToComplete
...
@@ -151,7 +160,7 @@ completionTarget code cursor = expandCompletionPiece pieceToComplete
splitAlongCursor
::
[[(
Char
,
Int
)]]
->
[[(
Char
,
Int
)]]
splitAlongCursor
::
[[(
Char
,
Int
)]]
->
[[(
Char
,
Int
)]]
splitAlongCursor
[]
=
[]
splitAlongCursor
[]
=
[]
splitAlongCursor
(
x
:
xs
)
=
splitAlongCursor
(
x
:
xs
)
=
case
elemIndex
cursor
$
map
snd
x
of
case
elemIndex
cursor
$
map
snd
x
of
Nothing
->
x
:
splitAlongCursor
xs
Nothing
->
x
:
splitAlongCursor
xs
Just
idx
->
take
(
idx
+
1
)
x
:
drop
(
idx
+
1
)
x
:
splitAlongCursor
xs
Just
idx
->
take
(
idx
+
1
)
x
:
drop
(
idx
+
1
)
x
:
splitAlongCursor
xs
...
@@ -160,34 +169,28 @@ completionTarget code cursor = expandCompletionPiece pieceToComplete
...
@@ -160,34 +169,28 @@ completionTarget code cursor = expandCompletionPiece pieceToComplete
neverIdent
=
"
\n\t
(),{}[]
\\
'
\"
`"
neverIdent
=
"
\n\t
(),{}[]
\\
'
\"
`"
expandCompletionPiece
Nothing
=
[]
expandCompletionPiece
Nothing
=
[]
expandCompletionPiece
(
Just
str
)
=
splitOn
"."
str
expandCompletionPiece
(
Just
str
)
=
splitOn
"."
str
completePath
::
MonadIO
m
=>
completePathFilter
::
(
String
->
Bool
)
-- ^ filter files
String
-- ^ Current directory
->
(
String
->
Bool
)
-- ^ filter directories
->
Maybe
[
String
]
-- ^ list of file extensions
->
String
-- ^ line contents left of cursor
->
String
-- ^ prefix to be completed
->
String
-- ^ line contents right of cursor
->
m
[
String
]
-- ^ completions, that is, if prefix is "Mai" one completion might be "Main.hs"
->
Interpreter
[
String
]
completePath
currDir
exts
prefix
completePathFilter
fileFilter
dirFilter
loc
roc
=
=
let
absolutePrefix
=
combine
currDir
prefix
do
(
_
,
comps
)
<-
MonadIO
.
liftIO
$
(
completeFilename
(
reverse
loc
,
roc
))
searchDir
=
dropFileName
absolutePrefix
let
completions
=
map
replacement
comps
pattern
=
absolutePrefix
++
"*"
dirs
<-
liftIO
$
filterM
doesDirectoryExist
completions
completions
=
liftIO
$
Find
.
find
always
(
filePath
~~?
pattern
)
searchDir
files
<-
liftIO
$
filterM
(
liftM
not
.
doesDirectoryExist
)
completions
allFileCompletions
=
completions
>>=
liftIO
.
filterM
(
liftM
not
.
doesDirectoryExist
)
let
dirs'
=
filter
dirFilter
files
fileCompletions
=
case
exts
of
files'
=
filter
fileFilter
dirs
Nothing
->
allFileCompletions
return
$
filter
(
\
x
->
elem
x
$
dirs'
++
files'
)
completions
Just
exts
->
do
xs
<-
allFileCompletions
return
$
filter
(
\
s
->
or
[
endswith
ext
s
|
ext
<-
exts
])
xs
completePath
::
String
->
Interpreter
[
String
]
dirCompletions
=
completions
completePath
loc
=
completePathFilter
(
const
True
)
(
const
True
)
loc
""
>>=
liftIO
.
filterM
doesDirectoryExist
>>=
\
xs
->
do
return
$
[
x
++
[
pathSeparator
]
|
x
<-
xs
]
completePathWithExtensions
::
[
String
]
->
String
->
Interpreter
[
String
]
relativeCompletions
=
do
validSearchDir
<-
liftIO
$
doesDirectoryExist
searchDir
completePathWithExtensions
extensions
loc
=
if
validSearchDir
then
completePathFilter
(
\
s
->
any
(
\
x
->
endswith
x
s
)
extensions
)
(
const
True
)
loc
""
do
xs
<-
fileCompletions
ys
<-
dirCompletions
return
$
map
(
cut
$
currDir
++
[
pathSeparator
])
$
xs
++
ys
else
return
[]
cut
::
String
->
String
->
String
cut
(
x
:
xs
)
z
@
(
y
:
ys
)
|
x
==
y
=
cut
xs
ys
|
otherwise
=
z
cut
_
z
=
z
in
relativeCompletions
\ No newline at end of file
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