Skip to content
This repository was archived by the owner on Oct 7, 2020. It is now read-only.

Commit efa7504

Browse files
fendorfendor
committed
First draft for add to import list
1 parent 51b912b commit efa7504

File tree

1 file changed

+0
-218
lines changed

1 file changed

+0
-218
lines changed

‎src/Haskell/Ide/Engine/Plugin/HsImport.hs

Lines changed: 0 additions & 218 deletions
Original file line numberDiff line numberDiff line change
@@ -1,218 +0,0 @@
1-
{-# LANGUAGE OverloadedStrings #-}
2-
{-# LANGUAGE NoMonomorphismRestriction #-}
3-
{-# LANGUAGE DeriveGeneric #-}
4-
{-# LANGUAGE DeriveAnyClass #-}
5-
{-# LANGUAGE TupleSections #-}
6-
module Haskell.Ide.Engine.Plugin.HsImport where
7-
8-
import Control.Lens.Operators
9-
import Control.Monad.IO.Class
10-
import Control.Monad
11-
import Data.Aeson
12-
import Data.Bitraversable
13-
import Data.Bifunctor
14-
import Data.Foldable
15-
import Data.Maybe
16-
import Data.Monoid ( (<>) )
17-
import qualified Data.Text as T
18-
import qualified Data.Text.IO as T
19-
import qualified GHC.Generics as Generics
20-
import qualified GhcMod.Utils as GM
21-
import HsImport
22-
import Haskell.Ide.Engine.Config
23-
import Haskell.Ide.Engine.MonadTypes
24-
import qualified Haskell.Ide.Engine.Support.HieExtras
25-
as Hie
26-
import qualified Language.Haskell.LSP.Types as J
27-
import qualified Language.Haskell.LSP.Types.Lens
28-
as J
29-
import Haskell.Ide.Engine.PluginUtils
30-
import qualified Haskell.Ide.Engine.Plugin.Hoogle
31-
as Hoogle
32-
import System.Directory
33-
import System.IO
34-
35-
hsimportDescriptor :: PluginId -> PluginDescriptor
36-
hsimportDescriptor plId = PluginDescriptor
37-
{ pluginId = plId
38-
, pluginName = "HsImport"
39-
, pluginDesc =
40-
"A tool for extending the import list of a Haskell source file."
41-
, pluginCommands = [PluginCommand "import" "Import a module" importCmd]
42-
, pluginCodeActionProvider = Just codeActionProvider
43-
, pluginDiagnosticProvider = Nothing
44-
, pluginHoverProvider = Nothing
45-
, pluginSymbolProvider = Nothing
46-
, pluginFormattingProvider = Nothing
47-
}
48-
49-
data ImportParams = ImportParams
50-
{ file :: Uri
51-
, addToImportList :: Maybe T.Text
52-
, moduleToImport :: T.Text
53-
}
54-
deriving (Show, Eq, Generics.Generic, ToJSON, FromJSON)
55-
56-
importCmd :: CommandFunc ImportParams J.WorkspaceEdit
57-
importCmd = CmdSync $ \(ImportParams uri importList modName) ->
58-
importModule uri importList modName
59-
60-
importModule
61-
:: Uri -> Maybe T.Text -> T.Text -> IdeGhcM (IdeResult J.WorkspaceEdit)
62-
importModule uri importList modName =
63-
pluginGetFile "hsimport cmd: " uri $ \origInput -> do
64-
shouldFormat <- formatOnImportOn <$> getConfig
65-
66-
fileMap <- GM.mkRevRedirMapFunc
67-
GM.withMappedFile origInput $ \input -> do
68-
69-
tmpDir <- liftIO getTemporaryDirectory
70-
(output, outputH) <- liftIO $ openTempFile tmpDir "hsimportOutput"
71-
liftIO $ hClose outputH
72-
73-
let args = defaultArgs { moduleName = T.unpack modName
74-
, inputSrcFile = input
75-
, symbolName = T.unpack $ fromMaybe "" importList
76-
, outputSrcFile = output
77-
}
78-
liftIO $ hPutStrLn stderr $ "hsimport args: " ++ show args
79-
maybeErr <- liftIO $ hsimportWithArgs defaultConfig args
80-
case maybeErr of
81-
Just err -> do
82-
liftIO $ removeFile output
83-
let msg = T.pack $ show err
84-
return $ IdeResultFail (IdeError PluginError msg Null)
85-
Nothing -> do
86-
newText <- liftIO $ T.readFile output
87-
liftIO $ removeFile output
88-
J.WorkspaceEdit mChanges mDocChanges <- liftToGhc
89-
$ makeDiffResult input newText fileMap
90-
91-
if shouldFormat
92-
then do
93-
config <- getConfig
94-
plugins <- getPlugins
95-
let mprovider = Hie.getFormattingPlugin config plugins
96-
case mprovider of
97-
Nothing ->
98-
return $ IdeResultOk (J.WorkspaceEdit mChanges mDocChanges)
99-
100-
Just (plugin, _) -> do
101-
newChanges <- forM mChanges $ \change -> do
102-
let func = mapM (formatTextEdit plugin)
103-
res <- mapM func change
104-
return $ fmap flatten res
105-
106-
newDocChanges <- forM mDocChanges $ \change -> do
107-
let cmd (J.TextDocumentEdit vids edits) = do
108-
newEdits <- mapM (formatTextEdit plugin) edits
109-
return $ J.TextDocumentEdit vids (flatten newEdits)
110-
mapM cmd change
111-
112-
return
113-
$ IdeResultOk (J.WorkspaceEdit newChanges newDocChanges)
114-
else return $ IdeResultOk (J.WorkspaceEdit mChanges mDocChanges)
115-
116-
where
117-
flatten :: List [a] -> List a
118-
flatten (J.List list) = J.List (join list)
119-
120-
formatTextEdit :: PluginDescriptor -> J.TextEdit -> IdeGhcM [J.TextEdit]
121-
formatTextEdit plugin edit@(J.TextEdit r t) = do
122-
result <- runPluginCommand
123-
(pluginId plugin)
124-
"formatText"
125-
-- TODO: should this be in the configs?
126-
(dynToJSON $ toDynJSON $ FormatTextCmdParams t
127-
r
128-
(FormattingOptions 2 True)
129-
)
130-
return $ case result of
131-
IdeResultOk e -> fromMaybe [edit] (fromDynJSON e)
132-
_ -> [edit]
133-
134-
codeActionProvider :: CodeActionProvider
135-
codeActionProvider plId docId _ context = do
136-
let J.List diags = context ^. J.diagnostics
137-
terms = mapMaybe getImportables diags
138-
strippedNames = map (head . T.words . snd) terms
139-
res <- zip strippedNames <$> mapM (bimapM return Hoogle.searchModules) terms
140-
actions <-
141-
catMaybes
142-
. concat
143-
<$> mapM
144-
(\(term, diags') -> do
145-
let
146-
actions = concatMap
147-
(\(d, t) ->
148-
[mkImportAction Nothing d t, mkImportAction (Just term) d t]
149-
)
150-
(concatTerms [diags'])
151-
sequenceA actions
152-
)
153-
res
154-
155-
if null actions
156-
then do
157-
let relaxedTerms = map (bimap id (head . T.words)) terms
158-
strippedNames' = map snd relaxedTerms
159-
relaxedRes <- zip strippedNames' <$> mapM (bimapM return Hoogle.searchModules) relaxedTerms
160-
relaxedActions <-
161-
catMaybes
162-
. concat
163-
<$> mapM
164-
(\(term, diags') -> do
165-
let
166-
actions' = concatMap
167-
(\(d, t) ->
168-
[mkImportAction Nothing d t, mkImportAction (Just term) d t]
169-
)
170-
(concatTerms [diags'])
171-
sequenceA actions'
172-
)
173-
relaxedRes
174-
return $ IdeResultOk relaxedActions
175-
else return $ IdeResultOk actions
176-
177-
where
178-
concatTerms :: [(a, [b])] -> [(a, b)]
179-
concatTerms = concatMap (\(d, ts) -> map (d, ) ts)
180-
181-
--TODO: Check if package is already installed
182-
mkImportAction
183-
:: Maybe T.Text -> J.Diagnostic -> T.Text -> IdeM (Maybe J.CodeAction)
184-
mkImportAction importList diag modName = do
185-
cmd <- mkLspCommand plId "import" title (Just cmdParams)
186-
return (Just (codeAction cmd))
187-
where
188-
codeAction cmd = J.CodeAction title
189-
(Just J.CodeActionQuickFix)
190-
(Just (J.List [diag]))
191-
Nothing
192-
(Just cmd)
193-
title = "Import module " <> modName <> maybe "" (\name -> " (" <> name <> ")" ) importList
194-
cmdParams = [toJSON (ImportParams (docId ^. J.uri) importList modName)]
195-
196-
197-
getImportables :: J.Diagnostic -> Maybe (J.Diagnostic, T.Text)
198-
getImportables diag@(J.Diagnostic _ _ _ (Just "ghcmod") msg _) =
199-
(diag, ) <$> extractImportableTerm msg
200-
getImportables _ = Nothing
201-
202-
extractImportableTerm :: T.Text -> Maybe T.Text
203-
extractImportableTerm dirtyMsg = T.strip <$> asum
204-
[ T.stripPrefix "Variable not in scope: " msg
205-
, T.init <$> T.stripPrefix "Not in scope: type constructor or class ‘" msg
206-
, T.stripPrefix "Data constructor not in scope: " msg
207-
]
208-
where
209-
msg =
210-
head
211-
-- Get rid of the rename suggestion parts
212-
$ T.splitOn "Perhaps you meant "
213-
$ T.replace "\n" " "
214-
-- Get rid of trailing/leading whitespace on each individual line
215-
$ T.unlines
216-
$ map T.strip
217-
$ T.lines
218-
$ T.replace "• " "" dirtyMsg

0 commit comments

Comments
 (0)