diff --git a/.github/workflows/test.yml b/.github/workflows/test.yml index fa597e173b..bc72dd3e30 100644 --- a/.github/workflows/test.yml +++ b/.github/workflows/test.yml @@ -144,7 +144,7 @@ jobs: run: cabal test wrapper-test --test-options="$TEST_OPTS --rerun-log-file .tasty-rerun-log-wrapper" || cabal test wrapper-test --test-options="$TEST_OPTS --rerun-log-file .tasty-rerun-log-wrapper" || cabal test wrapper-test --test-options="$TEST_OPTS --rerun-log-file .tasty-rerun-log-wrapper" - - if: matrix.test && matrix.ghc != '9.0.1' + - if: matrix.test name: Test hls-brittany-plugin run: cabal test hls-brittany-plugin --test-options="$TEST_OPTS" || cabal test hls-brittany-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-brittany-plugin --test-options="$TEST_OPTS" diff --git a/cabal-ghc901.project b/cabal-ghc901.project index f813020ae7..4505a1ce55 100644 --- a/cabal-ghc901.project +++ b/cabal-ghc901.project @@ -41,22 +41,25 @@ index-state: 2021-12-29T12:30:08Z constraints: -- These plugins don't work on GHC9 yet - haskell-language-server +ignore-plugins-ghc-bounds -brittany -stylishhaskell -tactic, + -- Add a plugin needs remove the -flag but also update ghc bounds in hls.cabal + haskell-language-server +ignore-plugins-ghc-bounds -stylishhaskell -tactic, ghc-lib-parser ^>= 9.0 -- although we are not building all plugins cabal solver phase is run for all packages -- this way we track explicitly all transitive dependencies which need support for ghc-9 allow-newer: - brittany:base, - brittany:ghc, - brittany:ghc-boot-th, - -- for brittany - butcher:base, + + -- brittany: update ghc bounds in hls.cabal when those are removed + -- https://github.com/lspitzner/multistate/pull/8 multistate:base, + -- https://github.com/lspitzner/data-tree-print/pull/3 data-tree-print:base, + -- https://github.com/lspitzner/butcher/pull/8 + butcher:base, stylish-haskell:Cabal, stylish-haskell:ghc-lib-parser, + stylish-haskell:aeson, floskell:base, floskell:ghc-prim, diff --git a/ghcide/ghcide.cabal b/ghcide/ghcide.cabal index c10923c66f..acefcc407d 100644 --- a/ghcide/ghcide.cabal +++ b/ghcide/ghcide.cabal @@ -49,8 +49,7 @@ library dependent-sum, dlist, exceptions, - -- we can't use >= 1.7.10 while we have to use hlint == 3.2.* - extra >= 1.7.4 && < 1.7.10, + extra >= 1.7.4, fuzzy, filepath, fingertree, diff --git a/ghcide/src/Control/Concurrent/Strict.hs b/ghcide/src/Control/Concurrent/Strict.hs index 2a33e5284b..842252d51c 100644 --- a/ghcide/src/Control/Concurrent/Strict.hs +++ b/ghcide/src/Control/Concurrent/Strict.hs @@ -4,25 +4,26 @@ module Control.Concurrent.Strict ,module Control.Concurrent.Extra ) where -import Control.Concurrent.Extra hiding (modifyVar, modifyVar_) +import Control.Concurrent.Extra hiding (modifyVar, modifyVar', + modifyVar_) import qualified Control.Concurrent.Extra as Extra import Control.Exception (evaluate) import Control.Monad (void) import Data.Tuple.Extra (dupe) -- | Strict modification that returns the new value -modifyVar' :: Var a -> (a -> a) -> IO a +modifyVar' :: Extra.Var a -> (a -> a) -> IO a modifyVar' var upd = modifyVarIO' var (pure . upd) -- | Strict modification that returns the new value -modifyVarIO' :: Var a -> (a -> IO a) -> IO a +modifyVarIO' :: Extra.Var a -> (a -> IO a) -> IO a modifyVarIO' var upd = do res <- Extra.modifyVar var $ \v -> do v' <- upd v pure $ dupe v' evaluate res -modifyVar :: Var a -> (a -> IO (a, b)) -> IO b +modifyVar :: Extra.Var a -> (a -> IO (a, b)) -> IO b modifyVar var upd = do (new, res) <- Extra.modifyVar var $ \old -> do (new,res) <- upd old @@ -30,5 +31,5 @@ modifyVar var upd = do void $ evaluate new return res -modifyVar_ :: Var a -> (a -> IO a) -> IO () +modifyVar_ :: Extra.Var a -> (a -> IO a) -> IO () modifyVar_ var upd = void $ modifyVarIO' var upd diff --git a/ghcide/src/Development/IDE/GHC/Orphans.hs b/ghcide/src/Development/IDE/GHC/Orphans.hs index a04fd1e86d..50aaa544ac 100644 --- a/ghcide/src/Development/IDE/GHC/Orphans.hs +++ b/ghcide/src/Development/IDE/GHC/Orphans.hs @@ -36,7 +36,6 @@ import Control.DeepSeq import Data.Aeson import Data.Hashable import Data.String (IsString (fromString)) -import Data.Text (Text) -- Orphan instances for types from the GHC API. instance Show CoreModule where show = prettyPrint @@ -122,7 +121,7 @@ instance NFData RealSrcSpan where rnf = rwhnf srcSpanFileTag, srcSpanStartLineTag, srcSpanStartColTag, - srcSpanEndLineTag, srcSpanEndColTag :: Text + srcSpanEndLineTag, srcSpanEndColTag :: String srcSpanFileTag = "srcSpanFile" srcSpanStartLineTag = "srcSpanStartLine" srcSpanStartColTag = "srcSpanStartCol" @@ -132,24 +131,24 @@ srcSpanEndColTag = "srcSpanEndCol" instance ToJSON RealSrcSpan where toJSON spn = object - [ srcSpanFileTag .= unpackFS (srcSpanFile spn) - , srcSpanStartLineTag .= srcSpanStartLine spn - , srcSpanStartColTag .= srcSpanStartCol spn - , srcSpanEndLineTag .= srcSpanEndLine spn - , srcSpanEndColTag .= srcSpanEndCol spn + [ fromString srcSpanFileTag .= unpackFS (srcSpanFile spn) + , fromString srcSpanStartLineTag .= srcSpanStartLine spn + , fromString srcSpanStartColTag .= srcSpanStartCol spn + , fromString srcSpanEndLineTag .= srcSpanEndLine spn + , fromString srcSpanEndColTag .= srcSpanEndCol spn ] instance FromJSON RealSrcSpan where parseJSON = withObject "object" $ \obj -> do - file <- fromString <$> (obj .: srcSpanFileTag) + file <- fromString <$> (obj .: fromString srcSpanFileTag) mkRealSrcSpan <$> (mkRealSrcLoc file - <$> obj .: srcSpanStartLineTag - <*> obj .: srcSpanStartColTag + <$> obj .: fromString srcSpanStartLineTag + <*> obj .: fromString srcSpanStartColTag ) <*> (mkRealSrcLoc file - <$> obj .: srcSpanEndLineTag - <*> obj .: srcSpanEndColTag + <$> obj .: fromString srcSpanEndLineTag + <*> obj .: fromString srcSpanEndColTag ) instance NFData Type where diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal index c35e8c0a37..e5898b8d1e 100644 --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -283,7 +283,7 @@ common qualifyImportedNames -- formatters common floskell - if flag(floskell) && (impl(ghc < 9.0.1) || flag(ignore-plugins-ghc-bounds)) + if flag(floskell) && (impl(ghc < 9.2.1) || flag(ignore-plugins-ghc-bounds)) build-depends: hls-floskell-plugin ^>=1.0.0.0 cpp-options: -Dfloskell @@ -433,6 +433,7 @@ test-suite func-test , data-default , hspec-expectations , lens + , lens-aeson , ghcide , hls-test-utils ^>= 1.1.0.0 , lsp-types @@ -472,7 +473,7 @@ test-suite func-test if flag(eval) cpp-options: -Deval -- formatters - if flag(floskell) && (impl(ghc < 9.0.1) || flag(ignore-plugins-ghc-bounds)) + if flag(floskell) && (impl(ghc < 9.2.1) || flag(ignore-plugins-ghc-bounds)) cpp-options: -Dfloskell if flag(fourmolu) && (impl(ghc < 9.2.1) || flag(ignore-plugins-ghc-bounds)) cpp-options: -Dfourmolu diff --git a/hls-plugin-api/hls-plugin-api.cabal b/hls-plugin-api/hls-plugin-api.cabal index 12c66bc3cd..1516d1b591 100644 --- a/hls-plugin-api/hls-plugin-api.cabal +++ b/hls-plugin-api/hls-plugin-api.cabal @@ -49,6 +49,7 @@ library , hls-graph >=1.4 && < 1.6 , hslogger , lens + , lens-aeson , lsp ^>=1.4.0.0 , opentelemetry , optparse-applicative diff --git a/hls-plugin-api/src/Ide/Plugin/ConfigUtils.hs b/hls-plugin-api/src/Ide/Plugin/ConfigUtils.hs index 411311106d..cea719a995 100644 --- a/hls-plugin-api/src/Ide/Plugin/ConfigUtils.hs +++ b/hls-plugin-api/src/Ide/Plugin/ConfigUtils.hs @@ -5,13 +5,16 @@ module Ide.Plugin.ConfigUtils where +import Control.Lens (at, ix, (&), (?~)) import qualified Data.Aeson as A +import Data.Aeson.Lens (_Object) import qualified Data.Aeson.Types as A import Data.Default (def) import qualified Data.Dependent.Map as DMap import qualified Data.Dependent.Sum as DSum -import qualified Data.HashMap.Lazy as HMap import Data.List (nub) +import Data.String (IsString (fromString)) +import qualified Data.Text as T import Ide.Plugin.Config import Ide.Plugin.Properties (toDefaultJSON, toVSCodeExtensionSchema) import Ide.Types @@ -25,17 +28,12 @@ import Language.LSP.Types -- | Generates a default 'Config', but remains only effective items pluginsToDefaultConfig :: IdePlugins a -> A.Value pluginsToDefaultConfig IdePlugins {..} = - A.Object $ - HMap.adjust - ( \(unsafeValueToObject -> o) -> - A.Object $ HMap.insert "plugin" elems o -- inplace the "plugin" section with our 'elems', leaving others unchanged - ) - "haskell" - (unsafeValueToObject (A.toJSON defaultConfig)) + -- Use 'ix' to look at all the "haskell" keys in the outer value (since we're not + -- setting it if missing), then we use '_Object' and 'at' to get at the "plugin" key + -- and actually set it. + A.toJSON defaultConfig & ix "haskell" . _Object . at "plugin" ?~ elems where defaultConfig@Config {} = def - unsafeValueToObject (A.Object o) = o - unsafeValueToObject _ = error "impossible" elems = A.object $ mconcat $ singlePlugin <$> map snd ipMap -- Splice genericDefaultConfig and dedicatedDefaultConfig -- Example: @@ -52,7 +50,7 @@ pluginsToDefaultConfig IdePlugins {..} = -- } singlePlugin PluginDescriptor {pluginConfigDescriptor = ConfigDescriptor {..}, ..} = let x = genericDefaultConfig <> dedicatedDefaultConfig - in [pId A..= A.object x | not $ null x] + in [fromString (T.unpack pId) A..= A.object x | not $ null x] where (PluginHandlers (DMap.toList -> handlers)) = pluginHandlers customConfigToDedicatedDefaultConfig (CustomConfig p) = toDefaultJSON p @@ -107,22 +105,22 @@ pluginsToVSCodeExtensionSchema IdePlugins {..} = A.object $ mconcat $ singlePlug (PluginId pId) = pluginId genericSchema = let x = - [withIdPrefix "diagnosticsOn" A..= schemaEntry "diagnostics" | configHasDiagnostics] + [toKey' "diagnosticsOn" A..= schemaEntry "diagnostics" | configHasDiagnostics] <> nub (mconcat (handlersToGenericSchema <$> handlers)) in case x of -- If the plugin has only one capability, we produce globalOn instead of the specific one; -- otherwise we don't produce globalOn at all - [_] -> [withIdPrefix "globalOn" A..= schemaEntry "plugin"] + [_] -> [toKey' "globalOn" A..= schemaEntry "plugin"] _ -> x dedicatedSchema = customConfigToDedicatedSchema configCustomConfig handlersToGenericSchema (IdeMethod m DSum.:=> _) = case m of - STextDocumentCodeAction -> [withIdPrefix "codeActionsOn" A..= schemaEntry "code actions"] - STextDocumentCodeLens -> [withIdPrefix "codeLensOn" A..= schemaEntry "code lenses"] - STextDocumentRename -> [withIdPrefix "renameOn" A..= schemaEntry "rename"] - STextDocumentHover -> [withIdPrefix "hoverOn" A..= schemaEntry "hover"] - STextDocumentDocumentSymbol -> [withIdPrefix "symbolsOn" A..= schemaEntry "symbols"] - STextDocumentCompletion -> [withIdPrefix "completionOn" A..= schemaEntry "completions"] - STextDocumentPrepareCallHierarchy -> [withIdPrefix "callHierarchyOn" A..= schemaEntry "call hierarchy"] + STextDocumentCodeAction -> [toKey' "codeActionsOn" A..= schemaEntry "code actions"] + STextDocumentCodeLens -> [toKey' "codeLensOn" A..= schemaEntry "code lenses"] + STextDocumentRename -> [toKey' "renameOn" A..= schemaEntry "rename"] + STextDocumentHover -> [toKey' "hoverOn" A..= schemaEntry "hover"] + STextDocumentDocumentSymbol -> [toKey' "symbolsOn" A..= schemaEntry "symbols"] + STextDocumentCompletion -> [toKey' "completionOn" A..= schemaEntry "completions"] + STextDocumentPrepareCallHierarchy -> [toKey' "callHierarchyOn" A..= schemaEntry "call hierarchy"] _ -> [] schemaEntry desc = A.object @@ -132,3 +130,4 @@ pluginsToVSCodeExtensionSchema IdePlugins {..} = A.object $ mconcat $ singlePlug "description" A..= A.String ("Enables " <> pId <> " " <> desc) ] withIdPrefix x = "haskell.plugin." <> pId <> "." <> x + toKey' = fromString . T.unpack . withIdPrefix diff --git a/hls-plugin-api/src/Ide/Plugin/Properties.hs b/hls-plugin-api/src/Ide/Plugin/Properties.hs index 2201cf2a53..9baaf26833 100644 --- a/hls-plugin-api/src/Ide/Plugin/Properties.hs +++ b/hls-plugin-api/src/Ide/Plugin/Properties.hs @@ -11,7 +11,6 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} -{-# LANGUAGE ViewPatterns #-} -- See Note [Constraints] {-# OPTIONS_GHC -Wno-redundant-constraints #-} @@ -47,6 +46,7 @@ import Data.Function ((&)) import Data.Kind (Constraint, Type) import qualified Data.Map.Strict as Map import Data.Proxy (Proxy (..)) +import Data.String (IsString (fromString)) import qualified Data.Text as T import GHC.OverloadedLabels (IsLabel (..)) import GHC.TypeLits @@ -162,6 +162,7 @@ type HasProperty s k t r = (k ~ 'PropertyKey s t, Elem s r, FindByKeyName s r ~ -- "Description of exampleNumber" -- 233 -- @ + emptyProperties :: Properties '[] emptyProperties = Properties Map.empty @@ -235,7 +236,7 @@ parseProperty kn k x = case k of (SEnum _, EnumMetaData {..}) -> A.parseEither ( \o -> do - txt <- o A..: keyName + txt <- o A..: key if txt `elem` enumValues then pure txt else @@ -247,9 +248,9 @@ parseProperty kn k x = case k of ) x where - keyName = T.pack $ symbolVal kn + key = fromString $ symbolVal kn parseEither :: forall a. A.FromJSON a => Either String a - parseEither = A.parseEither (A..: keyName) x + parseEither = A.parseEither (A..: key) x -- --------------------------------------------------------------------- @@ -352,26 +353,26 @@ toDefaultJSON :: Properties r -> [A.Pair] toDefaultJSON (Properties p) = [toEntry s v | (s, v) <- Map.toList p] where toEntry :: String -> SomePropertyKeyWithMetaData -> A.Pair - toEntry (T.pack -> s) = \case + toEntry s = \case (SomePropertyKeyWithMetaData SNumber MetaData {..}) -> - s A..= defaultValue + fromString s A..= defaultValue (SomePropertyKeyWithMetaData SInteger MetaData {..}) -> - s A..= defaultValue + fromString s A..= defaultValue (SomePropertyKeyWithMetaData SString MetaData {..}) -> - s A..= defaultValue + fromString s A..= defaultValue (SomePropertyKeyWithMetaData SBoolean MetaData {..}) -> - s A..= defaultValue + fromString s A..= defaultValue (SomePropertyKeyWithMetaData (SObject _) MetaData {..}) -> - s A..= defaultValue + fromString s A..= defaultValue (SomePropertyKeyWithMetaData (SArray _) MetaData {..}) -> - s A..= defaultValue + fromString s A..= defaultValue (SomePropertyKeyWithMetaData (SEnum _) EnumMetaData {..}) -> - s A..= defaultValue + fromString s A..= defaultValue -- | Converts a properties definition into kv pairs as vscode schema toVSCodeExtensionSchema :: T.Text -> Properties r -> [A.Pair] toVSCodeExtensionSchema prefix (Properties p) = - [(prefix <> T.pack k) A..= toEntry v | (k, v) <- Map.toList p] + [fromString (T.unpack prefix <> k) A..= toEntry v | (k, v) <- Map.toList p] where toEntry :: SomePropertyKeyWithMetaData -> A.Value toEntry = \case diff --git a/hls-plugin-api/src/Ide/Types.hs b/hls-plugin-api/src/Ide/Types.hs index 4d655cee0c..b20eb890d6 100644 --- a/hls-plugin-api/src/Ide/Types.hs +++ b/hls-plugin-api/src/Ide/Types.hs @@ -24,11 +24,11 @@ module Ide.Types #ifdef mingw32_HOST_OS import qualified System.Win32.Process as P (getCurrentProcessId) #else +import Control.Monad (void) import qualified System.Posix.Process as P (getProcessID) import System.Posix.Signals #endif import Control.Lens ((^.)) -import Control.Monad import Data.Aeson hiding (defaultOptions) import qualified Data.DList as DList import qualified Data.Default diff --git a/plugins/hls-brittany-plugin/hls-brittany-plugin.cabal b/plugins/hls-brittany-plugin/hls-brittany-plugin.cabal index ba64f55660..ff7f302985 100644 --- a/plugins/hls-brittany-plugin/hls-brittany-plugin.cabal +++ b/plugins/hls-brittany-plugin/hls-brittany-plugin.cabal @@ -23,7 +23,6 @@ library , base >=4.12 && <5 , brittany >=0.13.1.0 , filepath - , ghc , ghc-boot-th , ghcide >=1.2 && <1.6 , hls-plugin-api >=1.1 && <1.3 diff --git a/plugins/hls-brittany-plugin/src/Ide/Plugin/Brittany.hs b/plugins/hls-brittany-plugin/src/Ide/Plugin/Brittany.hs index 692f83b67c..7a61bf9935 100644 --- a/plugins/hls-brittany-plugin/src/Ide/Plugin/Brittany.hs +++ b/plugins/hls-brittany-plugin/src/Ide/Plugin/Brittany.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiWayIf #-} {-# LANGUAGE PolyKinds #-} @@ -19,8 +20,7 @@ import Development.IDE hiding (pluginHandlers) import qualified Development.IDE.GHC.Compat as GHC hiding (Cpp) -import qualified DynFlags as D -import qualified EnumSet as S +import qualified Development.IDE.GHC.Compat.Util as GHC import GHC.LanguageExtensions.Type import Ide.PluginUtils import Ide.Types @@ -39,7 +39,6 @@ import Data.CZipWith import qualified Data.List as List import qualified Data.Text as Text import qualified Data.Text.Lazy as TextL -import qualified GHC import qualified GHC.LanguageExtensions.Type as GHC import Language.Haskell.Brittany.Internal import Language.Haskell.Brittany.Internal.Config @@ -79,7 +78,7 @@ provider ide typ contents nfp opts = liftIO $ do -- Errors may be presented to the user. formatText :: MonadIO m - => D.DynFlags + => GHC.DynFlags -> Maybe FilePath -- ^ Path to configs. If Nothing, default configs will be used. -> FormattingOptions -- ^ Options for the formatter such as indentation. -> Text -- ^ Text to format @@ -101,7 +100,7 @@ getConfFile = findLocalConfigPath . takeDirectory . fromNormalizedFilePath -- Returns either a list of Brittany Errors or the reformatted text. -- May not throw an exception. runBrittany :: Int -- ^ tab size - -> D.DynFlags + -> GHC.DynFlags -> Maybe FilePath -- ^ local config file -> Text -- ^ text to format -> IO (Either [BrittanyError] Text) @@ -111,23 +110,30 @@ runBrittany tabSize df confPath text = do mempty { _lconfig_indentAmount = opt (Last tabSize) } , _conf_forward = - (mempty :: CForwardOptions Option) + (mempty :: CForwardOptions CMaybe) { _options_ghc = opt (getExtensions df) } } - - config <- fromMaybeT (pure staticDefaultConfig) (readConfigsWithUserConfig cfg (maybeToList confPath)) + config <- fromMaybeT (pure staticDefaultConfig) + (readConfigsWithUserConfig cfg (maybeToList confPath)) (errsAndWarnings, resultText) <- pPrintText config text if any isError errsAndWarnings then return $ Left errsAndWarnings else return $ Right resultText -fromMaybeT :: Monad m => m a -> MaybeT m a -> m a -fromMaybeT def act = runMaybeT act >>= maybe def return - +#if MIN_VERSION_brittany(0,14,0) +type CMaybe = Maybe +opt :: a -> Maybe a +opt = Just +#else +type CMaybe = Option opt :: a -> Option a opt = Option . Just +#endif + +fromMaybeT :: Monad m => m a -> MaybeT m a -> m a +fromMaybeT def act = runMaybeT act >>= maybe def return showErr :: BrittanyError -> String showErr (ErrorInput s) = s @@ -145,8 +151,8 @@ showExtension DatatypeContexts = Nothing showExtension RecordPuns = Just "-XNamedFieldPuns" showExtension other = Just $ "-X" ++ show other -getExtensions :: D.DynFlags -> [String] -getExtensions = mapMaybe showExtension . S.toList . D.extensionFlags +getExtensions :: GHC.DynFlags -> [String] +getExtensions = mapMaybe showExtension . GHC.toList . GHC.extensionFlags -- | This is a temporary fix that allows us to format the text if brittany diff --git a/shake-bench/shake-bench.cabal b/shake-bench/shake-bench.cabal index 250bc302c6..948b10dace 100644 --- a/shake-bench/shake-bench.cabal +++ b/shake-bench/shake-bench.cabal @@ -27,6 +27,8 @@ library directory, extra >= 1.7.2, filepath, + lens, + lens-aeson, shake, text default-language: Haskell2010 diff --git a/shake-bench/src/Development/Benchmark/Rules.hs b/shake-bench/src/Development/Benchmark/Rules.hs index 29e36fe71d..1732c02ddf 100644 --- a/shake-bench/src/Development/Benchmark/Rules.hs +++ b/shake-bench/src/Development/Benchmark/Rules.hs @@ -68,16 +68,19 @@ module Development.Benchmark.Rules import Control.Applicative import Control.Monad +import Control.Lens ((^.)) import Data.Aeson (FromJSON (..), ToJSON (..), - Value (..), (.!=), - (.:?)) + Value (..), object, (.!=), + (.:?), (.=)) +import Data.Aeson.Lens (_Object) import Data.Char (isDigit) import Data.List (find, isInfixOf, stripPrefix, transpose) import Data.List.Extra (lower) import Data.Maybe (fromMaybe) +import Data.String (fromString) import Data.Text (Text) import qualified Data.Text as T import Development.Shake @@ -88,7 +91,6 @@ import GHC.Exts (IsList (toList), import GHC.Generics (Generic) import GHC.Stack (HasCallStack) import qualified Graphics.Rendering.Chart.Backend.Diagrams as E -import Graphics.Rendering.Chart.Easy ((.=)) import qualified Graphics.Rendering.Chart.Easy as E import System.Directory (createDirectoryIfMissing, findExecutable, @@ -498,21 +500,24 @@ data GitCommit = GitCommit instance FromJSON GitCommit where parseJSON (String s) = pure $ GitCommit s Nothing Nothing True - parseJSON (Object (toList -> [(name, String gitName)])) = - pure $ GitCommit gitName (Just name) Nothing True - parseJSON (Object (toList -> [(name, Object props)])) = - GitCommit - <$> props .:? "git" .!= name - <*> pure (Just name) - <*> props .:? "parent" - <*> props .:? "include" .!= True + parseJSON o@(Object _) = do + let keymap = o ^. _Object + case toList keymap of + [(name, String gitName)] -> pure $ GitCommit gitName (Just name) Nothing True + [(name, Object props)] -> + GitCommit + <$> props .:? "git" .!= name + <*> pure (Just name) + <*> props .:? "parent" + <*> props .:? "include" .!= True + _ -> empty parseJSON _ = empty instance ToJSON GitCommit where toJSON GitCommit {..} = case name of Nothing -> String gitName - Just n -> Object $ fromList [(n, String gitName)] + Just n -> object [fromString (T.unpack n) .= String gitName] humanName :: GitCommit -> Text humanName GitCommit {..} = fromMaybe gitName name @@ -607,7 +612,7 @@ plotDiagram :: Bool -> Diagram -> FilePath -> Action () plotDiagram includeFailed t@Diagram {traceMetric, runLogs} out = do let extract = frameMetric traceMetric liftIO $ E.toFile E.def out $ do - E.layout_title .= title t + E.layout_title E..= title t E.setColors myColors forM_ runLogs $ \rl -> when (includeFailed || runSuccess rl) $ E.plot $ do diff --git a/stack-8.10.6.yaml b/stack-8.10.6.yaml index 6680b2d2bb..6863e2a43c 100644 --- a/stack-8.10.6.yaml +++ b/stack-8.10.6.yaml @@ -38,10 +38,12 @@ extra-deps: - brittany-0.13.1.2@sha256:9922614f1df18c63755a37c144033988788e0769fd9c2630b64ed0dfb49462bd,8197 - bytestring-encoding-0.1.1.0@sha256:1c3b97eb6345fd7153006211c8272215cd78bb0cf440c41185290822f1e3f2c2,1738 - data-tree-print-0.1.0.2@sha256:d845e99f322df70e0c06d6743bf80336f5918d5423498528beb0593a2afc1703,1620 + - extra-1.7.10 - floskell-0.10.5@sha256:77f0bc1569573d9666b10975a5357fef631d32266c071733739393ccae521dab,3803 - heapsize-0.3.0.1@sha256:0b69aa97a46d819b700ac7b145f3b5493c3565cf2c5b8298682238d405d0326e,1417 - hie-bios-0.8.0 - hiedb-0.4.1.0 + - hlint-3.2.8 - implicit-hie-0.1.2.6@sha256:f50a908979a574a881f753c0f9a5224f023f438b30fdefc5b7fa01803b07a280,2998 - implicit-hie-cradle-0.3.0.5@sha256:5f5e575f549b2a9db664be7650b5c3c9226e313bddc46c79e2e83eb349f8e692,2610 - lsp-1.4.0.0 diff --git a/stack-8.10.7.yaml b/stack-8.10.7.yaml index 7a0683c453..804a9ad284 100644 --- a/stack-8.10.7.yaml +++ b/stack-8.10.7.yaml @@ -39,10 +39,12 @@ extra-deps: - brittany-0.13.1.2@sha256:9922614f1df18c63755a37c144033988788e0769fd9c2630b64ed0dfb49462bd,8197 - bytestring-encoding-0.1.1.0@sha256:1c3b97eb6345fd7153006211c8272215cd78bb0cf440c41185290822f1e3f2c2,1738 - data-tree-print-0.1.0.2@sha256:d845e99f322df70e0c06d6743bf80336f5918d5423498528beb0593a2afc1703,1620 + - extra-1.7.10 - floskell-0.10.5@sha256:77f0bc1569573d9666b10975a5357fef631d32266c071733739393ccae521dab,3803 - heapsize-0.3.0.1@sha256:0b69aa97a46d819b700ac7b145f3b5493c3565cf2c5b8298682238d405d0326e,1417 - hie-bios-0.8.0 - hiedb-0.4.1.0 + - hlint-3.2.8 - implicit-hie-0.1.2.6@sha256:f50a908979a574a881f753c0f9a5224f023f438b30fdefc5b7fa01803b07a280,2998 - implicit-hie-cradle-0.3.0.5@sha256:5f5e575f549b2a9db664be7650b5c3c9226e313bddc46c79e2e83eb349f8e692,2610 - lsp-1.4.0.0 diff --git a/stack-8.6.5.yaml b/stack-8.6.5.yaml index 4635ba7fb4..088f1d4149 100644 --- a/stack-8.6.5.yaml +++ b/stack-8.6.5.yaml @@ -45,6 +45,7 @@ extra-deps: - cabal-plan-0.6.2.0 - clock-0.7.2 - Diff-0.4.0 + - extra-1.7.10 - floskell-0.10.4 - fourmolu-0.3.0.0 - fuzzy-0.1.0.1 @@ -61,13 +62,14 @@ extra-deps: - hashable-1.3.0.0 - heapsize-0.3.0 - hie-bios-0.8.0 - - hlint-3.2.3 + - hlint-3.2.8 - HsYAML-0.2.1.0@rev:1 - HsYAML-aeson-0.2.0.0@rev:2 - implicit-hie-cradle-0.3.0.5 - implicit-hie-0.1.2.6 - indexed-profunctors-0.1 - lens-4.18 + - lens-aeson-1.1 - megaparsec-9.0.1 - monad-dijkstra-0.1.1.2 - opentelemetry-0.6.1 @@ -95,7 +97,6 @@ extra-deps: - th-compat-0.1.2@sha256:3d55de1adc542c1a870c9ada90da2fbbe5f4e8bcd3eed545a55c3df9311b32a8,2854 - bytestring-encoding-0.1.0.0@sha256:460b49779fbf0112e8e2f1753c1ed9131eb18827600c298f4d6bb51c4e8c1c0d,1727 - hiedb-0.4.1.0 - - extra-1.7.9@sha256:f1dec740f0f2025790c540732bfd52c556ec55bde4f5dfd7cf18e22bd44ff3d0,2683 - dependent-map-0.4.0.0@sha256:ca2b131046f4340a1c35d138c5a003fe4a5be96b14efc26291ed35fd08c62221,1657 - dependent-sum-0.7.1.0@sha256:5599aa89637db434431b1dd3fa7c34bc3d565ee44f0519bfbc877be1927c2531,2068 - dependent-sum-template-0.1.0.3@sha256:0bbbacdfbd3abf2a15aaf0cf2c27e5bdd159b519441fec39e1e6f2f54424adde,1682 diff --git a/stack-8.8.4.yaml b/stack-8.8.4.yaml index 6cb159ed00..5e63618afe 100644 --- a/stack-8.8.4.yaml +++ b/stack-8.8.4.yaml @@ -40,6 +40,7 @@ extra-deps: - cabal-plan-0.6.2.0 - clock-0.7.2 - constrained-dynamic-0.1.0.0 + - extra-1.7.10 - floskell-0.10.4 - fourmolu-0.3.0.0 - ghc-check-0.5.0.4 @@ -51,7 +52,7 @@ extra-deps: - haskell-src-exts-1.21.1 - heapsize-0.3.0 - hie-bios-0.8.0 - - hlint-3.2.3 + - hlint-3.2.8 - HsYAML-aeson-0.2.0.0@rev:2 - hoogle-5.0.17.11 - hsimport-0.11.0 diff --git a/stack-9.0.1.yaml b/stack-9.0.1.yaml index c893993498..755bfae10d 100644 --- a/stack-9.0.1.yaml +++ b/stack-9.0.1.yaml @@ -1,4 +1,4 @@ -resolver: nightly-2021-12-14 +resolver: nightly-2021-12-26 packages: - . @@ -20,7 +20,7 @@ packages: - ./plugins/hls-retrie-plugin - ./plugins/hls-splice-plugin # - ./plugins/hls-tactics-plugin -# - ./plugins/hls-brittany-plugin +- ./plugins/hls-brittany-plugin # - ./plugins/hls-stylish-haskell-plugin - ./plugins/hls-floskell-plugin - ./plugins/hls-fourmolu-plugin @@ -30,10 +30,14 @@ packages: - ./plugins/hls-alternate-number-format-plugin extra-deps: +- aeson-2.0.2.0 +- brittany-0.14.0.0 +- butcher-1.3.3.2 - bytestring-encoding-0.1.1.0 +- data-tree-print-0.1.0.2 - dependent-map-0.4.0.0 - dependent-sum-0.7.1.0 -- extra-1.7.9 # for ghcide, https://github.com/haskell/haskell-language-server/pull/2131 +- extra-1.7.10 - hspec-2.7.10 # for hls-test-utils - hspec-core-2.7.10 # for hls-test-utils - some-1.0.2 # for dependent-sum, https://github.com/obsidiansystems/dependent-sum/issues/66 @@ -44,6 +48,7 @@ extra-deps: - implicit-hie-0.1.2.6 - implicit-hie-cradle-0.3.0.5 - monad-dijkstra-0.1.1.3 +- multistate-0.8.0.3 - retrie-1.1.0.0 - lsp-1.4.0.0 - lsp-test-0.14.0.2 @@ -78,7 +83,6 @@ flags: ignore-plugins-ghc-bounds: true tactic: false # Dependencies fail stylishHaskell: false - brittany: false retrie: BuildExecutable: false diff --git a/stack.yaml b/stack.yaml index 7a0683c453..804a9ad284 100644 --- a/stack.yaml +++ b/stack.yaml @@ -39,10 +39,12 @@ extra-deps: - brittany-0.13.1.2@sha256:9922614f1df18c63755a37c144033988788e0769fd9c2630b64ed0dfb49462bd,8197 - bytestring-encoding-0.1.1.0@sha256:1c3b97eb6345fd7153006211c8272215cd78bb0cf440c41185290822f1e3f2c2,1738 - data-tree-print-0.1.0.2@sha256:d845e99f322df70e0c06d6743bf80336f5918d5423498528beb0593a2afc1703,1620 + - extra-1.7.10 - floskell-0.10.5@sha256:77f0bc1569573d9666b10975a5357fef631d32266c071733739393ccae521dab,3803 - heapsize-0.3.0.1@sha256:0b69aa97a46d819b700ac7b145f3b5493c3565cf2c5b8298682238d405d0326e,1417 - hie-bios-0.8.0 - hiedb-0.4.1.0 + - hlint-3.2.8 - implicit-hie-0.1.2.6@sha256:f50a908979a574a881f753c0f9a5224f023f438b30fdefc5b7fa01803b07a280,2998 - implicit-hie-cradle-0.3.0.5@sha256:5f5e575f549b2a9db664be7650b5c3c9226e313bddc46c79e2e83eb349f8e692,2610 - lsp-1.4.0.0 diff --git a/test/functional/FunctionalCodeAction.hs b/test/functional/FunctionalCodeAction.hs index cf368b0613..3d160931b7 100644 --- a/test/functional/FunctionalCodeAction.hs +++ b/test/functional/FunctionalCodeAction.hs @@ -4,17 +4,17 @@ module FunctionalCodeAction (tests) where -import Control.Lens hiding (List) +import Control.Lens hiding (List) import Control.Monad import Data.Aeson -import qualified Data.HashMap.Strict as HM +import Data.Aeson.Lens (_Object) import Data.List -import qualified Data.Map as M +import qualified Data.Map as M import Data.Maybe -import qualified Data.Text as T +import qualified Data.Text as T import Ide.Plugin.Config -import Language.LSP.Test as Test -import qualified Language.LSP.Types.Lens as L +import Language.LSP.Test as Test +import qualified Language.LSP.Types.Lens as L import Test.Hls import Test.Hspec.Expectations @@ -56,11 +56,11 @@ renameTests = testGroup "rename suggestions" [ cars <- getAllCodeActions doc cmd <- liftIO $ inspectCommand cars ["Replace with", "putStrLn"] - let Just (List [Object args]) = cmd ^. L.arguments - Object editParams = args HM.! "fallbackWorkspaceEdit" + let Just (List [args]) = cmd ^. L.arguments + editParams = args ^. ix "fallbackWorkspaceEdit" . _Object liftIO $ do - "changes" `HM.member` editParams @? "Contains changes" - not ("documentChanges" `HM.member` editParams) @? "Doesn't contain documentChanges" + (editParams & has (ix "changes")) @? "Contains changes" + not (editParams & has (ix "documentChanges")) @? "Doesn't contain documentChanges" executeCommand cmd _ <- anyRequest