diff --git a/src/Data/ConcurrentCache.hs b/src/Data/ConcurrentCache.hs index 1a12031..23469cc 100644 --- a/src/Data/ConcurrentCache.hs +++ b/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, diff --git a/src/StaticLS/IDE/AllExtensions.hs b/src/StaticLS/IDE/AllExtensions.hs new file mode 100644 index 0000000..289652f --- /dev/null +++ b/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" + ] diff --git a/src/StaticLS/IDE/Completion.hs b/src/StaticLS/IDE/Completion.hs index 968c0c4..c83f94a 100644 --- a/src/StaticLS/IDE/Completion.hs +++ b/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 diff --git a/src/StaticLS/Tree.hs b/src/StaticLS/Tree.hs index 143fe8d..f0df306 100644 --- a/src/StaticLS/Tree.hs +++ b/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] diff --git a/static-ls.cabal b/static-ls.cabal index d441de4..4266201 100644 --- a/static-ls.cabal +++ b/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