handle trailing comma in import list properly (#3035)

Kobayashi · web-flow · commit 2f886bfdca36 · 2022-07-16T10:16:55.000Z
* handle trailing comma in import list properly

* no longer backup .ghcup in gitpod

* fix for ghc &lt; 9

* fix it without using CPP

* explain gitpod change

* read trailing comma before adding one

* refine imports

* refine gitpod

* gitpod store ghcide and hie-bios cache

These cache directories are small, but not preserving them requires
HLS to compile all modules in local project on workspace restarts.

* fix code styling
diff --git a/.gitpod.Dockerfile b/.gitpod.Dockerfile
@@ -2,17 +2,23 @@ FROM gitpod/workspace-full
 
 RUN sudo install-packages build-essential curl libffi-dev libffi7 libgmp-dev libgmp10 \
         libncurses-dev libncurses5 libtinfo5 && \
-    BOOTSTRAP_HASKELL_NONINTERACTIVE=1 \
-    BOOTSTRAP_HASKELL_MINIMAL=1 \
-    curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | sh && \
+    curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | BOOTSTRAP_HASKELL_NONINTERACTIVE=1 BOOTSTRAP_HASKELL_MINIMAL=1 sh && \
     echo 'source $HOME/.ghcup/env' >> $HOME/.bashrc && \
     echo 'export PATH=$HOME/.cabal/bin:$HOME/.local/bin:$PATH' >> $HOME/.bashrc && \
     . /home/gitpod/.ghcup/env && \
-    ghcup install ghc --set && \
+    # Install all verions of GHC that HLS supports. Putting GHC into Docker image makes workspace start much faster.
+    ghcup install ghc 8.6.5 && \
+    ghcup install ghc 8.8.4 && \
+    ghcup install ghc 8.10.7 && \
+    ghcup install ghc 9.0.2 && \
+    ghcup install ghc 9.2.2 && \
+    ghcup install ghc 9.2.3 --set && \
     ghcup install hls --set && \
     ghcup install cabal --set && \
     ghcup install stack --set && \
     cabal update && \
-    cabal install stylish-haskell hoogle implicit-hie && \
+    cabal install --disable-executable-dynamic --install-method copy --constraint "stylish-haskell +ghc-lib" \
+      stylish-haskell implicit-hie hoogle && \
+    rm -rf $HOME/.cabal/store && \
     pip install pre-commit && \
     npm install -g http-server
diff --git a/.gitpod.yml b/.gitpod.yml
@@ -10,7 +10,8 @@ tasks:
         $HOME/.local
         $HOME/.cabal
         $HOME/.stack
-        $HOME/.ghcup
+        $HOME/.cache/ghcide
+        $HOME/.cache/hie-bios
         /nix
       )
       for DIR in "${CACHE_DIRS[@]}"; do
@@ -41,9 +42,7 @@ tasks:
         echo '}' >> .vscode/settings.json
       fi
 
-      pushd docs
-        pip install -r requirements.txt
-      popd
+      pip install -r docs/requirements.txt
     init: |
       cabal update
       cabal configure --enable-executable-dynamic
