diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/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/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/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/hls-overloaded-record-dot-plugin.cabal b/hls-overloaded-record-dot-plugin.cabal new file mode 100644 --- /dev/null +++ b/hls-overloaded-record-dot-plugin.cabal @@ -0,0 +1,65 @@ +cabal-version: 3.0 +name: hls-overloaded-record-dot-plugin +version: 2.0.0.1 +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 +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 + if impl(ghc < 9.2) + buildable: False + else + buildable: True + exposed-modules: Ide.Plugin.OverloadedRecordDot + build-depends: + , base >=4.16 && <5 + , ghcide + , hls-plugin-api + , lsp + , lens + , hls-graph + , text + , syb + , transformers + , ghc-boot-th + , unordered-containers + , containers + , deepseq + hs-source-dirs: src + default-language: GHC2021 + +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 + main-is: Main.hs + build-depends: + , base + , filepath + , text + , hls-overloaded-record-dot-plugin + , lsp-test + , hls-test-utils + diff --git a/src/Ide/Plugin/OverloadedRecordDot.hs b/src/Ide/Plugin/OverloadedRecordDot.hs new file mode 100644 --- /dev/null +++ b/src/Ide/Plugin/OverloadedRecordDot.hs @@ -0,0 +1,280 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE TypeFamilies #-} +{-# 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, + everythingBut, mkQ) +import qualified Data.HashMap.Strict as HashMap +import Data.Maybe (mapMaybe, 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, + useWithStale) +import qualified Development.IDE.Core.Shake as Shake + +#if __GLASGOW_HASKELL__ >= 903 +import Development.IDE.GHC.Compat (HsExpr (HsRecSel)) +#else +import Development.IDE.GHC.Compat (HsExpr (HsRecFld)) +#endif + +import Control.DeepSeq (rwhnf) +import Development.IDE.Core.PositionMapping (PositionMapping (PositionMapping), + toCurrentRange) +import Development.IDE.GHC.Compat (Extension (OverloadedRecordDot), + GhcPass, + HsExpansion (HsExpanded), + HsExpr (HsApp, HsPar, HsVar, OpApp, XExpr), + LHsExpr, Outputable, + Pass (..), RealSrcSpan, + appPrec, dollarName, + getLoc, hs_valds, + parenthesizeHsContext, + parenthesizeHsExpr, + pattern RealSrcSpan, + unLoc) +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 [RecordSelectorExpr] + | LogTextEdits [TextEdit] + +instance Pretty Log where + pretty = \case + LogShake shakeLog -> pretty shakeLog + LogCollectedRecordSelectors recs -> "Collected record selectors:" + <+> pretty recs + +data CollectRecordSelectors = CollectRecordSelectors + deriving (Eq, Show, Generic) + +instance Hashable CollectRecordSelectors +instance NFData CollectRecordSelectors + +data CollectRecordSelectorsResult = CRSR + { recordInfos :: RangeMap RecordSelectorExpr + , enabledExtensions :: [Extension] + } + deriving (Generic) + +instance NFData CollectRecordSelectorsResult + +instance Show CollectRecordSelectorsResult where + show _ = "" + +type instance RuleResult CollectRecordSelectors = CollectRecordSelectorsResult + +-- |Where we store our collected record selectors +data RecordSelectorExpr = RecordSelectorExpr + { -- |The location of the matched expression + location :: Range, + -- |The record selector, this is found in front of recordExpr, but get's + -- placed after it when converted into record dot syntax + selectorExpr :: LHsExpr (GhcPass 'Renamed), + -- |The record expression. The only requirement is that it evaluates to a + -- record in the end + recordExpr :: LHsExpr (GhcPass 'Renamed) } + +instance Pretty RecordSelectorExpr where + pretty (RecordSelectorExpr l rs se) = pretty (printOutputable rs) <> ":" + <+> pretty (printOutputable se) + +instance NFData RecordSelectorExpr where + rnf = rwhnf + +descriptor :: Recorder (WithPriority Log) -> PluginId + -> PluginDescriptor IdeState +descriptor recorder plId = (defaultPluginDescriptor plId) + { pluginHandlers = + mkPluginHandler STextDocumentCodeAction codeActionProvider + , pluginRules = collectRecSelsRule recorder + } + +codeActionProvider :: PluginMethodHandler IdeState 'TextDocumentCodeAction +codeActionProvider ideState pId (CodeActionParams _ _ caDocId caRange _) = + pluginResponse $ do + nfp <- getNormalizedFilePath (caDocId ^. L.uri) + pragma <- getFirstPragma pId ideState nfp + CRSR crsMap exts <- collectRecSelResult ideState nfp + let pragmaEdit = + if OverloadedRecordDot `elem` exts + then Nothing + else Just $ insertNewPragma pragma OverloadedRecordDot + edits crs = convertRecordSelectors crs : maybeToList pragmaEdit + changes crs = + Just $ HashMap.singleton (fromNormalizedUri + (normalizedFilePathToUri nfp)) + (List (edits crs)) + mkCodeAction crs = InR CodeAction + { -- We pass the record selector to the title function, so that + -- we can have the name of the record selector in the title of + -- the codeAction. This allows the user can easily distinguish + -- between the different codeActions when using nested record + -- selectors, the disadvantage is we need to print out the + -- name of the record selector which will decrease performance + _title = mkCodeActionTitle exts crs + , _kind = Just CodeActionRefactorRewrite + , _diagnostics = Nothing + , _isPreferred = Nothing + , _disabled = Nothing + , _edit = Just $ WorkspaceEdit (changes crs) Nothing Nothing + , _command = Nothing + , _xdata = Nothing + } + actions = map mkCodeAction (RangeMap.filterByRange caRange crsMap) + pure $ List actions + where + mkCodeActionTitle :: [Extension] -> RecordSelectorExpr-> Text + mkCodeActionTitle exts (RecordSelectorExpr _ se _) = + if OverloadedRecordDot `elem` exts + then title + else title <> " (needs extension: OverloadedRecordDot)" + where + title = "Convert `" <> name <> "` to record dot syntax" + name = printOutputable se + +collectRecSelsRule :: Recorder (WithPriority Log) -> Rules () +collectRecSelsRule recorder = define (cmapWithPrio LogShake recorder) $ + \CollectRecordSelectors nfp -> + useWithStale TypeCheck nfp >>= \case + -- `useWithStale` here allows us to be able to return codeActions even + -- if the file does not typecheck. The disadvantage being that we + -- sometimes will end up corrupting code. This is most obvious in that + -- used code actions will continue to be presented, and when applied + -- multiple times will almost always cause code corruption. + Nothing -> pure ([], Nothing) + Just (tmr, pm) -> do + let -- We need the file's extensions to check whether we need to add + -- the OverloadedRecordDot pragma + exts = getEnabledExtensions tmr + recSels = mapMaybe (rewriteRange pm) (getRecordSelectors tmr) + logWith recorder Debug (LogCollectedRecordSelectors recSels) + let -- We need the rangeMap to be able to filter by range later + crsMap :: RangeMap RecordSelectorExpr + crsMap = RangeMap.fromList location recSels + pure ([], CRSR <$> Just crsMap <*> Just exts) + where getEnabledExtensions :: TcModuleResult -> [Extension] + getEnabledExtensions = getExtensions . tmrParsed + getRecordSelectors :: TcModuleResult -> [RecordSelectorExpr] + getRecordSelectors (tmrRenamed -> (hs_valds -> valBinds,_,_,_)) = + collectRecordSelectors valBinds + rewriteRange :: PositionMapping -> RecordSelectorExpr + -> Maybe RecordSelectorExpr + rewriteRange pm recSel = + case toCurrentRange pm (location recSel) of + Just newLoc -> Just $ recSel{location = newLoc} + Nothing -> Nothing + +convertRecordSelectors :: RecordSelectorExpr -> TextEdit +convertRecordSelectors (RecordSelectorExpr l se re) = + TextEdit l $ convertRecSel se re + +-- |Converts a record selector expression into record dot syntax, currently we +-- are using printOutputable to do it. We are also letting GHC decide when to +-- parenthesize the record expression +convertRecSel :: Outputable (LHsExpr (GhcPass 'Renamed)) + => LHsExpr (GhcPass 'Renamed) + -> LHsExpr (GhcPass 'Renamed) -> Text +convertRecSel se re = printOutputable (parenthesizeHsExpr appPrec re) <> "." + <> printOutputable se + +collectRecordSelectors :: GenericQ [RecordSelectorExpr] +-- It's important that we use everthingBut here, because if we used everything +-- we would get duplicates for every case that occurs inside a HsExpanded +-- expression. Please see the test MultilineExpanded.hs +collectRecordSelectors = everythingBut (<>) (([], False) `mkQ` getRecSels) + +-- |We want to return a list here, because on the occasion that we encounter a +-- HsExpanded expression, we want to return all the results from recursing on +-- one branch, which could be multiple matches. Again see MultilineExpanded.hs +getRecSels :: LHsExpr (GhcPass 'Renamed) -> ([RecordSelectorExpr], Bool) +-- When we stumble upon an occurrence of HsExpanded, we only want to follow one +-- branch. We do this here, by explicitly returning occurrences from traversing +-- the original branch, and returning True, which keeps syb from implicitly +-- continuing to traverse. +getRecSels (unLoc -> XExpr (HsExpanded a _)) = (collectRecordSelectors a, True) +#if __GLASGOW_HASKELL__ >= 903 +-- applied record selection: "selector record" or "selector (record)" or +-- "selector selector2.record2" +getRecSels e@(unLoc -> HsApp _ se@(unLoc -> HsRecSel _ _) re) = + ( [ RecordSelectorExpr (realSrcSpanToRange realSpan') se re + | RealSrcSpan realSpan' _ <- [ getLoc e ] ], False ) +-- Record selection where the field is being applied with the "$" operator: +-- "selector $ record" +getRecSels e@(unLoc -> OpApp _ se@(unLoc -> HsRecSel _ _) + (unLoc -> HsVar _ (unLoc -> d)) re) | d == dollarName = + ( [ RecordSelectorExpr (realSrcSpanToRange realSpan') se re + | RealSrcSpan realSpan' _ <- [ getLoc e ] ], False ) +#else +getRecSels e@(unLoc -> HsApp _ se@(unLoc -> HsRecFld _ _) re) = + ( [ RecordSelectorExpr (realSrcSpanToRange realSpan') se re + | RealSrcSpan realSpan' _ <- [ getLoc e ] ], False ) +getRecSels e@(unLoc -> OpApp _ se@(unLoc -> HsRecFld _ _) + (unLoc -> HsVar _ (unLoc -> d)) re) | d == dollarName = + ( [ RecordSelectorExpr (realSrcSpanToRange realSpan') se re + | RealSrcSpan realSpan' _ <- [ getLoc e ] ], False ) +#endif +getRecSels _ = ([], False) + +collectRecSelResult :: MonadIO m => IdeState -> NormalizedFilePath + -> ExceptT String m CollectRecordSelectorsResult +collectRecSelResult ideState = + handleMaybeM "Unable to TypeCheck" + . liftIO + . runAction "overloadedRecordDot.collectRecordSelectors" ideState + . use CollectRecordSelectors + diff --git a/test/Main.hs b/test/Main.hs new file mode 100644 --- /dev/null +++ b/test/Main.hs @@ -0,0 +1,57 @@ +{-# 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" "name" 10 7 10 15, + mkTest "NoPragmaNeeded" "NoPragmaNeeded" "name" 11 7 11 15, + mkTest "NestedParens" "NestedParens" "name" 15 7 15 24, + mkTest "NestedDot" "NestedDot" "name" 17 7 17 22, + mkTest "NestedDollar" "NestedDollar" "name" 15 7 15 24, + mkTest "MultilineCase" "MultilineCase" "name" 10 7 12 15, + mkTest "Multiline" "Multiline" "name" 10 7 11 15, + mkTest "MultilineExpanded" "MultilineExpanded" "owner" 28 8 28 19 + ] + +mkTest :: TestName -> FilePath -> T.Text -> UInt -> UInt -> UInt -> UInt -> TestTree +mkTest title fp selectorName x1 y1 x2 y2 = + goldenWithHaskellDoc plugin title testDataDir fp "expected" "hs" $ \doc -> do + (act:_) <- getExplicitFieldsActions doc selectorName x1 y1 x2 y2 + executeCodeAction act + +getExplicitFieldsActions + :: TextDocumentIdentifier + -> T.Text + -> UInt -> UInt -> UInt -> UInt + -> Session [CodeAction] +getExplicitFieldsActions doc selectorName x1 y1 x2 y2 = + findExplicitFieldsAction selectorName <$> getCodeActions doc range + where + range = Range (Position x1 y1) (Position x2 y2) + +findExplicitFieldsAction :: T.Text -> [a |? CodeAction] -> [CodeAction] +findExplicitFieldsAction selectorName = filter (isExplicitFieldsCodeAction selectorName) . rights . map toEither + +isExplicitFieldsCodeAction :: T.Text -> CodeAction -> Bool +isExplicitFieldsCodeAction selectorName CodeAction {_title} = + ("Convert `" <> selectorName <> "` to record dot syntax") `T.isPrefixOf` _title + +testDataDir :: FilePath +testDataDir = "test" "testdata" diff --git a/test/testdata/Multiline.expected.hs b/test/testdata/Multiline.expected.hs new file mode 100644 --- /dev/null +++ b/test/testdata/Multiline.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/test/testdata/Multiline.hs b/test/testdata/Multiline.hs new file mode 100644 --- /dev/null +++ b/test/testdata/Multiline.hs @@ -0,0 +1,12 @@ +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/test/testdata/MultilineCase.expected.hs b/test/testdata/MultilineCase.expected.hs new file mode 100644 --- /dev/null +++ b/test/testdata/MultilineCase.expected.hs @@ -0,0 +1,14 @@ +{-# 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 = (case True of + True -> man + False -> man).name diff --git a/test/testdata/MultilineCase.hs b/test/testdata/MultilineCase.hs new file mode 100644 --- /dev/null +++ b/test/testdata/MultilineCase.hs @@ -0,0 +1,13 @@ +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 $ case True of + True -> man + False -> man diff --git a/test/testdata/MultilineExpanded.expected.hs b/test/testdata/MultilineExpanded.expected.hs new file mode 100644 --- /dev/null +++ b/test/testdata/MultilineExpanded.expected.hs @@ -0,0 +1,32 @@ +{-# 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} + +home2 :: Building +home2 = Building {address = "No. 6 Beach Ave.", owner = man} + +home3 :: Building +home3 = Building {address = "No. 12 Central Blvd.", owner = man} + +n:: Int +n = 3 + +test :: String +test = (case n of + 0 -> owner home + 1 -> home2.owner + 2 -> owner home3 + _ -> man).name + diff --git a/test/testdata/MultilineExpanded.hs b/test/testdata/MultilineExpanded.hs new file mode 100644 --- /dev/null +++ b/test/testdata/MultilineExpanded.hs @@ -0,0 +1,32 @@ +{-# 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} + +home2 :: Building +home2 = Building {address = "No. 6 Beach Ave.", owner = man} + +home3 :: Building +home3 = Building {address = "No. 12 Central Blvd.", owner = man} + +n:: Int +n = 3 + +test :: String +test = (case n of + 0 -> owner home + 1 -> owner home2 + 2 -> owner home3 + _ -> man).name + diff --git a/test/testdata/NestedDollar.expected.hs b/test/testdata/NestedDollar.expected.hs new file mode 100644 --- /dev/null +++ b/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/test/testdata/NestedDollar.hs b/test/testdata/NestedDollar.hs new file mode 100644 --- /dev/null +++ b/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/test/testdata/NestedDot.expected.hs b/test/testdata/NestedDot.expected.hs new file mode 100644 --- /dev/null +++ b/test/testdata/NestedDot.expected.hs @@ -0,0 +1,18 @@ +{-# 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 = home.owner.name diff --git a/test/testdata/NestedDot.hs b/test/testdata/NestedDot.hs new file mode 100644 --- /dev/null +++ b/test/testdata/NestedDot.hs @@ -0,0 +1,18 @@ +{-# 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 = name home.owner diff --git a/test/testdata/NestedParens.expected.hs b/test/testdata/NestedParens.expected.hs new file mode 100644 --- /dev/null +++ b/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/test/testdata/NestedParens.hs b/test/testdata/NestedParens.hs new file mode 100644 --- /dev/null +++ b/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/test/testdata/NoPragmaNeeded.expected.hs b/test/testdata/NoPragmaNeeded.expected.hs new file mode 100644 --- /dev/null +++ b/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/test/testdata/NoPragmaNeeded.hs b/test/testdata/NoPragmaNeeded.hs new file mode 100644 --- /dev/null +++ b/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/test/testdata/Simple.expected.hs b/test/testdata/Simple.expected.hs new file mode 100644 --- /dev/null +++ b/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/test/testdata/Simple.hs b/test/testdata/Simple.hs new file mode 100644 --- /dev/null +++ b/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