Merge pull request #1268 from alanz/reinstate-pr-1237

Revert "Revert "Merge pull request #1237 from fendor/add-package-tests""

Author: alanz

haskell-ide-engine.cabal

@@ -173,10 +173,11 @@ test-suite unit-test
                        DiffSpec
                        ExtensibleStateSpec
                        GhcModPluginSpec
-                       LiquidSpec
                        HaRePluginSpec
                        HooglePluginSpec
                        JsonSpec
+                       LiquidSpec
+                       PackagePluginSpec
                        Spec
   -- Technically cabal-helper should be a 'run-tool-depends', but that doesn't exist yet
   build-tool-depends:  cabal-helper:cabal-helper-main, hspec-discover:hspec-discover

src/Haskell/Ide/Engine/Plugin/Package.hs

@@ -67,7 +67,7 @@ data AddParams = AddParams
   { rootDirParam   :: FilePath   -- ^ The root directory.
   , fileParam      :: ModulePath -- ^ A path to a module inside the
                                  -- library/executable/test-suite you want to
-                                 -- add the package to. May be a realtive oir
+                                 -- add the package to. May be a relative or
                                  -- absolute path, thus, must be normalised.
   , packageParam   :: Package    -- ^ The name of the package to add.
   }
@@ -76,7 +76,7 @@ data AddParams = AddParams
 -- | FilePath to a cabal package description file.
 type CabalFilePath = FilePath
 -- | FilePath to a package.yaml package description file.
-type PackageYamlFilePath = FilePath
+type HpackFilePath = FilePath
 -- | FilePath to a module within the project.
 -- May be used to establish what component the dependency shall be added to.
 type ModulePath = FilePath
@@ -88,8 +88,14 @@ type Package = T.Text
 -- Supported are `*.cabal` and `package.yaml` specifications.
 -- Moreover, may fail with an IOException in case of a filesystem problem.
 addCmd :: CommandFunc AddParams J.WorkspaceEdit
-addCmd = CmdSync $ \(AddParams rootDir modulePath pkg) -> do
+addCmd = CmdSync addCmd'
 
+-- | Add a package to the project's dependencies.
+-- May fail if no project dependency specification can be found.
+-- Supported are `*.cabal` and `package.yaml` specifications.
+-- Moreover, may fail with an IOException in case of a filesystem problem.
+addCmd' :: AddParams -> IdeGhcM (IdeResult J.WorkspaceEdit)
+addCmd' (AddParams rootDir modulePath pkg) = do
   packageType <- liftIO $ findPackageType rootDir
   fileMap <- GM.mkRevRedirMapFunc
 
@@ -105,9 +111,10 @@ addCmd = CmdSync $ \(AddParams rootDir modulePath pkg) -> do
       liftToGhc $ editHpackPackage absFp relModulePath pkg
     NoPackage -> return $ IdeResultFail (IdeError PluginError "No package.yaml or .cabal found" Null)
 
-data PackageType = CabalPackage FilePath -- ^ Location of Cabal File.
-                 | HpackPackage FilePath -- ^ Location of `package.yaml`
+data PackageType = CabalPackage FilePath -- ^ Location of Cabal File. May be relative.
+                 | HpackPackage FilePath -- ^ Location of `package.yaml`. May be relative.
                  | NoPackage -- ^ No package format has been found.
+                 deriving (Show, Eq)
 
 -- | Find the package type the project with the given root uses.
 -- Might have weird results if there is more than one cabal package specification
@@ -129,12 +136,13 @@ findPackageType rootDir = do
   return $ fromMaybe NoPackage $ asum [HpackPackage <$> mHpack, CabalPackage <$> mCabal]
 
 -- | Edit a hpack package to add the given package to the package.yaml.
+-- If package.yaml is not in an expected format, will fail fatally.
 --
 -- Currently does not preserve format.
 -- Keep an eye out on this other GSOC project!
 -- https://github.com/wisn/format-preserving-yaml
-editHpackPackage :: PackageYamlFilePath -- ^ Path to the package.yaml file
-                                        -- containing the package description.
+editHpackPackage :: HpackFilePath -- ^ Path to the package.yaml file
+                                  -- containing the package description.
                  -> ModulePath -- ^ Path to the module where the command has
                                -- been issued in.
                                -- Used to find out what component the
@@ -148,19 +156,29 @@ editHpackPackage fp modulePath pkgName = do
 
   case Y.decodeThrow contents :: Maybe Object of
     Just obj -> do
