Add language extension autocomplete (#128)

`LANGUAGE` and any language extensions in GHC 9.6.3 are available as
auto-completions when writing a pragma. The list of language extensions
is hardcoded should be updated when migrating to a new GHC version.

---------

Co-authored-by: Greg Baimetov <gb@Gregs-MacBook-Pro.local>
Co-authored-by: Greg Baimetov <gb@Gregs-MacBook-Pro-4.local>

src/Data/ConcurrentCache.hs

@@ -3,6 +3,7 @@
 -- 'insert k v1' and 'insert k v2' are called concurrently,
 -- then only one of the computations v1 or v2 will run, and the one that runs will be cached
 -- so that subsequence inserts will return the cached value.
+
 module Data.ConcurrentCache (
   ConcurrentCache,
   new,

src/StaticLS/IDE/AllExtensions.hs

@@ -0,0 +1,280 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE Strict #-}
+
+module StaticLS.IDE.AllExtensions (allExtensions) where
+
+import Data.Text
+
+allExtensions :: [Text]
+allExtensions =
+  [ "Haskell98"
+  , "Haskell2010"
+  , "GHC2021"
+  , "Unsafe"
+  , "Trustworthy"
+  , "Safe"
+  , "AllowAmbiguousTypes"
+  , "NoAllowAmbiguousTypes"
+  , "AlternativeLayoutRule"
+  , "NoAlternativeLayoutRule"
+  , "AlternativeLayoutRuleTransitional"
+  , "NoAlternativeLayoutRuleTransitional"
+  , "Arrows"
+  , "NoArrows"
+  , "AutoDeriveTypeable"
+  , "NoAutoDeriveTypeable"
+  , "BangPatterns"
+  , "NoBangPatterns"
+  , "BinaryLiterals"
+  , "NoBinaryLiterals"
+  , "CApiFFI"
+  , "NoCApiFFI"
+  , "CPP"
+  , "NoCPP"
+  , "CUSKs"
+  , "NoCUSKs"
+  , "ConstrainedClassMethods"
+  , "NoConstrainedClassMethods"
+  , "ConstraintKinds"
+  , "NoConstraintKinds"
+  , "DataKinds"
+  , "NoDataKinds"
+  , "DatatypeContexts"
+  , "NoDatatypeContexts"
+  , "DefaultSignatures"
+  , "NoDefaultSignatures"
+  , "DeriveAnyClass"
+  , "NoDeriveAnyClass"
+  , "DeriveDataTypeable"
+  , "NoDeriveDataTypeable"
+  , "DeriveFoldable"
+  , "NoDeriveFoldable"
+  , "DeriveFunctor"
+  , "NoDeriveFunctor"
+  , "DeriveGeneric"
+  , "NoDeriveGeneric"
+  , "DeriveLift"
+  , "NoDeriveLift"
+  , "DeriveTraversable"
+  , "NoDeriveTraversable"
+  , "DerivingStrategies"
+  , "NoDerivingStrategies"
+  , "DerivingVia"
+  , "NoDerivingVia"
+  , "DisambiguateRecordFields"
+  , "NoDisambiguateRecordFields"
+  , "DoAndIfThenElse"
+  , "NoDoAndIfThenElse"
+  , "BlockArguments"
+  , "NoBlockArguments"
+  , "DoRec"
+  , "NoDoRec"
+  , "DuplicateRecordFields"
+  , "NoDuplicateRecordFields"
+  , "FieldSelectors"
+  , "NoFieldSelectors"
+  , "EmptyCase"
+  , "NoEmptyCase"
+  , "EmptyDataDecls"
+  , "NoEmptyDataDecls"
+  , "EmptyDataDeriving"
+  , "NoEmptyDataDeriving"
+  , "ExistentialQuantification"
+  , "NoExistentialQuantification"
+  , "ExplicitForAll"
+  , "NoExplicitForAll"
+  , "ExplicitNamespaces"
+  , "NoExplicitNamespaces"
+  , "ExtendedDefaultRules"
+  , "NoExtendedDefaultRules"
+  , "FlexibleContexts"
+  , "NoFlexibleContexts"
+  , "FlexibleInstances"
+  , "NoFlexibleInstances"
+  , "ForeignFunctionInterface"
+  , "NoForeignFunctionInterface"
+  , "FunctionalDependencies"
+  , "NoFunctionalDependencies"
+  , "GADTSyntax"
+  , "NoGADTSyntax"
+  , "GADTs"
+  , "NoGADTs"
+  , "GHCForeignImportPrim"
+  , "NoGHCForeignImportPrim"
+  , "GeneralizedNewtypeDeriving"
+  , "NoGeneralizedNewtypeDeriving"
+  , "GeneralisedNewtypeDeriving"
+  , "NoGeneralisedNewtypeDeriving"
+  , "ImplicitParams"
+  , "NoImplicitParams"
+  , "ImplicitPrelude"
+  , "NoImplicitPrelude"
+  , "ImportQualifiedPost"
+  , "NoImportQualifiedPost"
+  , "ImpredicativeTypes"
+  , "NoImpredicativeTypes"
+  , "IncoherentInstances"
+  , "NoIncoherentInstances"
+  , "TypeFamilyDependencies"
+  , "NoTypeFamilyDependencies"
+  , "InstanceSigs"
+  , "NoInstanceSigs"
+  , "ApplicativeDo"
+  , "NoApplicativeDo"
+  , "InterruptibleFFI"
+  , "NoInterruptibleFFI"
+  , "JavaScriptFFI"
+  , "NoJavaScriptFFI"
+  , "KindSignatures"
+  , "NoKindSignatures"
+  , "LambdaCase"
+  , "NoLambdaCase"
+  , "LexicalNegation"
+  , "NoLexicalNegation"
+  , "LiberalTypeSynonyms"
+  , "NoLiberalTypeSynonyms"
+  , "LinearTypes"
+  , "NoLinearTypes"
+  , "MagicHash"
+  , "NoMagicHash"
+  , "MonadComprehensions"
+  , "NoMonadComprehensions"
+  , "MonoLocalBinds"
+  , "NoMonoLocalBinds"
+  , "DeepSubsumption"
+  , "NoDeepSubsumption"
+  , "MonomorphismRestriction"
+  , "NoMonomorphismRestriction"
+  , "MultiParamTypeClasses"
+  , "NoMultiParamTypeClasses"
+  , "MultiWayIf"
+  , "NoMultiWayIf"
+  , "NumericUnderscores"
+  , "NoNumericUnderscores"
+  , "NPlusKPatterns"
+  , "NoNPlusKPatterns"
+  , "NamedFieldPuns"
+  , "NoNamedFieldPuns"
+  , "NamedWildCards"
+  , "NoNamedWildCards"
+  , "NegativeLiterals"
+  , "NoNegativeLiterals"
+  , "HexFloatLiterals"
+  , "NoHexFloatLiterals"
+  , "NondecreasingIndentation"
+  , "NoNondecreasingIndentation"
+  , "NullaryTypeClasses"
+  , "NoNullaryTypeClasses"
+  , "NumDecimals"
+  , "NoNumDecimals"
+  , "OverlappingInstances"
+  , "NoOverlappingInstances"
+  , "OverloadedLabels"
+  , "NoOverloadedLabels"
+  , "OverloadedLists"
+  , "NoOverloadedLists"
+  , "OverloadedStrings"
+  , "NoOverloadedStrings"
+  , "PackageImports"
+  , "NoPackageImports"
+  , "ParallelArrays"
+  , "NoParallelArrays"
+  , "ParallelListComp"
+  , "NoParallelListComp"
+  , "PartialTypeSignatures"
+  , "NoPartialTypeSignatures"
+  , "PatternGuards"
+  , "NoPatternGuards"
+  , "PatternSignatures"
+  , "NoPatternSignatures"
+  , "PatternSynonyms"
+  , "NoPatternSynonyms"
+  , "PolyKinds"
+  , "NoPolyKinds"
+  , "PolymorphicComponents"
+  , "NoPolymorphicComponents"
+  , "QuantifiedConstraints"
+  , "NoQuantifiedConstraints"
+  , "PostfixOperators"
+  , "NoPostfixOperators"
+  , "QuasiQuotes"
+  , "NoQuasiQuotes"
+  , "QualifiedDo"
+  , "NoQualifiedDo"
+  , "Rank2Types"
+  , "NoRank2Types"
+  , "RankNTypes"
+  , "NoRankNTypes"
+  , "RebindableSyntax"
+  , "NoRebindableSyntax"
+  , "OverloadedRecordDot"
+  , "NoOverloadedRecordDot"
+  , "OverloadedRecordUpdate"
+  , "NoOverloadedRecordUpdate"
+  , "RecordPuns"
+  , "NoRecordPuns"
+  , "RecordWildCards"
+  , "NoRecordWildCards"
+  , "RecursiveDo"
+  , "NoRecursiveDo"
+  , "RelaxedLayout"
+  , "NoRelaxedLayout"
+  , "RelaxedPolyRec"
+  , "NoRelaxedPolyRec"
+  , "RoleAnnotations"
+  , "NoRoleAnnotations"
+  , "ScopedTypeVariables"
+  , "NoScopedTypeVariables"
+  , "StandaloneDeriving"
+  , "NoStandaloneDeriving"
+  , "StarIsType"
+  , "NoStarIsType"
+  , "StaticPointers"
+  , "NoStaticPointers"
+  , "Strict"
+  , "NoStrict"
+  , "StrictData"
+  , "NoStrictData"
+  , "TemplateHaskell"
+  , "NoTemplateHaskell"
+  , "TemplateHaskellQuotes"
+  , "NoTemplateHaskellQuotes"
+  , "StandaloneKindSignatures"
+  , "NoStandaloneKindSignatures"
+  , "TraditionalRecordSyntax"
+  , "NoTraditionalRecordSyntax"
+  , "TransformListComp"
+  , "NoTransformListComp"
+  , "TupleSections"
+  , "NoTupleSections"
+  , "TypeApplications"
+  , "NoTypeApplications"
+  , "TypeData"
+  , "NoTypeData"
+  , "TypeInType"
+  , "NoTypeInType"
+  , "TypeFamilies"
+  , "NoTypeFamilies"
+  , "TypeOperators"
+  , "NoTypeOperators"
+  , "TypeSynonymInstances"
+  , "NoTypeSynonymInstances"
+  , "UnboxedTuples"
+  , "NoUnboxedTuples"
+  , "UnboxedSums"
+  , "NoUnboxedSums"
+  , "UndecidableInstances"
+  , "NoUndecidableInstances"
+  , "UndecidableSuperClasses"
+  , "NoUndecidableSuperClasses"
+  , "UnicodeSyntax"
+  , "NoUnicodeSyntax"
+  , "UnliftedDatatypes"
+  , "NoUnliftedDatatypes"
+  , "UnliftedFFITypes"
+  , "NoUnliftedFFITypes"
+  , "UnliftedNewtypes"
+  , "NoUnliftedNewtypes"
+  , "ViewPatterns"
+  , "NoViewPatterns"
+  ]

src/StaticLS/IDE/Completion.hs

@@ -1,4 +1,3 @@
-{-# LANGUAGE BlockArguments #-}
 {-# LANGUAGE MultiWayIf #-}
 
 module StaticLS.IDE.Completion (
@@ -45,6 +44,7 @@ import HieDb qualified
 import StaticLS.HieView.Name qualified as HieView.Name
 import StaticLS.HieView.Query qualified as HieView.Query
 import StaticLS.Hir qualified as Hir
+import StaticLS.IDE.AllExtensions (allExtensions)
 import StaticLS.IDE.CodeActions.AutoImport qualified as IDE.CodeActions.AutoImport
 import StaticLS.IDE.Monad
 import StaticLS.IDE.Utils qualified as IDE.Utils
@@ -134,10 +134,16 @@ getUnqualifiedImportCompletions cx = do
   completions <- getCompletionsForMods $ (.mod.text) <$> unqualifiedImports
   pure $ fmap textCompletion completions
 
+-- Why don't we need the text for this?
+getLangextCompletions :: Text -> StaticLsM [Completion]
+getLangextCompletions _ = do
+  pure (textCompletion <$> (allExtensions <> ["LANGUAGE"]))
+
 data CompletionMode
   = ImportMode !(Maybe Text)
   | HeaderMode !Text
   | QualifiedMode !Text !Text
+  | LangextMode !Text
   | UnqualifiedMode
   deriving (Show, Eq)
 
@@ -168,14 +174,29 @@ getImportPrefix cx sourceRope hs = do
       Just $ fst <$> modPrefix
     _ -> Nothing
 
+-- TODO: recognize headers properly
+getLangextPrefix :: Context -> Rope -> H.Haskell -> Maybe Text
+getLangextPrefix cx sourceRope hs = do
+  let lineCol = cx.lineCol
+  let pos = cx.pos
+  let posRange = Range.point pos
+  let line = Rope.toText $ Maybe.fromMaybe "" $ Rope.getLine sourceRope lineCol.line
+  let (_rest, extPrefix) = Maybe.fromMaybe ("", "") $ TextUtils.splitOnceEnd " " line
+  let dyn = AST.getDynNode hs
+  let pragma = AST.getDeepestContaining @Haskell.Pragma posRange dyn
+  let isInPragma = Maybe.isJust pragma
+  if isInPragma && extPrefix /= "" then Just extPrefix else Nothing
+
 getCompletionMode :: Context -> StaticLsM CompletionMode
 getCompletionMode cx = do
   let path = cx.path
   haskell <- getHaskell path
-  header <- Tree.getHeader haskell & isRightOrThrowT
+  header <- Tree.getHeader haskell & isRightOrThrowT -- check if it's in a pragma
   sourceRope <- getSourceRope path
   mod <- IDE.Utils.pathToModule path
   if
+    | Just match <- getLangextPrefix cx sourceRope haskell -> do
+        pure $ LangextMode match
     | (Nothing, Just mod) <- (header, mod) -> pure $ HeaderMode mod.text
     | Just modPrefix <- getImportPrefix cx sourceRope haskell -> do
         pure $ ImportMode modPrefix
@@ -251,6 +272,7 @@ getFlyImports cx qualifiedCompletions prefix match = do
   completions <- pure $ concat completions
   pure $ bootCompletions ++ completions
 
+-- TODO add language extension completions
 getCompletion :: Context -> StaticLsM (Bool, [Completion])
 getCompletion cx = do
   mode <- getCompletionMode cx
@@ -286,6 +308,9 @@ getCompletion cx = do
         "" -> pure []
         _ -> getFlyImports cx (HashSet.fromList qualifiedCompletions) mod match
       pure (match == "", (textCompletion <$> qualifiedCompletions) ++ flyImports)
+    LangextMode match -> do
+      comps <- getLangextCompletions match
+      pure (True, comps)
 
 resolveCompletionEdit :: CompletionMessage -> StaticLsM Edit
 resolveCompletionEdit msg = do

src/StaticLS/Tree.hs

@@ -27,6 +27,8 @@ getHeader haskell = do
   header <- AST.collapseErr haskell.children
   pure header
 
+-- getDeepestContaining @pragma should also work
+
 data Imports = Imports
   { dynNode :: AST.DynNode
   , imports :: [Haskell.Import]

static-ls.cabal

@@ -65,6 +65,7 @@ library
       StaticLS.Hir.Parse
       StaticLS.Hir.Print
       StaticLS.Hir.Types
+      StaticLS.IDE.AllExtensions
       StaticLS.IDE.CodeActions
       StaticLS.IDE.CodeActions.AddTypeSig
       StaticLS.IDE.CodeActions.AutoExport