diff --git a/cabal.project b/cabal.project index 00bd552741..f1e29b1079 100644 --- a/cabal.project +++ b/cabal.project @@ -36,6 +36,7 @@ packages: ./plugins/hls-explicit-fixity-plugin ./plugins/hls-explicit-record-fields-plugin ./plugins/hls-refactor-plugin + ./plugins/hls-overloaded-record-dot-plugin -- Standard location for temporary packages needed for particular environments -- For example it is used in the project gitlab mirror to help in the MAcOS M1 build script diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal index cccc2529d5..2f4cf0a53e 100644 --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -174,6 +174,11 @@ flag explicitFields default: True manual: True +flag overloadedRecordDot + description: Enable overloadedRecordDot plugin + default: True + manual: True + -- formatters flag floskell @@ -326,10 +331,15 @@ common explicitFields build-depends: hls-explicit-record-fields-plugin ^>= 1.0 cpp-options: -DexplicitFields +common overloadedRecordDot + if flag(overloadedRecordDot) && (impl(ghc >= 9.2.0) || flag(ignore-plugins-ghc-bounds)) + build-depends: hls-overloaded-record-dot-plugin ^>= 1.0 + cpp-options: -Dhls_overloaded_record_dot + -- formatters common floskell - if flag(floskell) && impl(ghc < 9.5) + if flag(floskell) && impl(ghc < 9.5) build-depends: hls-floskell-plugin ^>= 1.0 cpp-options: -Dhls_floskell @@ -387,6 +397,7 @@ library , ormolu , stylishHaskell , refactor + , overloadedRecordDot exposed-modules: Ide.Arguments diff --git a/plugins/hls-overloaded-record-dot-plugin/CHANGELOG.md b/plugins/hls-overloaded-record-dot-plugin/CHANGELOG.md new file mode 100644 index 0000000000..6179d5a570 --- /dev/null +++ b/plugins/hls-overloaded-record-dot-plugin/CHANGELOG.md @@ -0,0 +1,5 @@ +# Revision history for hls-overloaded-record-dot-plugin + +## 1.0.0.0 -- 2023-04-16 + +* First version. diff --git a/plugins/hls-overloaded-record-dot-plugin/LICENSE b/plugins/hls-overloaded-record-dot-plugin/LICENSE new file mode 100644 index 0000000000..16590f45c8 --- /dev/null +++ b/plugins/hls-overloaded-record-dot-plugin/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2023, Nathan Maxson + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Nathan Maxson nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/plugins/hls-overloaded-record-dot-plugin/README.md b/plugins/hls-overloaded-record-dot-plugin/README.md new file mode 100644 index 0000000000..7b15d09911 --- /dev/null +++ b/plugins/hls-overloaded-record-dot-plugin/README.md @@ -0,0 +1,18 @@ +# Explicit Record Fields Plugin + +`hls-overloaded-record-dot-plugin` is a plugin to convert record selectors to record dot syntax in GHC 9.2 and above. + + +## Demo + +![Convert Record Selector Demo](example.gif) + + +## Known limitations + +hls-overloaded-record-dot-plugin currently only converts record selectors to the record dot syntax, and will not help you convert your record updaters to overloaded record update syntax. + + +## Change log +### 1.0.0.0 +- Release diff --git a/plugins/hls-overloaded-record-dot-plugin/example.gif b/plugins/hls-overloaded-record-dot-plugin/example.gif new file mode 100644 index 0000000000..a84a342917 Binary files /dev/null and b/plugins/hls-overloaded-record-dot-plugin/example.gif differ diff --git a/plugins/hls-overloaded-record-dot-plugin/hls-overloaded-record-dot-plugin.cabal b/plugins/hls-overloaded-record-dot-plugin/hls-overloaded-record-dot-plugin.cabal new file mode 100644 index 0000000000..dabc0b6e20 --- /dev/null +++ b/plugins/hls-overloaded-record-dot-plugin/hls-overloaded-record-dot-plugin.cabal @@ -0,0 +1,61 @@ +cabal-version: 3.0 +name: hls-overloaded-record-dot-plugin +version: 1.0.1.0 +synopsis: Overloaded record dot plugin for Haskell Language Server +description: + Please see the README on GitHub at +license: BSD-3-Clause +license-file: LICENSE +author: Nathan Maxson +maintainer: joyfulmantis@gmail.com +-- copyright: +category: Development +build-type: Simple +extra-doc-files: CHANGELOG.md +extra-source-files: + test/testdata/**/*.hs + +source-repository head + type: git + location: https://github.com/haskell/haskell-language-server + +common warnings + ghc-options: -Wall + +library + import: warnings + exposed-modules: Ide.Plugin.OverloadedRecordDot + -- other-modules: + -- other-extensions: + build-depends: + , base >=4.12 && <5 + , ghcide ^>=1.10 + , hls-plugin-api ^>=1.6 + , lsp + , lens + , hls-graph + , text + , syb + , transformers + , ghc-boot-th + , unordered-containers + , containers + hs-source-dirs: src + default-language: Haskell2010 + +test-suite tests + import: warnings + default-language: Haskell2010 + -- other-modules: + -- other-extensions: + type: exitcode-stdio-1.0 + hs-source-dirs: test + main-is: Main.hs + build-depends: + , base + , filepath + , text + , hls-overloaded-record-dot-plugin + , lsp-test + , hls-test-utils + diff --git a/plugins/hls-overloaded-record-dot-plugin/src/Ide/Plugin/OverloadedRecordDot.hs b/plugins/hls-overloaded-record-dot-plugin/src/Ide/Plugin/OverloadedRecordDot.hs new file mode 100644 index 0000000000..c8681b6012 --- /dev/null +++ b/plugins/hls-overloaded-record-dot-plugin/src/Ide/Plugin/OverloadedRecordDot.hs @@ -0,0 +1,228 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE ViewPatterns #-} + +module Ide.Plugin.OverloadedRecordDot + ( descriptor + , Log + ) where + +-- based off of Berk Okzuturk's hls-explicit-records-fields-plugin + +import Control.Lens ((^.)) +import Control.Monad.IO.Class (MonadIO, liftIO) +import Control.Monad.Trans.Except (ExceptT) +import Data.Generics (GenericQ, everything, mkQ) +import qualified Data.HashMap.Strict as HashMap +import Data.Maybe (listToMaybe, maybeToList) +import Data.Text (Text) +import Development.IDE (IdeState, NormalizedFilePath, + Pretty (..), Range, + Recorder (..), Rules, + WithPriority (..), + realSrcSpanToRange) +import Development.IDE.Core.Rules (runAction) +import Development.IDE.Core.RuleTypes (TcModuleResult (..), + TypeCheck (..)) +import Development.IDE.Core.Shake (define, use) +import qualified Development.IDE.Core.Shake as Shake +import Development.IDE.GHC.Compat (HsExpr (HsApp, HsPar, HsRecSel, HsVar, OpApp), + Outputable, getLoc, unLoc) +import Development.IDE.GHC.Compat.Core (Extension (OverloadedRecordDot), + GhcPass, LHsExpr, Pass (..), + RealSrcSpan, hs_valds, + pattern RealSrcSpan) +import Development.IDE.GHC.Util (getExtensions, + printOutputable) +import Development.IDE.Graph (RuleResult) +import Development.IDE.Graph.Classes (Hashable, NFData (rnf)) +import Development.IDE.Spans.Pragmas (NextPragmaInfo (..), + getFirstPragma, + insertNewPragma) +import Development.IDE.Types.Logger (Priority (..), cmapWithPrio, + logWith, (<+>)) +import GHC.Generics (Generic) +import Ide.Plugin.RangeMap (RangeMap) +import qualified Ide.Plugin.RangeMap as RangeMap +import Ide.PluginUtils (getNormalizedFilePath, + handleMaybeM, pluginResponse) +import Ide.Types (PluginDescriptor (..), + PluginId (..), + PluginMethodHandler, + defaultPluginDescriptor, + mkPluginHandler) +import Language.LSP.Types (CodeAction (..), + CodeActionKind (CodeActionRefactorRewrite), + CodeActionParams (..), + Command, List (..), + Method (..), SMethod (..), + TextEdit (..), + WorkspaceEdit (WorkspaceEdit), + fromNormalizedUri, + normalizedFilePathToUri, + type (|?) (InR)) +import qualified Language.LSP.Types.Lens as L + +data Log + = LogShake Shake.Log + | LogCollectedRecordSelectors [RecordSelectors] + | LogRenderedRecordSelectors [ConvertedRecordSelector] + +instance Pretty Log where + pretty = \case + LogShake shakeLog -> pretty shakeLog + LogCollectedRecordSelectors recs -> "Collected record selectors:" <+> pretty recs + LogRenderedRecordSelectors recs -> "Rendered record selectors:" <+> pretty recs + +data CollectRecordSelectors = CollectRecordSelectors + deriving (Eq, Show, Generic) + +instance Hashable CollectRecordSelectors +instance NFData CollectRecordSelectors + +data CollectConvertedRecordSelectorsResult = CCRSR + { recordInfos :: RangeMap ConvertedRecordSelector + , enabledExtensions :: [GhcExtension] + } + deriving (Generic) + +instance NFData CollectConvertedRecordSelectorsResult + +instance Show CollectConvertedRecordSelectorsResult where + show _ = "" + +type instance RuleResult CollectRecordSelectors = CollectConvertedRecordSelectorsResult + +-- `Extension` is wrapped so that we can provide an `NFData` instance +-- (without resorting to creating an orphan instance). +newtype GhcExtension = GhcExtension { unExt :: Extension } + +instance NFData GhcExtension where + rnf x = x `seq` () + +data RecordSelectors + = RecordSelectors RealSrcSpan (HsExpr (GhcPass 'Renamed)) + +instance Pretty RecordSelectors where + pretty (RecordSelectors ss e) = pretty (printOutputable ss) <> ":" <+> pretty (printOutputable e) + +data ConvertedRecordSelector = ConvertedRecordSelector + { range :: Range + , convertedDotRecord :: Text + } + deriving (Generic) + +instance Pretty ConvertedRecordSelector where + pretty (ConvertedRecordSelector r cdr) = pretty (show r) <> ":" <+> pretty cdr + +instance NFData ConvertedRecordSelector + +descriptor :: Recorder (WithPriority Log) -> PluginId -> PluginDescriptor IdeState +descriptor recorder plId = (defaultPluginDescriptor plId) + { pluginHandlers = mkPluginHandler STextDocumentCodeAction codeActionProvider + , pluginRules = collectConvRecSelsRule recorder + } + +codeActionProvider :: PluginMethodHandler IdeState 'TextDocumentCodeAction +codeActionProvider ideState pId (CodeActionParams _ _ caDocId caRange _) = pluginResponse $ do + nfp <- getNormalizedFilePath (caDocId ^. L.uri) + pragma <- getFirstPragma pId ideState nfp + CCRSR crsMap (map unExt -> exts) <- collectConvRecSels' ideState nfp + let actions = map (mkCodeAction nfp exts pragma) (RangeMap.filterByRange caRange crsMap) + pure $ List actions + where + mkCodeAction :: NormalizedFilePath -> [Extension] -> NextPragmaInfo -> ConvertedRecordSelector -> Command |? CodeAction + mkCodeAction nfp exts pragma crs = InR CodeAction + { _title = mkCodeActionTitle exts + , _kind = Just CodeActionRefactorRewrite + , _diagnostics = Nothing + , _isPreferred = Nothing + , _disabled = Nothing + , _edit = Just $ mkWorkspaceEdit nfp edits + , _command = Nothing + , _xdata = Nothing + } + where + edits = mkTextEdit crs : maybeToList pragmaEdit + + mkTextEdit :: ConvertedRecordSelector -> TextEdit + mkTextEdit (ConvertedRecordSelector r cdr) = TextEdit r cdr + + pragmaEdit :: Maybe TextEdit + pragmaEdit = if OverloadedRecordDot `elem` exts + then Nothing + else Just $ insertNewPragma pragma OverloadedRecordDot + + mkWorkspaceEdit :: NormalizedFilePath -> [TextEdit] -> WorkspaceEdit + mkWorkspaceEdit nfp edits = WorkspaceEdit changes Nothing Nothing + where + changes = Just $ HashMap.singleton (fromNormalizedUri (normalizedFilePathToUri nfp)) (List edits) + + mkCodeActionTitle :: [Extension] -> Text + mkCodeActionTitle exts = + if OverloadedRecordDot `elem` exts + then title + else title <> " (needs extension: OverloadedRecordDot)" + where + title = "Convert to record dot syntax" + +collectConvRecSelsRule :: Recorder (WithPriority Log) -> Rules () +collectConvRecSelsRule recorder = define (cmapWithPrio LogShake recorder) $ \CollectRecordSelectors nfp -> + use TypeCheck nfp >>= \case + Nothing -> pure ([], Nothing) + Just tmr -> do + let exts = getEnabledExtensions tmr + recSels = getRecordSelectors tmr + logWith recorder Debug (LogCollectedRecordSelectors recSels) + let convertedRecordSelectors = traverse convertRecordSelectors recSels + crsMap = RangeMap.fromList range <$> convertedRecordSelectors + logWith recorder Debug (LogRenderedRecordSelectors (concat convertedRecordSelectors)) + pure ([], CCRSR <$> crsMap <*> Just exts) + where + getEnabledExtensions :: TcModuleResult -> [GhcExtension] + getEnabledExtensions = map GhcExtension . getExtensions . tmrParsed + +getRecordSelectors :: TcModuleResult -> [RecordSelectors] +getRecordSelectors (tmrRenamed -> (hs_valds -> valBinds,_,_,_)) = + collectRecordSelectors valBinds + +convertRecordSelectors :: RecordSelectors -> Maybe ConvertedRecordSelector +convertRecordSelectors (RecordSelectors ss expr) = ConvertedRecordSelector (realSrcSpanToRange ss) <$> convertRecSel expr + +convertRecSel :: Outputable (HsExpr (GhcPass c)) => HsExpr (GhcPass c) -> Maybe Text +convertRecSel (HsApp _ s@(unLoc -> HsRecSel _ _) r@(unLoc -> HsVar _ _)) = + Just $ printOutputable r <> "." <> printOutputable s +convertRecSel (HsApp _ s@(unLoc -> HsRecSel _ _) r@(unLoc -> HsPar _ _ _ _)) = + Just $ printOutputable r <> "." <> printOutputable s +convertRecSel ( OpApp _ s@(unLoc -> HsRecSel _ _) _ r) = + Just $ "(" <> printOutputable r <> ")." <> printOutputable s +convertRecSel _ = Nothing + +collectRecordSelectors :: GenericQ [RecordSelectors] +collectRecordSelectors = everything (<>) (maybeToList . (Nothing `mkQ` getRecSels)) + +getRecSels :: LHsExpr (GhcPass 'Renamed) -> Maybe RecordSelectors +-- standard record selection: "field record" +getRecSels e@(unLoc -> HsApp _ (unLoc -> HsRecSel _ _) (unLoc -> HsVar _ _)) = + listToMaybe [ RecordSelectors realSpan' (unLoc e) | RealSrcSpan realSpan' _ <- [ getLoc e ]] +-- Record selection where the field is being applied to a parenthesised expression: "field (record)" +getRecSels e@(unLoc -> HsApp _ (unLoc -> HsRecSel _ _) (unLoc -> HsPar _ _ _ _)) = + listToMaybe [ RecordSelectors realSpan' (unLoc e) | RealSrcSpan realSpan' _ <- [ getLoc e ]] +-- Record selection where the field is being applied with the "$" operator: "field $ record" +getRecSels e@(unLoc -> OpApp _ (unLoc -> HsRecSel _ _) (unLoc -> HsVar _ (unLoc -> d)) _) + | printOutputable d == "$" = listToMaybe [ RecordSelectors realSpan' (unLoc e) | RealSrcSpan realSpan' _ <- [ getLoc e ]] +getRecSels _ = Nothing + +collectConvRecSels' :: MonadIO m => IdeState -> NormalizedFilePath -> ExceptT String m CollectConvertedRecordSelectorsResult +collectConvRecSels' ideState = + handleMaybeM "Unable to TypeCheck" + . liftIO + . runAction "overloadedRecordDot.collectRecordSelectors" ideState + . use CollectRecordSelectors + diff --git a/plugins/hls-overloaded-record-dot-plugin/test/Main.hs b/plugins/hls-overloaded-record-dot-plugin/test/Main.hs new file mode 100644 index 0000000000..605d096510 --- /dev/null +++ b/plugins/hls-overloaded-record-dot-plugin/test/Main.hs @@ -0,0 +1,52 @@ +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeOperators #-} + +module Main ( main ) where + +import Data.Either (rights) +import qualified Data.Text as T +import qualified Ide.Plugin.OverloadedRecordDot as OverloadedRecordDot +import System.FilePath (()) +import Test.Hls + + +main :: IO () +main = defaultTestRunner test + +plugin :: PluginTestDescriptor OverloadedRecordDot.Log +plugin = mkPluginTestDescriptor OverloadedRecordDot.descriptor "overloaded-record-dot" + +test :: TestTree +test = testGroup "overloaded-record-dot" + [ mkTest "Simple" "Simple" 10 8 10 16, + mkTest "NoPragmaNeeded" "NoPragmaNeeded" 11 8 11 16, + mkTest "NestedParens" "NestedParens" 15 8 15 13, + mkTest "NestedDollar" "NestedDollar" 15 8 15 14 + ] + +mkTest :: TestName -> FilePath -> UInt -> UInt -> UInt -> UInt -> TestTree +mkTest title fp x1 y1 x2 y2 = + goldenWithHaskellDoc plugin title testDataDir fp "expected" "hs" $ \doc -> do + (act:_) <- getExplicitFieldsActions doc x1 y1 x2 y2 + executeCodeAction act + +getExplicitFieldsActions + :: TextDocumentIdentifier + -> UInt -> UInt -> UInt -> UInt + -> Session [CodeAction] +getExplicitFieldsActions doc x1 y1 x2 y2 = + findExplicitFieldsAction <$> getCodeActions doc range + where + range = Range (Position x1 y1) (Position x2 y2) + +findExplicitFieldsAction :: [a |? CodeAction] -> [CodeAction] +findExplicitFieldsAction = filter isExplicitFieldsCodeAction . rights . map toEither + +isExplicitFieldsCodeAction :: CodeAction -> Bool +isExplicitFieldsCodeAction CodeAction {_title} = + "Convert to record dot syntax" `T.isPrefixOf` _title + +testDataDir :: FilePath +testDataDir = "test" "testdata" diff --git a/plugins/hls-overloaded-record-dot-plugin/test/testdata/NestedDollar.expected.hs b/plugins/hls-overloaded-record-dot-plugin/test/testdata/NestedDollar.expected.hs new file mode 100644 index 0000000000..0e697f0301 --- /dev/null +++ b/plugins/hls-overloaded-record-dot-plugin/test/testdata/NestedDollar.expected.hs @@ -0,0 +1,17 @@ +{-# LANGUAGE OverloadedRecordDot #-} +data Happy = Happy {name :: String, age :: Int, happy :: Bool} + +data Building = Building {address :: String, owner :: Happy} + +main :: IO () +main = do + putStrLn test + +man :: Happy +man = Happy {name = "Happy", age = 1, happy = True} + +home :: Building +home = Building {address = "No. 10 Privet Dr.", owner = man} + +test :: String +test = (owner home).name diff --git a/plugins/hls-overloaded-record-dot-plugin/test/testdata/NestedDollar.hs b/plugins/hls-overloaded-record-dot-plugin/test/testdata/NestedDollar.hs new file mode 100644 index 0000000000..5ee9578550 --- /dev/null +++ b/plugins/hls-overloaded-record-dot-plugin/test/testdata/NestedDollar.hs @@ -0,0 +1,16 @@ +data Happy = Happy {name :: String, age :: Int, happy :: Bool} + +data Building = Building {address :: String, owner :: Happy} + +main :: IO () +main = do + putStrLn test + +man :: Happy +man = Happy {name = "Happy", age = 1, happy = True} + +home :: Building +home = Building {address = "No. 10 Privet Dr.", owner = man} + +test :: String +test = name $ owner home diff --git a/plugins/hls-overloaded-record-dot-plugin/test/testdata/NestedParens.expected.hs b/plugins/hls-overloaded-record-dot-plugin/test/testdata/NestedParens.expected.hs new file mode 100644 index 0000000000..0e697f0301 --- /dev/null +++ b/plugins/hls-overloaded-record-dot-plugin/test/testdata/NestedParens.expected.hs @@ -0,0 +1,17 @@ +{-# LANGUAGE OverloadedRecordDot #-} +data Happy = Happy {name :: String, age :: Int, happy :: Bool} + +data Building = Building {address :: String, owner :: Happy} + +main :: IO () +main = do + putStrLn test + +man :: Happy +man = Happy {name = "Happy", age = 1, happy = True} + +home :: Building +home = Building {address = "No. 10 Privet Dr.", owner = man} + +test :: String +test = (owner home).name diff --git a/plugins/hls-overloaded-record-dot-plugin/test/testdata/NestedParens.hs b/plugins/hls-overloaded-record-dot-plugin/test/testdata/NestedParens.hs new file mode 100644 index 0000000000..5704df8be3 --- /dev/null +++ b/plugins/hls-overloaded-record-dot-plugin/test/testdata/NestedParens.hs @@ -0,0 +1,16 @@ +data Happy = Happy {name :: String, age :: Int, happy :: Bool} + +data Building = Building {address :: String, owner :: Happy} + +main :: IO () +main = do + putStrLn test + +man :: Happy +man = Happy {name = "Happy", age = 1, happy = True} + +home :: Building +home = Building {address = "No. 10 Privet Dr.", owner = man} + +test :: String +test = name (owner home) diff --git a/plugins/hls-overloaded-record-dot-plugin/test/testdata/NoPragmaNeeded.expected.hs b/plugins/hls-overloaded-record-dot-plugin/test/testdata/NoPragmaNeeded.expected.hs new file mode 100644 index 0000000000..246a61ebe3 --- /dev/null +++ b/plugins/hls-overloaded-record-dot-plugin/test/testdata/NoPragmaNeeded.expected.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE OverloadedRecordDot #-} +data Happy = Happy {name :: String, age :: Int, happy :: Bool} + +main :: IO () +main = do + putStrLn test + +man :: Happy +man = Happy {name = "Happy", age = 1, happy = True} + +test :: String +test = man.name diff --git a/plugins/hls-overloaded-record-dot-plugin/test/testdata/NoPragmaNeeded.hs b/plugins/hls-overloaded-record-dot-plugin/test/testdata/NoPragmaNeeded.hs new file mode 100644 index 0000000000..0089a130f6 --- /dev/null +++ b/plugins/hls-overloaded-record-dot-plugin/test/testdata/NoPragmaNeeded.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE OverloadedRecordDot #-} +data Happy = Happy {name :: String, age :: Int, happy :: Bool} + +main :: IO () +main = do + putStrLn test + +man :: Happy +man = Happy {name = "Happy", age = 1, happy = True} + +test :: String +test = name man diff --git a/plugins/hls-overloaded-record-dot-plugin/test/testdata/Simple.expected.hs b/plugins/hls-overloaded-record-dot-plugin/test/testdata/Simple.expected.hs new file mode 100644 index 0000000000..246a61ebe3 --- /dev/null +++ b/plugins/hls-overloaded-record-dot-plugin/test/testdata/Simple.expected.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE OverloadedRecordDot #-} +data Happy = Happy {name :: String, age :: Int, happy :: Bool} + +main :: IO () +main = do + putStrLn test + +man :: Happy +man = Happy {name = "Happy", age = 1, happy = True} + +test :: String +test = man.name diff --git a/plugins/hls-overloaded-record-dot-plugin/test/testdata/Simple.hs b/plugins/hls-overloaded-record-dot-plugin/test/testdata/Simple.hs new file mode 100644 index 0000000000..e0e3ba0730 --- /dev/null +++ b/plugins/hls-overloaded-record-dot-plugin/test/testdata/Simple.hs @@ -0,0 +1,11 @@ +data Happy = Happy {name :: String, age :: Int, happy :: Bool} + +main :: IO () +main = do + putStrLn test + +man :: Happy +man = Happy {name = "Happy", age = 1, happy = True} + +test :: String +test = name man diff --git a/src/HlsPlugins.hs b/src/HlsPlugins.hs index f341208bfb..06b4c26bad 100644 --- a/src/HlsPlugins.hs +++ b/src/HlsPlugins.hs @@ -100,6 +100,10 @@ import qualified Ide.Plugin.ExplicitFixity as ExplicitFixity import qualified Ide.Plugin.ExplicitFields as ExplicitFields #endif +#if hls_overloaded_record_dot +import qualified Ide.Plugin.OverloadedRecordDot as OverloadedRecordDot +#endif + -- formatters #if hls_floskell @@ -226,11 +230,14 @@ idePlugins recorder = pluginDescToIdePlugins allPlugins let pId = "ghcide-code-actions-fill-holes" in Refactor.fillHolePluginDescriptor (pluginRecorder pId) pId : let pId = "ghcide-extend-import-action" in Refactor.extendImportPluginDescriptor (pluginRecorder pId) pId : #endif - GhcIde.descriptors (pluginRecorder "ghcide") #if explicitFixity - ++ [let pId = "explicit-fixity" in ExplicitFixity.descriptor (pluginRecorder pId) pId] + let pId = "explicit-fixity" in ExplicitFixity.descriptor (pluginRecorder pId) pId : #endif #if explicitFields - ++ [let pId = "explicit-fields" in ExplicitFields.descriptor (pluginRecorder pId) pId] + let pId = "explicit-fields" in ExplicitFields.descriptor (pluginRecorder pId) pId : #endif +#if hls_overloaded_record_dot + let pId = "overloaded-record-dot" in OverloadedRecordDot.descriptor (pluginRecorder pId) pId : +#endif + GhcIde.descriptors (pluginRecorder "ghcide")