Skip to content

Commit 883e1fd

Browse files
VenInfVenInf
committed
WIP formatting
1 parent b5b1098 commit 883e1fd

File tree

2 files changed

+61
-63
lines changed

2 files changed

+61
-63
lines changed

‎plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs‎

Lines changed: 60 additions & 60 deletions
Original file line numberDiff line numberDiff line change
@@ -18,43 +18,49 @@ module Ide.Plugin.Cabal.CabalAdd
1818
where
1919

2020
import Control.Monad (filterM, void)
21-
import Control.Monad.IO.Class (liftIO, MonadIO)
21+
import Control.Monad.IO.Class (MonadIO, liftIO)
2222
import Data.String (IsString)
2323
import qualified Data.Text as T
2424
import qualified Data.Text.Encoding as T
25-
import Development.IDE (IdeState (shakeExtras),
26-
runIdeAction,
25+
import Development.IDE (IdeState,
2726
useWithStale)
2827
import Distribution.PackageDescription.Quirks (patchQuirks)
2928
import Ide.PluginUtils (WithDeletions (SkipDeletions),
3029
diffText,
3130
mkLspCommand)
3231
import Ide.Types (CommandFunction,
3332
CommandId (CommandId),
34-
PluginId, pluginGetClientCapabilities, pluginSendRequest, HandlerM)
35-
import Language.LSP.Protocol.Types (CodeAction (CodeAction),
33+
HandlerM,
34+
PluginId,
35+
pluginGetClientCapabilities,
36+
pluginSendRequest)
37+
import Language.LSP.Protocol.Types (ApplyWorkspaceEditParams (ApplyWorkspaceEditParams),
38+
ClientCapabilities,
39+
CodeAction (CodeAction),
3640
CodeActionKind (CodeActionKind_QuickFix),
3741
Diagnostic (..),
3842
Null (Null),
39-
TextDocumentIdentifier,
4043
VersionedTextDocumentIdentifier,
4144
WorkspaceEdit,
42-
WorkspaceFoldersServerCapabilities,
4345
toNormalizedFilePath,
44-
type (|?) (InR), ClientCapabilities, ApplyWorkspaceEditParams (ApplyWorkspaceEditParams))
46+
type (|?) (InR))
4547
import System.Directory (doesFileExist,
4648
listDirectory)
4749