diff --git a/ghcide/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs b/ghcide/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs
@@ -4,6 +4,7 @@
 {-# LANGUAGE RankNTypes         #-}
 {-# LANGUAGE CPP                #-}
 {-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 
 module Development.IDE.Plugin.CodeAction.ExactPrint (
   Rewrite (..),
@@ -23,41 +24,47 @@ module Development.IDE.Plugin.CodeAction.ExactPrint (
   wildCardSymbol
 ) where
 
-import           Control.Applicative
 import           Control.Monad
-import           Control.Monad.Extra                   (whenJust)
 import           Control.Monad.Trans
-import           Data.Char                             (isAlphaNum)
-import           Data.Data                             (Data)
-import           Data.Functor
-import           Data.Generics                         (listify)
-import qualified Data.Map.Strict                       as Map
-import           Data.Maybe                            (fromJust, isNothing,
-                                                        mapMaybe)
-import qualified Data.Text                             as T
-import           Development.IDE.GHC.Compat hiding (Annotation)
+import           Data.Char                       (isAlphaNum)
+import           Data.Data                       (Data)
+import           Data.Generics                   (listify)
+import qualified Data.Text                       as T
+import           Development.IDE.GHC.Compat      hiding (Annotation)
 import           Development.IDE.GHC.Error
 import           Development.IDE.GHC.ExactPrint
+import           Development.IDE.GHC.Util
 import           Development.IDE.Spans.Common
-import           GHC.Exts                              (IsList (fromList))
+import           GHC.Exts                        (IsList (fromList))
+import           GHC.Stack                       (HasCallStack)
 import           Language.Haskell.GHC.ExactPrint
-#if !MIN_VERSION_ghc(9,2,0)
+import           Language.LSP.Types
+
+-- GHC version specific imports. For any supported GHC version, make sure there is no warning in imports.
+#if MIN_VERSION_ghc(9,2,0)
+import           Control.Lens   (_head, _last, over)
+import           Data.Bifunctor (first)
+import           Data.Default   (Default (..))
+import           Data.Maybe     (fromJust, fromMaybe, mapMaybe)
+import           GHC            (AddEpAnn (..), AnnContext (..), AnnList (..),
+                                 AnnParen (..), DeltaPos (SameLine), EpAnn (..),
+                                 EpaLocation (EpaDelta),
+                                 IsUnicodeSyntax (NormalSyntax),
+                                 NameAdornment (NameParens),
+                                 TrailingAnn (AddCommaAnn), addAnns, ann,
+                                 emptyComments, reAnnL)
+#else
+import           Control.Applicative                   (Alternative ((<|>)))
+import           Control.Monad.Extra                   (whenJust)
+import           Data.Foldable                         (find)
+import           Data.Functor                          (($>))
+import qualified Data.Map.Strict                       as Map
+import           Data.Maybe                            (fromJust, isJust,
+                                                        isNothing, mapMaybe)
 import qualified Development.IDE.GHC.Compat.Util       as Util
 import           Language.Haskell.GHC.ExactPrint.Types (DeltaPos (DP),
                                                         KeywordId (G), mkAnnKey)
-#else
-import Data.Default
-import           GHC (AddEpAnn (..), AnnContext (..), AnnParen (..),
-                      DeltaPos (SameLine), EpAnn (..), EpaLocation (EpaDelta),
-                      IsUnicodeSyntax (NormalSyntax),
-                      NameAdornment (NameParens), NameAnn (..), addAnns, ann, emptyComments,
-                      reAnnL, AnnList (..), TrailingAnn (AddCommaAnn), addTrailingAnnToA)
 #endif
-import           Language.LSP.Types
-import Development.IDE.GHC.Util
-import Data.Bifunctor (first)
-import Control.Lens (_head, _last, over)
-import GHC.Stack (HasCallStack)
 
 ------------------------------------------------------------------------------
 
@@ -367,17 +374,28 @@ extendImportTopLevel thing (L l it@ImportDecl{..})
       then lift (Left $ thing <> " already imported")
       else do
 #if !MIN_VERSION_ghc(9,2,0)
-        when hasSibling $
-          addTrailingCommaT (last lies)
+        anns <- getAnnsT
+        maybe (pure ()) addTrailingCommaT (lastMaybe lies)
         addSimpleAnnT x (DP (0, if hasSibling then 1 else 0)) []
         addSimpleAnnT rdr dp00 [(G AnnVal, dp00)]
+
+        -- When the last item already has a trailing comma, we append a trailing comma to the new item.
+        let isAnnComma (G AnnComma, _) = True
+            isAnnComma _               = False
+            shouldAddTrailingComma = maybe False nodeHasComma (lastMaybe lies)
+                && not (nodeHasComma (L l' lies))
+
+            nodeHasComma :: Data a => Located a -> Bool
+            nodeHasComma x = isJust $ Map.lookup (mkAnnKey x) anns >>= find isAnnComma . annsDP
+        when shouldAddTrailingComma (addTrailingCommaT x)
+
         -- Parens are attachted to `lies`, so if `lies` was empty previously,
         -- we need change the ann key from `[]` to `:` to keep parens and other anns.
         unless hasSibling $
           transferAnn (L l' lies) (L l' [x]) id
         return $ L l it{ideclHiding = Just (hide, L l' $ lies ++ [x])}
 #else
-        lies' <- addCommaInImportList lies x
+        let lies' = addCommaInImportList lies x
         return $ L l it{ideclHiding = Just (hide, L l' lies')}
 #endif
 extendImportTopLevel _ _ = lift $ Left "Unable to extend the import list"
@@ -514,30 +532,44 @@ extendImportViaParent df parent child (L l it@ImportDecl{..})
           listAnn = epAnn srcParent [AddEpAnn AnnOpenP (epl 1), AddEpAnn AnnCloseP (epl 0)]
           x :: LIE GhcPs = reLocA $ L l'' $ IEThingWith listAnn parentLIE NoIEWildcard [childLIE]
 
-      lies' <- addCommaInImportList (reverse pre) x
+          lies' = addCommaInImportList (reverse pre) x
 #endif
       return $ L l it{ideclHiding = Just (hide, L l' lies')}
 extendImportViaParent _ _ _ _ = lift $ Left "Unable to extend the import list via parent"
 
 #if MIN_VERSION_ghc(9,2,0)
 -- Add an item in an import list, taking care of adding comma if needed.
-addCommaInImportList :: Monad m =>
+addCommaInImportList ::
   -- | Initial list
   [LocatedAn AnnListItem a]
   -- | Additionnal item
   -> LocatedAn AnnListItem a
-  -> m [LocatedAn AnnListItem a]
-addCommaInImportList lies x = do
-  let hasSibling = not (null lies)
-  -- Add the space before the comma
-  x <- pure $ setEntryDP x (SameLine $ if hasSibling then 1 else 0)
-
-  -- Add the comma (if needed)
-  let
-    fixLast = if hasSibling then first addComma else id
-    lies' = over _last fixLast lies ++ [x]
-
-  pure lies'
+  -> [LocatedAn AnnListItem a]
+addCommaInImportList lies x =
+    fixLast lies ++ [newItem]
+  where
+    isTrailingAnnComma :: TrailingAnn -> Bool
+    isTrailingAnnComma (AddCommaAnn _) = True
+    isTrailingAnnComma _ = False
+
+    -- check if there is an existing trailing comma
+    existingTrailingComma = fromMaybe False $ do
+        L lastItemSrcAnn _ <- lastMaybe lies
+        lastItemAnn <- case ann lastItemSrcAnn of
+            EpAnn _ lastItemAnn _ -> pure lastItemAnn
+            _ -> Nothing
+        pure $ any isTrailingAnnComma (lann_trailing lastItemAnn)
+
+    hasSibling = not . null $ lies
+
+    -- Setup the new item. It should have a preceding whitespace if it has siblings, and a trailing comma if the
+    -- preceding item already has one.
+    newItem = first (if existingTrailingComma then addComma else id) $
+        setEntryDP x (SameLine $ if hasSibling then 1 else 0)
+
+    -- Add the comma (if needed)
+    fixLast :: [LocatedAn AnnListItem a] -> [LocatedAn AnnListItem a]
+    fixLast = over _last (first (if existingTrailingComma then id else addComma))
 #endif
 
 unIEWrappedName :: IEWrappedName (IdP GhcPs) -> String
diff --git a/ghcide/test/exe/Main.hs b/ghcide/test/exe/Main.hs
@@ -1882,6 +1882,28 @@ extendImportTests = testGroup "extend import actions"
                     , "               )"
                     , "main = print (stuffA, stuffB)"
                     ])
+        , testSession "extend multi line import with trailing comma" $ template
+            [("ModuleA.hs", T.unlines
+                    [ "module ModuleA where"
+                    , "stuffA :: Double"
+                    , "stuffA = 0.00750"
+                    , "stuffB :: Integer"
+                    , "stuffB = 123"
+                    ])]
+            ("ModuleB.hs", T.unlines
+                    [ "module ModuleB where"
+                    , "import ModuleA (stuffB,"
+                    , "               )"
+                    , "main = print (stuffA, stuffB)"
+                    ])
+            (Range (Position 3 17) (Position 3 18))
+            ["Add stuffA to the import list of ModuleA"]
+            (T.unlines
+                    [ "module ModuleB where"
+                    , "import ModuleA (stuffB, stuffA,"
+                    , "               )"
+                    , "main = print (stuffA, stuffB)"
+                    ])
         , testSession "extend single line import with method within class" $ template
             [("ModuleA.hs", T.unlines
                     [ "module ModuleA where"
