Remove conditional cabal logic pertaining to pre 9.2 GHCs

.github/workflows/flags.yml

@@ -75,9 +75,7 @@ jobs:
       - name: Build `ghcide` with flags
         run: cabal v2-build ghcide --flags="ghc-patched-unboxed-bytecode test-exe executable bench-exe ekg"
 
-      # wingman fails with flags on 9.0, so this can be removed when that's gone
-      - if: matrix.ghc != '9.0'
-        name: Build with pedantic (-WError)
+      - name: Build with pedantic (-WError)
         run: cabal v2-build --flags="pedantic"
 
   flags_post_job:

.github/workflows/test.yml

@@ -236,7 +236,7 @@ jobs:
         name: Test hls-retrie-plugin test suite
         run: cabal test hls-retrie-plugin --test-options="$TEST_OPTS" || cabal test hls-retrie-plugin --test-options="$TEST_OPTS"
 
-      - if: matrix.test && matrix.ghc != '9.0'
+      - if: matrix.test
         name: Test hls-overloaded-record-dot-plugin test suite
         run: cabal test hls-overloaded-record-dot-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-overloaded-record-dot-plugin --test-options="$TEST_OPTS"
 

cabal.project

@@ -36,7 +36,7 @@ packages:
          ./plugins/hls-overloaded-record-dot-plugin
          ./plugins/hls-semantic-tokens-plugin
 
-index-state: 2024-01-05T19:06:05Z
+index-state: 2024-01-13T19:06:05Z
 
 tests: True
 test-show-details: direct

ghcide/ghcide.cabal

@@ -78,7 +78,7 @@ library
     , hashable
     , hie-bios                     ==0.13.1
     , hie-compat                   ^>=0.3.0.0
-    , hiedb                        >=0.4.4    && <0.4.5
+    , hiedb                        ^>= 0.5.0.1
     , hls-graph                    == 2.5.0.0
     , hls-plugin-api               == 2.5.0.0
     , implicit-hie                 >= 0.1.4.0 && < 0.1.5
@@ -232,12 +232,7 @@ library
       -Wwarn=duplicate-exports -Wwarn=dodgy-exports
       -Wwarn=incomplete-patterns -Wwarn=overlapping-patterns
       -Wwarn=incomplete-record-updates
-
-  -- ambiguous-fields is only understood by GHC >= 9.2, so we only disable it
-  -- then. The above comment goes for here too -- this should be understood to
-  -- be temporary until we can remove these warnings.
-  if (impl(ghc >=9.2) && flag(pedantic))
-    ghc-options: -Wwarn=ambiguous-fields
+      -Wwarn=ambiguous-fields
 
   if flag(ekg)
     build-depends:
@@ -268,7 +263,7 @@ executable ghcide
   default-language:   Haskell2010
   hs-source-dirs:     exe
   ghc-options:
-    -threaded -Wall -Wincomplete-uni-patterns -Wno-name-shadowing
+    -threaded -Wall -Wincomplete-uni-patterns -Wno-name-shadowing -Wunused-packages
     -rtsopts "-with-rtsopts=-I0 -A128M -T"
 
   -- allow user RTS overrides
@@ -318,9 +313,6 @@ executable ghcide
 
     cpp-options:   -DMONITORING_EKG
 
-  if impl(ghc >=9)
-    ghc-options: -Wunused-packages
-
 test-suite ghcide-tests
   type:               exitcode-stdio-1.0
   default-language:   Haskell2010
@@ -340,6 +332,13 @@ test-suite ghcide-tests
     , extra
     , filepath
     , fuzzy
+  --------------------------------------------------------------
+  -- The MIN_VERSION_ghc macro relies on MIN_VERSION pragmas
+  -- which require depending on ghc. So the tests need to depend
+  -- on ghc if they need to use MIN_VERSION_ghc. Maybe a
+  -- better solution can be found, but this is a quick solution
+  -- which works for now.
+  --------------------------------------------------------------
     , ghc
     , ghcide
     , hls-plugin-api