50+
import Control.Monad.Trans.Class (lift)
51+
import Control.Monad.Trans.Except
4852
import Data.Aeson.Types (FromJSON,
4953
ToJSON, toJSON)
5054
import Data.ByteString (ByteString)
5155
import qualified Data.ByteString.Char8 as B
5256
import Data.List.NonEmpty (NonEmpty (..),
5357
fromList)
58+
import Data.Text.Encoding (encodeUtf8)
5459
import Development.IDE.Core.Rules (runAction)
60+
import Development.IDE.Core.RuleTypes (GetFileContents (..))
5561
import Distribution.Client.Add as Add
5662
import Distribution.Compat.Prelude (Generic)
57-
import Distribution.PackageDescription (GenericPackageDescription (GenericPackageDescription),
63+
import Distribution.PackageDescription (GenericPackageDescription,
5864
packageDescription,
5965
specVersion)
6066
import Distribution.PackageDescription.Configuration (flattenPackageDescription)
@@ -65,25 +71,19 @@ import Distribution.Simple.BuildTarget (BuildTarget,
6571
import Distribution.Simple.Utils (safeHead)
6672
import Distribution.Verbosity (silent,
6773
verboseNoStderr)
74+
import qualified Ide.Logger as Logger
6875
import Ide.Plugin.Cabal.Completion.Types (ParseCabalFields (..),
6976
ParseCabalFile (..))
77+
import Ide.Plugin.Cabal.Orphans ()
78+
import Ide.Plugin.Error
79+
import Language.LSP.Protocol.Message (SMethod (SMethod_WorkspaceApplyEdit))
7080
import System.FilePath (dropFileName,
7181
makeRelative,
7282
splitPath,
7383
takeExtension,
7484
(</>))
7585
import Text.PrettyPrint (render)
7686
import Text.Regex.TDFA
77-
import Development.IDE.Core.RuleTypes (GetFileContents(..))
78-
import Data.Text.Encoding (encodeUtf8)
79-
import Ide.Plugin.Cabal.Orphans ()
80-
import Distribution.Fields.Field (fieldAnn)
81-
import Control.Monad.Trans.Class (lift)
82-
import Language.LSP.Protocol.Message (SMethod (SMethod_WorkspaceApplyEdit))
83-
import Debug.Trace
84-
import qualified Ide.Logger as Logger
85-
import Control.Monad.Trans.Except
86-
import Ide.Plugin.Error
8787

8888
data Log
8989
= LogFoundResponsibleCabalFile FilePath
@@ -101,24 +101,6 @@ instance Logger.Pretty Log where
101101
LogCreatedEdit edit -> "Created inplace edit:\n" Logger.<+> Logger.pretty edit
102102
LogExecutedCommand -> "Executed CabalAdd command"
103103

104-
-- | Given a path to a haskell file, returns the closest cabal file.
105-
-- If cabal file wasn't found, dives Nothing.
106-
findResponsibleCabalFile :: FilePath -> IO (Maybe FilePath)
107-
findResponsibleCabalFile haskellFilePath = do
108-
let dirPath = dropFileName haskellFilePath
109-
allDirPaths = reverse $ scanl1 (</>) (splitPath dirPath) -- sorted from most to least specific
110-
go allDirPaths
111-
where
112-
go [] = pure Nothing
113-
go (path:ps) = do
114-
objects <- listDirectory path
115-
let objectsWithPaths = map (\obj -> path <> obj) objects
116-
objectsCabalExtension = filter (\c -> takeExtension c == ".cabal") objectsWithPaths
117-
cabalFiles <- filterM (\c -> doesFileExist c) objectsCabalExtension
118-
case safeHead cabalFiles of
119-
Nothing -> go ps
120-
Just cabalFile -> pure $ Just cabalFile
121-
122104

123105
-- | Gives a code action that calls the command,
124106
-- if a suggestion for a missing dependency is found.
@@ -134,6 +116,13 @@ hiddenPackageAction recorder plId verTxtDocId maxCompletions diag haskellFilePat
134116
hiddenPackageSuggestion maxCompletions (_message diag) | target <- targets]
135117
where
136118
buildTargetToStringRepr target = render $ pretty $ buildTargetComponentName target
119+
120+
getBuildTargets :: GenericPackageDescription -> FilePath -> FilePath -> IO [BuildTarget]
121+
getBuildTargets gpd cabalFilePath haskellFilePath = do
122+
let haskellFileRelativePath = makeRelative (dropFileName cabalFilePath) haskellFilePath
123+
readBuildTargets (verboseNoStderr silent) (flattenPackageDescription gpd) [haskellFileRelativePath]
124+
125+
mkCodeAction :: FilePath -> Maybe String -> (T.Text, T.Text) -> CodeAction
137126
mkCodeAction cabalFilePath target (suggestedDep, suggestedVersion) =
138127
let
139128
versionTitle = if T.null suggestedVersion then T.empty else " version " <> suggestedVersion
@@ -200,36 +189,19 @@ command recorder state _ params@(CabalAddCommandParams {cabalPath = path, verTxt
200189
Logger.logWith recorder Logger.Info LogExecutedCommand
201190
pure $ InR Null
202191

203-
204-
-- | Gives cabal file's contents or throws error.
205-
-- Inspired by @readCabalFile@ in cabal-add,
206-
-- Distribution.Client.Main
207-
readCabalFile :: MonadIO m => FilePath -> ExceptT PluginError m ByteString
208-
readCabalFile fileName = do
209-
cabalFileExists <- liftIO $ doesFileExist fileName
210-
if cabalFileExists
211-
then snd . patchQuirks <$> liftIO (B.readFile fileName)
212-
else throwE $ PluginInternalError $ T.pack ("Failed to read cabal file at " <> fileName)
213-
214-
getBuildTargets :: GenericPackageDescription -> FilePath -> FilePath -> IO [BuildTarget]
215-
getBuildTargets gpd cabalFilePath haskellFilePath = do
216-
let haskellFileRelativePath = makeRelative (dropFileName cabalFilePath) haskellFilePath
217-
readBuildTargets (verboseNoStderr silent) (flattenPackageDescription gpd) [haskellFileRelativePath]
218-
219-
220192
-- | Constructs prerequisets for the @executeConfig@
221193
-- and runs it, given path to the cabal file and a dependency message.
222-
--
194+
-- Given the new contents of the cabal file constructs and returns the @edit@.
223195
-- Inspired by @main@ in cabal-add,
224196
-- Distribution.Client.Main
225197
getDependencyEdit :: MonadIO m => Logger.Recorder (Logger.WithPriority Log) -> (IdeState, ClientCapabilities, VersionedTextDocumentIdentifier) ->
226198
FilePath -> Maybe String -> NonEmpty String -> ExceptT PluginError m WorkspaceEdit
227199
getDependencyEdit recorder env cabalFilePath buildTarget dependency = do
228200
let (state, caps, verTxtDocId) = env
229201
(mbCnfOrigContents, mbFields, mbPackDescr) <- liftIO $ runAction "cabal.cabal-add" state $ do
230-
contents <- useWithStale GetFileContents $ toNormalizedFilePath cabalFilePath
231-
inFields <- useWithStale ParseCabalFields $ toNormalizedFilePath cabalFilePath
232-
inPackDescr <- useWithStale ParseCabalFile $ toNormalizedFilePath cabalFilePath
202+
contents <- Development.IDE.useWithStale GetFileContents $ toNormalizedFilePath cabalFilePath
203+
inFields <- Development.IDE.useWithStale ParseCabalFields $ toNormalizedFilePath cabalFilePath
204+
inPackDescr <- Development.IDE.useWithStale ParseCabalFile $ toNormalizedFilePath cabalFilePath
233205
let mbCnfOrigContents = case snd . fst <$> contents of
234206
Just (Just txt) -> Just $ encodeUtf8 txt
235207
_ -> Nothing
@@ -240,7 +212,7 @@ getDependencyEdit recorder env cabalFilePath buildTarget dependency = do
240212
(cnfOrigContents, fields, packDescr) <- do
241213
cnfOrigContents <- case mbCnfOrigContents of
242214
(Just cnfOrigContents) -> pure cnfOrigContents
243-
Nothing -> readCabalFile cabalFilePath
215+
Nothing -> readCabalFile cabalFilePath
244216
(fields, packDescr) <- case (mbFields, mbPackDescr) of
245217
(Just fields, Just packDescr) -> pure (fields, packDescr)
246218
(_, _) -> case parseCabalFile cabalFilePath cnfOrigContents of
@@ -256,7 +228,7 @@ getDependencyEdit recorder env cabalFilePath buildTarget dependency = do
256228
pure (fields, packDescr, cmp, deps)
257229

258230
(cnfFields, origPackDescr, cnfComponent, cnfDependencies) <- case inputs of
259-
Left err -> throwE $ PluginInternalError $ T.pack $ err
231+
Left err -> throwE $ PluginInternalError $ T.pack err
260232
Right pair -> pure pair
261233

262234
case executeConfig (validateChanges origPackDescr) (Config {..}) of
@@ -265,3 +237,31 @@ getDependencyEdit recorder env cabalFilePath buildTarget dependency = do
265237
let edit = diffText caps (verTxtDocId, T.decodeUtf8 cnfOrigContents) (T.decodeUtf8 newContents) SkipDeletions
266238
Logger.logWith recorder Logger.Info $ LogCreatedEdit edit
267239
pure edit
240+
241+
-- | Given a path to a haskell file, returns the closest cabal file.
242+
-- If cabal file wasn't found, dives Nothing.
243+
findResponsibleCabalFile :: FilePath -> IO (Maybe FilePath)
244+
findResponsibleCabalFile haskellFilePath = do
245+
let dirPath = dropFileName haskellFilePath
246+
allDirPaths = reverse $ scanl1 (</>) (splitPath dirPath) -- sorted from most to least specific
247+
go allDirPaths
248+
where
249+
go [] = pure Nothing
250+
go (path:ps) = do
251+
objects <- listDirectory path
252+
let objectsWithPaths = map (\obj -> path <> obj) objects
253+
objectsCabalExtension = filter (\c -> takeExtension c == ".cabal") objectsWithPaths
254+
cabalFiles <- filterM (\c -> doesFileExist c) objectsCabalExtension
255+
case safeHead cabalFiles of
256+
Nothing -> go ps
257+
Just cabalFile -> pure $ Just cabalFile
258+
259+
-- | Gives cabal file's contents or throws error.
260+
-- Inspired by @readCabalFile@ in cabal-add,
261+
-- Distribution.Client.Main
262+
readCabalFile :: MonadIO m => FilePath -> ExceptT PluginError m ByteString
263+
readCabalFile fileName = do
264+
cabalFileExists <- liftIO $ doesFileExist fileName
265+
if cabalFileExists
266+
then snd . patchQuirks <$> liftIO (B.readFile fileName)
267+
else throwE $ PluginInternalError $ T.pack ("Failed to read cabal file at " <> fileName)

‎plugins/hls-cabal-plugin/test/Main.hs‎

Lines changed: 1 addition & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -226,11 +226,9 @@ codeActionTests = testGroup "Code Actions"
226226
_ <- waitForDiagnosticsFrom hsdoc
227227
cas <- Maybe.mapMaybe (^? _R) <$> getAllCodeActions hsdoc
228228
let selectedCas = filter (\ca -> "Add dependency" `T.isPrefixOf` (ca ^. L.title)) cas
229-
-- traceShowM("selectedCas", selectedCas)
230229
mapM_ executeCodeAction selectedCas
231-
_ <- skipManyTill anyMessage $ getDocumentEdit cabDoc
230+
_ <- skipManyTill anyMessage $ getDocumentEdit cabDoc -- Needed to wait for the changes in cabal file
232231
contents <- documentContents cabDoc
233-
-- traceShowM("contents", contents)
234232
liftIO $ assertEqual "Split isn't found in the cabal file" (Text.indices "split" contents) [256]
235233
]
236234
where

0 commit comments

Comments
 (0)