+        -- Map over all major components, such as "executable", "executables",
+        -- "tests" and "benchmarks". Note, that "library" is a major component,
+        -- but its structure is different and can not be mapped over in the same way.
+        --
+        -- Only adds the package if the declared "source-dirs" field is part of the
+        -- module path, or if no "source-dirs" is declared.
         let compsMapped = mapComponentTypes (ensureObject $ mapComponents (ensureObject $ mapCompDependencies addDep)) obj
 
-        let addDepToMainLib = fromMaybe True $ do
-              Object lib <- HM.lookup "library" compsMapped
-              sourceDirs <- HM.lookup "source-dirs" lib
-              return $ isInSourceDir sourceDirs
+        -- Is there a global "dependencies" yaml object?
+        let addDepToMainDep = fromMaybe False $ do
+              Array _ <- HM.lookup "dependencies" compsMapped
+              return True
 
-        let newPkg = if addDepToMainLib
-            then mapMainDependencies addDep compsMapped
-            else compsMapped
+        -- Either add the package to only the top-level "dependencies",
+        -- or to all main components of which the given module is part of.
+        let newPkg
+              | addDepToMainDep = mapMainDependencies addDep obj
+              -- Map over the library component at last, since it has different structure.
+              | otherwise = mapLibraryDependency addDep compsMapped
 
-            newPkgText = T.decodeUtf8 $ Y.encode newPkg
+        let newPkgText = T.decodeUtf8 $ Y.encode newPkg
 
+        -- Construct the WorkSpaceEdit
         let numOldLines = length $ T.lines $ T.decodeUtf8 contents
             range = J.Range (J.Position 0 0) (J.Position numOldLines 0)
             textEdit = J.TextEdit range newPkgText
@@ -179,10 +197,18 @@ editHpackPackage fp modulePath pkgName = do
 
     mapMainDependencies :: (Value -> Value) -> Object -> Object
     mapMainDependencies f o =
-      let g "dependencies" = f
+      let g :: T.Text -> Value -> Value
+          g "dependencies" = f
           g _              = id
       in HM.mapWithKey g o
 
+    mapLibraryDependency :: (Value -> Value) -> Object -> Object
+    mapLibraryDependency f o =
+      let g :: T.Text -> Value -> Value
+          g "library" (Y.Object o') = Y.Object (mapCompDependencies f o')
+          g _ x = x
+      in HM.mapWithKey g o
+
     mapComponentTypes :: (Value -> Value) -> Object -> Object
     mapComponentTypes f o =
       let g "executables" = f

test/functional/FunctionalCodeActionsSpec.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE CPP #-}
 
 module FunctionalCodeActionsSpec where
 
@@ -179,7 +180,9 @@ spec = describe "code actions" $ do
         ]
       ]
   describe "add package suggestions" $ do
-    it "adds to .cabal files" $ runSession hieCommand fullCaps "test/testdata/addPackageTest/cabal" $ do
+    -- Only execute this test with ghc 8.4.4, below seems to be broken in the package.
+#if (defined(MIN_VERSION_GLASGOW_HASKELL) && (MIN_VERSION_GLASGOW_HASKELL(8,4,0,0)))
+    it "adds to .cabal files" $ runSession hieCommand fullCaps "test/testdata/addPackageTest/cabal-exe" $ do
       doc <- openDoc "AddPackage.hs" "haskell"
 
       -- ignore the first empty hlint diagnostic publish
@@ -203,9 +206,9 @@ spec = describe "code actions" $ do
 
       contents <- getDocumentEdit . TextDocumentIdentifier =<< getDocUri "add-package-test.cabal"
       liftIO $ T.lines contents `shouldSatisfy` \x -> any (\l -> "text -any" `T.isSuffixOf` (x !! l)) [15, 16]
-
+#endif
     it "adds to hpack package.yaml files" $
-      runSession hieCommand fullCaps "test/testdata/addPackageTest/hpack" $ do
+      runSession hieCommand fullCaps "test/testdata/addPackageTest/hpack-exe" $ do
         doc <- openDoc "app/Asdf.hs" "haskell"
 
         -- ignore the first empty hlint diagnostic publish
@@ -229,9 +232,35 @@ spec = describe "code actions" $ do
 
         contents <- getDocumentEdit . TextDocumentIdentifier =<< getDocUri "package.yaml"
         liftIO $ do
