Skip to content

Commit c05125e

Browse files
committed
fix parseCabalProjectFileContents arguments, add test
1 parent 72fc5ab commit c05125e

File tree

6 files changed

+55
-22
lines changed

6 files changed

+55
-22
lines changed

haskell-language-server.cabal

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -397,6 +397,8 @@ test-suite hls-cabal-project-plugin-tests
397397
, lsp-types
398398
, text
399399
, hls-plugin-api
400+
, cabal-install
401+
400402

401403
-----------------------------
402404
-- class plugin

plugins/hls-cabal-project-plugin/src/Ide/Plugin/CabalProject.hs

Lines changed: 8 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -58,7 +58,7 @@ import Language.LSP.Protocol.Types
5858
import qualified Language.LSP.VFS as VFS
5959
import System.FilePath (takeFileName)
6060
import Text.Regex.TDFA
61-
61+
-- import Ide.Plugin.Cabal.Orphans ()
6262

6363
data Log
6464
= LogModificationTime NormalizedFilePath FileVersion
@@ -203,14 +203,16 @@ cabalRules recorder plId = do
203203
else do
204204
-- whenever this key is marked as dirty (e.g., when a user writes stuff to it),
205205
-- we rerun this rule because this rule *depends* on GetModificationTime.
206-
(t, mRope) <- use_ GetFileContents file
206+
(t, mCabalSource) <- use_ GetFileContents file
207207
log' Debug $ LogModificationTime file t
208208

209-
bytes <- case mRope of
210-
Just sources -> pure (Encoding.encodeUtf8 (Rope.toText sources))
211-
Nothing -> liftIO $ BS.readFile (fromNormalizedFilePath file)
209+
contents <- case mCabalSource of
210+
Just sources ->
211+
pure $ Encoding.encodeUtf8 $ Rope.toText sources
212+
Nothing ->
213+
liftIO $ BS.readFile $ fromNormalizedFilePath file
212214

213-
(pWarnings, pResult) <- liftIO $ Parse.parseCabalProjectFileContents (fromNormalizedFilePath file) bytes
215+
(pWarnings, pResult) <- liftIO $ Parse.parseCabalProjectFileContents (fromNormalizedFilePath file) contents
214216
let warnDiags = fmap (Diagnostics.warningDiagnostic file) pWarnings
215217

216218
case pResult of

plugins/hls-cabal-project-plugin/src/Ide/Plugin/CabalProject/Parse.hs

Lines changed: 0 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -32,10 +32,6 @@ import System.Directory.Extra (XdgDirectory (..),
3232
getXdgDirectory)
3333
import System.FilePath (takeBaseName,
3434
takeDirectory, (</>))
35-
-- import System.Directory.Extra as SD
36-
37-
38-
3935

4036
parseCabalProjectFileContents
4137
:: FilePath

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

Lines changed: 43 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -6,20 +6,29 @@ module Main (
66
main,
77
) where
88

9-
import Control.Lens ((^.))
10-
import Control.Lens.Fold ((^?))
11-
import Control.Monad (guard)
12-
import qualified Data.ByteString as BS
13-
import Data.Either (isRight)
14-
import Data.List.Extra (nubOrdOn)
15-
import qualified Data.Maybe as Maybe
16-
import qualified Data.Text as T
17-
import qualified Ide.Plugin.CabalProject.Parse as Lib
18-
import qualified Language.LSP.Protocol.Lens as L
9+
import qualified Control.Exception as E
10+
import Control.Lens ((^.))
11+
import Control.Lens.Fold ((^?))
12+
import Control.Monad (guard)
13+
import qualified Data.ByteString as BS
14+
import Data.ByteString.Char8 (pack)
15+
import Data.Either (isRight)
16+
import Data.List.Extra (nubOrdOn)
17+
import Data.List.NonEmpty (NonEmpty (..))
18+
import qualified Data.List.NonEmpty as NE
19+
import qualified Data.Maybe as Maybe
20+
import qualified Data.Text as T
21+
import Distribution.Client.ProjectConfig.Parsec (ProjectConfigSkeleton)
22+
import Distribution.Fields (PError (..),
23+
PWarning (..))
24+
import Distribution.Types.Version (Version)
25+
import qualified Ide.Plugin.CabalProject.Parse as Lib
26+
import qualified Language.LSP.Protocol.Lens as L
1927
import System.FilePath
2028
import Test.Hls
2129
import Utils
2230

31+
2332
main :: IO ()
2433
main = do
2534
defaultTestRunner $
@@ -45,10 +54,33 @@ cabalProjectParserUnitTests =
4554
testGroup
4655
"Parsing Cabal Project"
4756
[ testCase "Simple Parsing works" $ do
48-
(warnings, pm) <- Lib.parseCabalProjectFileContents (testDataDir </> "cabal.project")
57+
let fp = testDataDir </> "cabal.project"
58+
bytes <- BS.readFile fp
59+
(warnings, pm) <- Lib.parseCabalProjectFileContents fp bytes
4960
liftIO $ do
5061
null warnings @? "Found unexpected warnings"
5162
isRight pm @? "Failed to parse base cabal.project file"
63+
, testCase "Correct root directory" $ do
64+
let root = testDataDir </> "root-directory"
65+
let cabalFp = root </> "cabal.project"
66+
bytes <- BS.readFile cabalFp
67+
result <- E.try @E.IOException (Lib.parseCabalProjectFileContents cabalFp bytes)
68+
:: IO ( Either
69+
E.IOException
70+
( [PWarning]
71+
, Either (Maybe Version, NonEmpty PError)
72+
ProjectConfigSkeleton
73+
)
74+
)
75+
case result of
76+
Left err ->
77+
let errStr = show err
78+
in (pack root `BS.isInfixOf` pack errStr)
79+
@? ("Expected missing file error to mention the test-dir:\n"
80+
++ " " ++ root ++ "\n"
81+
++ "but got:\n" ++ errStr)
82+
Right _ ->
83+
False @? "Expected parse to fail (missing import), but it succeeded"
5284
]
5385

5486
-- ------------------------ ------------------------------------------------
Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1 @@
1+
import: missing-folder/nonexistent.config

0 commit comments

Comments
 (0)