@@ -368,18 +367,6 @@ test-suite ghcide-tests
     , text-rope
     , unordered-containers
 
-  --------------------------------------------------------------
-  -- The MIN_VERSION_ghc macro relies on MIN_VERSION pragmas
-  -- which require depending on ghc. So the tests need to depend
-  -- on ghc if they need to use MIN_VERSION_ghc. Maybe a
-  -- better solution can be found, but this is a quick solution
-  -- which works for now.
-  --------------------------------------------------------------
-  if impl(ghc <9.2)
-    build-depends:
-      , record-dot-preprocessor
-      , record-hasfield
-
   if impl(ghc <9.3)
     build-depends: ghc-typelits-knownnat
 

haskell-language-server.cabal

@@ -307,7 +307,7 @@ common explicitFields
     cpp-options: -DexplicitFields
 
 common overloadedRecordDot
-  if flag(overloadedRecordDot) && (impl(ghc >= 9.2.0) || flag(ignore-plugins-ghc-bounds))
+  if flag(overloadedRecordDot)
     build-depends: hls-overloaded-record-dot-plugin == 2.5.0.0
     cpp-options: -Dhls_overloaded_record_dot
 

hie-compat/hie-compat.cabal

@@ -35,8 +35,6 @@ library
     Compat.HieDebug
     Compat.HieUtils
 
-  if (impl(ghc >= 9.0) && impl(ghc < 9.1))
-    hs-source-dirs: src-ghc90 src-reexport-ghc9
   if (impl(ghc >= 9.2) && impl(ghc < 9.3))
     hs-source-dirs: src-ghc92 src-reexport-ghc9
   if (impl(ghc >= 9.4))

hls-plugin-api/src/Ide/Plugin/Properties.hs