-          T.lines contents !! 33 `shouldSatisfy` T.isSuffixOf "zlib"
-          T.lines contents !! 12 `shouldNotSatisfy` T.isSuffixOf "zlib"
-          T.lines contents !! 13 `shouldNotSatisfy` T.isSuffixOf "zlib"
+          T.lines contents !! 3 `shouldSatisfy` T.isSuffixOf "zlib"
+          T.lines contents !! 21 `shouldNotSatisfy` T.isSuffixOf "zlib"
+
+    it "adds to hpack package.yaml files if both are present" $
+      runSession hieCommand fullCaps "test/testdata/addPackageTest/hybrid-exe" $ do
+        doc <- openDoc "app/Asdf.hs" "haskell"
+
+        -- ignore the first empty hlint diagnostic publish
+        [_,diag:_] <- count 2 waitForDiagnostics
+
+        let preds = [ T.isPrefixOf "Could not load module ‘Codec.Compression.GZip’"
+                    , T.isPrefixOf "Could not find module ‘Codec.Compression.GZip’"
+                    ]
+          in liftIO $ diag ^. L.message `shouldSatisfy` \x -> any (\f -> f x) preds
+
+        mActions <- getAllCodeActions doc
+        let allActions = map fromAction mActions
+            action = head allActions
+
+        liftIO $ do
+          action ^. L.title `shouldBe` "Add zlib as a dependency"
+          forM_ allActions $ \a -> a ^. L.kind `shouldBe` Just CodeActionQuickFix
+          forM_ allActions $ \a -> a ^. L.command . _Just . L.command `shouldSatisfy` T.isSuffixOf "package:add"
+
+        executeCodeAction action
+
+        contents <- getDocumentEdit . TextDocumentIdentifier =<< getDocUri "package.yaml"
+        liftIO $
+          T.lines contents !! 21 `shouldSatisfy` T.isSuffixOf "zlib"
 
   -- -----------------------------------
 
@@ -318,10 +347,11 @@ spec = describe "code actions" $ do
 
           contents <- documentContents doc
 
-          liftIO $ contents `shouldBe`
-            "module TypedHoles where\n\
-            \foo :: [Int] -> Int\n\
-            \foo x = " <> suggestion
+          liftIO $ contents `shouldBe` T.concat
+            [ "module TypedHoles where\n"
+            , "foo :: [Int] -> Int\n"
+            , "foo x = " <> suggestion
+            ]
 
       it "shows more suggestions" $
         runSession hieCommand fullCaps "test/testdata" $ do

test/testdata/addPackageTest/cabal/AddPackage.hs renamed to test/testdata/addPackageTest/cabal-exe/AddPackage.hs

@@ -0,0 +1,14 @@
+name:                add-package-test
+version:             0.1.0.0
+license:             BSD3
+author:              Luke Lau
+maintainer:          [email protected]
+build-type:          Simple
+extra-source-files:  ChangeLog.md
+cabal-version:       >=1.10
+
+executable AddPackage
+  exposed-modules:     ./.
+  main-is:             AddPackage.hs
+  build-depends:       base >=4.7 && <5
+  default-language:    Haskell2010

test/testdata/addPackageTest/cabal-exe/add-package-test.cabal

@@ -0,0 +1,4 @@
+module AddPackage where 
+
+import Data.Text
+foo = pack "I'm a Text"

test/testdata/addPackageTest/cabal-lib/AddPackage.hs

@@ -22,9 +22,6 @@ description:         Please see the README on GitHub at <https://github.com/gith
 dependencies:
 - base >= 4.7 && < 5
 
-library:
-  source-dirs: src
-
 executables:
   asdf-exe:
     main:                Main.hs
@@ -34,15 +31,4 @@ executables:
     - -rtsopts
     - -with-rtsopts=-N
     dependencies:
-    - asdf
-
-tests:
-  asdf-test:
-    main:                Spec.hs
-    source-dirs:         test
-    ghc-options:
-    - -threaded
-    - -rtsopts
-    - -with-rtsopts=-N
-    dependencies:
-    - asdf
+    - asdf

test/testdata/addPackageTest/cabal/add-package-test.cabal renamed to test/testdata/addPackageTest/cabal-lib/add-package-test.cabal

@@ -0,0 +1,7 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Asdf where
+
+import Codec.Compression.GZip
+
+main = return $ compress "hello"