mirror of
https://github.com/haskell/haskell-language-server.git
synced 2024-08-16 12:00:31 +03:00
handle trailing comma in import list properly (#3035)
* handle trailing comma in import list properly * no longer backup .ghcup in gitpod * fix for ghc < 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
This commit is contained in:
parent
fa868b5f34
commit
2f886bfdca
16
.gitpod.Dockerfile
vendored
16
.gitpod.Dockerfile
vendored
@ -2,17 +2,23 @@ FROM gitpod/workspace-full
|
|||||||
|
|
||||||
RUN sudo install-packages build-essential curl libffi-dev libffi7 libgmp-dev libgmp10 \
|
RUN sudo install-packages build-essential curl libffi-dev libffi7 libgmp-dev libgmp10 \
|
||||||
libncurses-dev libncurses5 libtinfo5 && \
|
libncurses-dev libncurses5 libtinfo5 && \
|
||||||
BOOTSTRAP_HASKELL_NONINTERACTIVE=1 \
|
curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | BOOTSTRAP_HASKELL_NONINTERACTIVE=1 BOOTSTRAP_HASKELL_MINIMAL=1 sh && \
|
||||||
BOOTSTRAP_HASKELL_MINIMAL=1 \
|
|
||||||
curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | sh && \
|
|
||||||
echo 'source $HOME/.ghcup/env' >> $HOME/.bashrc && \
|
echo 'source $HOME/.ghcup/env' >> $HOME/.bashrc && \
|
||||||
echo 'export PATH=$HOME/.cabal/bin:$HOME/.local/bin:$PATH' >> $HOME/.bashrc && \
|
echo 'export PATH=$HOME/.cabal/bin:$HOME/.local/bin:$PATH' >> $HOME/.bashrc && \
|
||||||
. /home/gitpod/.ghcup/env && \
|
. /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 hls --set && \
|
||||||
ghcup install cabal --set && \
|
ghcup install cabal --set && \
|
||||||
ghcup install stack --set && \
|
ghcup install stack --set && \
|
||||||
cabal update && \
|
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 && \
|
pip install pre-commit && \
|
||||||
npm install -g http-server
|
npm install -g http-server
|
||||||
|
@ -10,7 +10,8 @@ tasks:
|
|||||||
$HOME/.local
|
$HOME/.local
|
||||||
$HOME/.cabal
|
$HOME/.cabal
|
||||||
$HOME/.stack
|
$HOME/.stack
|
||||||
$HOME/.ghcup
|
$HOME/.cache/ghcide
|
||||||
|
$HOME/.cache/hie-bios
|
||||||
/nix
|
/nix
|
||||||
)
|
)
|
||||||
for DIR in "${CACHE_DIRS[@]}"; do
|
for DIR in "${CACHE_DIRS[@]}"; do
|
||||||
@ -41,9 +42,7 @@ tasks:
|
|||||||
echo '}' >> .vscode/settings.json
|
echo '}' >> .vscode/settings.json
|
||||||
fi
|
fi
|
||||||
|
|
||||||
pushd docs
|
pip install -r docs/requirements.txt
|
||||||
pip install -r requirements.txt
|
|
||||||
popd
|
|
||||||
init: |
|
init: |
|
||||||
cabal update
|
cabal update
|
||||||
cabal configure --enable-executable-dynamic
|
cabal configure --enable-executable-dynamic
|
||||||
|
@ -4,6 +4,7 @@
|
|||||||
{-# LANGUAGE RankNTypes #-}
|
{-# LANGUAGE RankNTypes #-}
|
||||||
{-# LANGUAGE CPP #-}
|
{-# LANGUAGE CPP #-}
|
||||||
{-# LANGUAGE FlexibleInstances #-}
|
{-# LANGUAGE FlexibleInstances #-}
|
||||||
|
{-# LANGUAGE ScopedTypeVariables #-}
|
||||||
|
|
||||||
module Development.IDE.Plugin.CodeAction.ExactPrint (
|
module Development.IDE.Plugin.CodeAction.ExactPrint (
|
||||||
Rewrite (..),
|
Rewrite (..),
|
||||||
@ -23,41 +24,47 @@ module Development.IDE.Plugin.CodeAction.ExactPrint (
|
|||||||
wildCardSymbol
|
wildCardSymbol
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Applicative
|
|
||||||
import Control.Monad
|
import Control.Monad
|
||||||
import Control.Monad.Extra (whenJust)
|
|
||||||
import Control.Monad.Trans
|
import Control.Monad.Trans
|
||||||
import Data.Char (isAlphaNum)
|
import Data.Char (isAlphaNum)
|
||||||
import Data.Data (Data)
|
import Data.Data (Data)
|
||||||
import Data.Functor
|
|
||||||
import Data.Generics (listify)
|
import Data.Generics (listify)
|
||||||
import qualified Data.Map.Strict as Map
|
|
||||||
import Data.Maybe (fromJust, isNothing,
|
|
||||||
mapMaybe)
|
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import Development.IDE.GHC.Compat hiding (Annotation)
|
import Development.IDE.GHC.Compat hiding (Annotation)
|
||||||
import Development.IDE.GHC.Error
|
import Development.IDE.GHC.Error
|
||||||
import Development.IDE.GHC.ExactPrint
|
import Development.IDE.GHC.ExactPrint
|
||||||
|
import Development.IDE.GHC.Util
|
||||||
import Development.IDE.Spans.Common
|
import Development.IDE.Spans.Common
|
||||||
import GHC.Exts (IsList (fromList))
|
import GHC.Exts (IsList (fromList))
|
||||||
|
import GHC.Stack (HasCallStack)
|
||||||
import Language.Haskell.GHC.ExactPrint
|
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 qualified Development.IDE.GHC.Compat.Util as Util
|
||||||
import Language.Haskell.GHC.ExactPrint.Types (DeltaPos (DP),
|
import Language.Haskell.GHC.ExactPrint.Types (DeltaPos (DP),
|
||||||
KeywordId (G), mkAnnKey)
|
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
|
#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")
|
then lift (Left $ thing <> " already imported")
|
||||||
else do
|
else do
|
||||||
#if !MIN_VERSION_ghc(9,2,0)
|
#if !MIN_VERSION_ghc(9,2,0)
|
||||||
when hasSibling $
|
anns <- getAnnsT
|
||||||
addTrailingCommaT (last lies)
|
maybe (pure ()) addTrailingCommaT (lastMaybe lies)
|
||||||
addSimpleAnnT x (DP (0, if hasSibling then 1 else 0)) []
|
addSimpleAnnT x (DP (0, if hasSibling then 1 else 0)) []
|
||||||
addSimpleAnnT rdr dp00 [(G AnnVal, dp00)]
|
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,
|
-- 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.
|
-- we need change the ann key from `[]` to `:` to keep parens and other anns.
|
||||||
unless hasSibling $
|
unless hasSibling $
|
||||||
transferAnn (L l' lies) (L l' [x]) id
|
transferAnn (L l' lies) (L l' [x]) id
|
||||||
return $ L l it{ideclHiding = Just (hide, L l' $ lies ++ [x])}
|
return $ L l it{ideclHiding = Just (hide, L l' $ lies ++ [x])}
|
||||||
#else
|
#else
|
||||||
lies' <- addCommaInImportList lies x
|
let lies' = addCommaInImportList lies x
|
||||||
return $ L l it{ideclHiding = Just (hide, L l' lies')}
|
return $ L l it{ideclHiding = Just (hide, L l' lies')}
|
||||||
#endif
|
#endif
|
||||||
extendImportTopLevel _ _ = lift $ Left "Unable to extend the import list"
|
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)]
|
listAnn = epAnn srcParent [AddEpAnn AnnOpenP (epl 1), AddEpAnn AnnCloseP (epl 0)]
|
||||||
x :: LIE GhcPs = reLocA $ L l'' $ IEThingWith listAnn parentLIE NoIEWildcard [childLIE]
|
x :: LIE GhcPs = reLocA $ L l'' $ IEThingWith listAnn parentLIE NoIEWildcard [childLIE]
|
||||||
|
|
||||||
lies' <- addCommaInImportList (reverse pre) x
|
lies' = addCommaInImportList (reverse pre) x
|
||||||
#endif
|
#endif
|
||||||
return $ L l it{ideclHiding = Just (hide, L l' lies')}
|
return $ L l it{ideclHiding = Just (hide, L l' lies')}
|
||||||
extendImportViaParent _ _ _ _ = lift $ Left "Unable to extend the import list via parent"
|
extendImportViaParent _ _ _ _ = lift $ Left "Unable to extend the import list via parent"
|
||||||
|
|
||||||
#if MIN_VERSION_ghc(9,2,0)
|
#if MIN_VERSION_ghc(9,2,0)
|
||||||
-- Add an item in an import list, taking care of adding comma if needed.
|
-- Add an item in an import list, taking care of adding comma if needed.
|
||||||
addCommaInImportList :: Monad m =>
|
addCommaInImportList ::
|
||||||
-- | Initial list
|
-- | Initial list
|
||||||
[LocatedAn AnnListItem a]
|
[LocatedAn AnnListItem a]
|
||||||
-- | Additionnal item
|
-- | Additionnal item
|
||||||
-> LocatedAn AnnListItem a
|
-> LocatedAn AnnListItem a
|
||||||
-> m [LocatedAn AnnListItem a]
|
-> [LocatedAn AnnListItem a]
|
||||||
addCommaInImportList lies x = do
|
addCommaInImportList lies x =
|
||||||
let hasSibling = not (null lies)
|
fixLast lies ++ [newItem]
|
||||||
-- Add the space before the comma
|
where
|
||||||
x <- pure $ setEntryDP x (SameLine $ if hasSibling then 1 else 0)
|
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)
|
-- Add the comma (if needed)
|
||||||
let
|
fixLast :: [LocatedAn AnnListItem a] -> [LocatedAn AnnListItem a]
|
||||||
fixLast = if hasSibling then first addComma else id
|
fixLast = over _last (first (if existingTrailingComma then id else addComma))
|
||||||
lies' = over _last fixLast lies ++ [x]
|
|
||||||
|
|
||||||
pure lies'
|
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
unIEWrappedName :: IEWrappedName (IdP GhcPs) -> String
|
unIEWrappedName :: IEWrappedName (IdP GhcPs) -> String
|
||||||
|
@ -1882,6 +1882,28 @@ extendImportTests = testGroup "extend import actions"
|
|||||||
, " )"
|
, " )"
|
||||||
, "main = print (stuffA, stuffB)"
|
, "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
|
, testSession "extend single line import with method within class" $ template
|
||||||
[("ModuleA.hs", T.unlines
|
[("ModuleA.hs", T.unlines
|
||||||
[ "module ModuleA where"
|
[ "module ModuleA where"
|
||||||
|
Loading…
Reference in New Issue
Block a user