@@ -11,8 +11,6 @@
 {-# LANGUAGE TypeFamilies          #-}
 {-# LANGUAGE TypeOperators         #-}
 {-# LANGUAGE UndecidableInstances  #-}
--- See Note [Constraints]
-{-# OPTIONS_GHC -Wno-redundant-constraints #-}
 
 module Ide.Plugin.Properties
   ( PropertyType (..),
@@ -44,13 +42,11 @@ import qualified Data.Aeson.Types     as A
 import           Data.Either          (fromRight)
 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
-import           Unsafe.Coerce        (unsafeCoerce)
 
 -- | Types properties may have
 data PropertyType
@@ -114,7 +110,10 @@ data SomePropertyKeyWithMetaData
 -- A property is an immediate child of the json object in each plugin's "config" section.
 -- It was designed to be compatible with vscode's settings UI.
 -- Use 'emptyProperties' and 'useProperty' to create and consume 'Properties'.
-newtype Properties (r :: [PropertyKey]) = Properties (Map.Map String SomePropertyKeyWithMetaData)
+data Properties (r :: [PropertyKey]) where
+    ConsProperties :: (k ~ 'PropertyKey s t, KnownSymbol s, NotElem s ks)
+        => KeyNameProxy s -> (SPropertyKey k) -> (MetaData t) -> Properties ks -> Properties (k : ks)
+    EmptyProperties :: Properties '[]
 
 -- | A proxy type in order to allow overloaded labels as properties' names at the call site
 data KeyNameProxy (s :: Symbol) = KnownSymbol s => KeyNameProxy
@@ -132,6 +131,10 @@ type family FindByKeyName (s :: Symbol) (r :: [PropertyKey]) :: PropertyType whe
   FindByKeyName s ('PropertyKey s t ': _) = t
   FindByKeyName s (_ ': xs) = FindByKeyName s xs
 
+type family IsPropertySymbol (s :: Symbol) (r :: PropertyKey) :: Bool where
+    IsPropertySymbol s ('PropertyKey s _) = 'True
+    IsPropertySymbol s _ = 'False
+
 type family Elem (s :: Symbol) (r :: [PropertyKey]) :: Constraint where
   Elem s ('PropertyKey s _ ': _) = ()
   Elem s (_ ': xs) = Elem s xs
@@ -143,7 +146,17 @@ type family NotElem (s :: Symbol) (r :: [PropertyKey]) :: Constraint where
   NotElem s '[] = ()
 
 -- | In row @r@, there is a 'PropertyKey' @k@, which has name @s@ and carries haskell type @t@
-type HasProperty s k t r = (k ~ 'PropertyKey s t, Elem s r, FindByKeyName s r ~ t, KnownSymbol s)
+type HasProperty s k t r = (k ~ 'PropertyKey s t, Elem s r, FindByKeyName s r ~ t, KnownSymbol s, FindPropertyMeta s r t)
+class FindPropertyMeta (s :: Symbol) (r :: [PropertyKey]) t where
+    findSomePropertyKeyWithMetaData :: KeyNameProxy s -> Properties r -> (SPropertyKey ('PropertyKey s t), MetaData t)
+instance (FindPropertyMetaIf (IsPropertySymbol symbol k) symbol k ks t) => FindPropertyMeta symbol (k : ks) t where
+  findSomePropertyKeyWithMetaData = findSomePropertyKeyWithMetaDataIf
+class (bool ~ IsPropertySymbol symbol k) => FindPropertyMetaIf bool symbol k ks t where
+  findSomePropertyKeyWithMetaDataIf :: KeyNameProxy symbol -> Properties (k : ks) -> (SPropertyKey ('PropertyKey symbol t), MetaData t)
+instance (k ~ 'PropertyKey s t) => FindPropertyMetaIf 'True s k ks t where
+  findSomePropertyKeyWithMetaDataIf _ (ConsProperties _ k m _) = (k, m)
+instance ('False ~ IsPropertySymbol s k, FindPropertyMeta s ks t) => FindPropertyMetaIf 'False s k ks t where
+  findSomePropertyKeyWithMetaDataIf s (ConsProperties _ _ _ ks) = findSomePropertyKeyWithMetaData s ks
 
 -- ---------------------------------------------------------------------
 
@@ -164,7 +177,7 @@ type HasProperty s k t r = (k ~ 'PropertyKey s t, Elem s r, FindByKeyName s r ~
 -- @
 
 emptyProperties :: Properties '[]
-emptyProperties = Properties Map.empty
+emptyProperties = EmptyProperties
 
 insert ::
   (k ~ 'PropertyKey s t, NotElem s r, KnownSymbol s) =>
@@ -173,30 +186,14 @@ insert ::
   MetaData t ->
   Properties r ->
   Properties (k ': r)
-insert kn key metadata (Properties old) =
-  Properties
-    ( Map.insert
-        (symbolVal kn)
-        (SomePropertyKeyWithMetaData key metadata)
-        old
-    )
+insert = ConsProperties
 
 find ::
   (HasProperty s k t r) =>
   KeyNameProxy s ->
   Properties r ->
   (SPropertyKey k, MetaData t)
-find kn (Properties p) = case p Map.! symbolVal kn of
-  (SomePropertyKeyWithMetaData sing metadata) ->
-    -- Note [Constraints]
-    -- It's safe to use unsafeCoerce here:
-    --   Since each property name is unique that the redefinition will be prevented by predication on the type level list,
-    --   the value we get from the name-indexed map must be exactly the singleton and metadata corresponding to the type.
-    -- We drop this information at type level: some of the above type families return '() :: Constraint',
-    -- so GHC will consider them as redundant.
-    -- But we encode it using semantically identical 'Map' at term level,
-    -- which avoids inducting on the list by defining a new type class.
-    unsafeCoerce (sing, metadata)
+find = findSomePropertyKeyWithMetaData
 
 -- ---------------------------------------------------------------------
 
@@ -350,7 +347,10 @@ defineEnumProperty kn description enums defaultValue =
 
 -- | Converts a properties definition into kv pairs with default values from 'MetaData'
 toDefaultJSON :: Properties r -> [A.Pair]
-toDefaultJSON (Properties p) = [toEntry s v | (s, v) <- Map.toList p]
+toDefaultJSON pr = case pr of
+    EmptyProperties -> []
+    ConsProperties keyNameProxy k m xs ->
+        toEntry (symbolVal keyNameProxy) (SomePropertyKeyWithMetaData k m) : toDefaultJSON xs
   where
     toEntry :: String -> SomePropertyKeyWithMetaData -> A.Pair
     toEntry s = \case
@@ -371,8 +371,10 @@ toDefaultJSON (Properties p) = [toEntry s v | (s, v) <- Map.toList p]
 
 -- | Converts a properties definition into kv pairs as vscode schema
 toVSCodeExtensionSchema :: T.Text -> Properties r -> [A.Pair]
-toVSCodeExtensionSchema prefix (Properties p) =
-  [fromString (T.unpack prefix <> k) A..= toEntry v | (k, v) <- Map.toList p]
+toVSCodeExtensionSchema prefix ps = case ps of
+    EmptyProperties -> []
+    ConsProperties (keyNameProxy :: KeyNameProxy s) (k :: SPropertyKey k) (m :: MetaData t) xs ->
+       fromString (T.unpack prefix <> symbolVal keyNameProxy) A..= toEntry (SomePropertyKeyWithMetaData k m) : toVSCodeExtensionSchema prefix xs
   where
     toEntry :: SomePropertyKeyWithMetaData -> A.Value
     toEntry = \case

plugins/hls-call-hierarchy-plugin/src/Ide/Plugin/CallHierarchy/Query.hs

@@ -11,8 +11,7 @@ module Ide.Plugin.CallHierarchy.Query (
 import qualified Data.Text                      as T
 import           Database.SQLite.Simple
 import           Development.IDE.GHC.Compat
-import           HieDb                          (HieDb (getConn), Symbol (..),
-                                                 toNsChar)
+import           HieDb                          (HieDb (getConn), Symbol (..))
 import           Ide.Plugin.CallHierarchy.Types
 
 incomingCalls :: HieDb -> Symbol -> IO [Vertex]
@@ -73,9 +72,9 @@ getSymbolPosition (getConn -> conn) Vertex{..} = do
             ]
         ) (occ, sl, sc, sl, el, ec, el)
 
-parseSymbol :: Symbol -> (String, String, String)
+parseSymbol :: Symbol -> (OccName, ModuleName, Unit)
 parseSymbol Symbol{..} =
-    let o = toNsChar (occNameSpace symName) : occNameString symName
-        m = moduleNameString $ moduleName symModule
-        u = unitString $ moduleUnit symModule
+    let o = symName
+        m = moduleName symModule
+        u = moduleUnit symModule
     in  (o, m, u)

plugins/hls-class-plugin/hls-class-plugin.cabal

@@ -44,6 +44,7 @@ library
     , deepseq
     , extra
     , ghc
+    , ghc-exactprint >= 1.5
     , ghcide          == 2.5.0.0
     , ghc-boot-th
     , hls-graph
@@ -54,11 +55,6 @@ library
     , text
     , transformers
 
-  if impl(ghc >=9.2.1)
-    build-depends: ghc-exactprint >= 1.5
-  else
-    build-depends: ghc-exactprint >= 0.6.4 && <1.1
-
   default-language:   Haskell2010
   default-extensions:
     DataKinds

plugins/hls-fourmolu-plugin/hls-fourmolu-plugin.cabal

@@ -30,6 +30,7 @@ library
   build-depends:
     , base            >=4.12 && <5
     , filepath
+    , fourmolu        ^>= 0.14
     , ghc
     , ghc-boot-th
     , ghcide          == 2.5.0.0
@@ -41,14 +42,6 @@ library
     , text
     , transformers
 
-  if impl(ghc >= 9.0) && impl(ghc < 9.2)
-    build-depends: fourmolu ^>= 0.11
-  else 
-    build-depends: fourmolu ^>= 0.14
-
-  -- fourmolu 0.9.0 fails to build on Windows CI for reasons unknown
-  if impl(ghc >= 9.2) && os(windows) && impl(ghc < 9.4)
-     build-depends: fourmolu > 0.9.0.0 || < 0.9.0.0
   default-language: Haskell2010
 
 test-suite tests

plugins/hls-overloaded-record-dot-plugin/hls-overloaded-record-dot-plugin.cabal

@@ -23,10 +23,6 @@ common warnings
 
 library
     import:           warnings
-    if impl(ghc < 9.2)
-      buildable: False
-    else
-      buildable: True
     exposed-modules:  Ide.Plugin.OverloadedRecordDot
     build-depends:
       , base                  >=4.16 && <5
@@ -48,10 +44,6 @@ library
 
 test-suite tests
     import:           warnings
-    if impl(ghc < 9.2)
-      buildable: False
-    else
-      buildable: True
     default-language: GHC2021
     type:             exitcode-stdio-1.0
     hs-source-dirs:   test

plugins/hls-semantic-tokens-plugin/src/Ide/Plugin/SemanticTokens/Query.hs

@@ -83,10 +83,8 @@ hieAstSpanNames vf ast =
         inclusion a b = not $ exclusion a b
         exclusion :: Identifier -> IdentifierDetails a -> Bool
         exclusion idt IdentifierDetails {identInfo = infos} = case idt of
-          Left _ -> True
-          Right name ->
-            isDerivedOccName (nameOccName name)
-              || any isEvidenceContext (S.toList infos)
+          Left _  -> True
+          Right _ -> any isEvidenceContext (S.toList infos)
 
 -------------------------------------------------
 

plugins/hls-semantic-tokens-plugin/test/Main.hs

@@ -187,6 +187,7 @@ semanticTokensDataTypeTests =
     "get semantic Tokens"
     [ goldenWithSemanticTokens "simple datatype" "TDataType",
       goldenWithSemanticTokens "record" "TRecord",
+      goldenWithSemanticTokens "record" "TRecordDuplicateRecordFields",
       goldenWithSemanticTokens "datatype import" "TDatatypeImported",
       goldenWithSemanticTokens "datatype family" "TDataFamily",
       goldenWithSemanticTokens "GADT" "TGADT"

plugins/hls-semantic-tokens-plugin/test/testdata/TRecordDuplicateRecordFields.expected

@@ -0,0 +1,4 @@
+5:6-9 TTypeCon "Foo"
+5:12-15 TDataCon "Foo"
+5:18-21 TRecField "boo"
+5:26-32 TTypeSyn "String"

plugins/hls-semantic-tokens-plugin/test/testdata/TRecordDuplicateRecordFields.hs

@@ -0,0 +1,5 @@
+{-# LANGUAGE DuplicateRecordFields      #-}
+
+module TRecordDuplicateRecordFields where
+
+data Foo = Foo { boo :: !String } 

stack-lts21.yaml

@@ -45,7 +45,7 @@ allow-newer: true
 
 extra-deps:
 - floskell-0.11.1
-- hiedb-0.4.4.0
+- hiedb-0.5.0.1
 - hie-bios-0.13.1
 - implicit-hie-0.1.4.0
 - monad-dijkstra-0.1.1.3

stack.yaml

@@ -45,7 +45,7 @@ allow-newer: true
 extra-deps:
 - floskell-0.11.1
 - retrie-1.2.2
-- hiedb-0.4.4.0
+- hiedb-0.5.0.1
 - implicit-hie-0.1.4.0
 - hie-bios-0.13.1
 - lsp-2.3.0.0