Skip to content

Consider HsExpanded expressions during SYB traversal #3579

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Closed
wants to merge 1 commit into from
Closed

Consider HsExpanded expressions during SYB traversal #3579

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
36 changes: 24 additions & 12 deletions plugins/hls-explicit-record-fields-plugin/src/Ide/Plugin/ExplicitFields.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -6,6 +6,7 @@
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE ViewPatterns #-}
Expand All @@ -18,12 +19,13 @@ module Ide.Plugin.ExplicitFields
import Control.Lens ((^.))
import Control.Monad.IO.Class (MonadIO, liftIO)
import Control.Monad.Trans.Except (ExceptT)
import Data.Bifunctor (first)
import Data.Functor ((<&>))
import Data.Generics (GenericQ, everything, extQ,
mkQ)
import Data.Generics (GenericQ, everything,
everythingBut, extQ, mkQ)
import qualified Data.HashMap.Strict as HashMap
import Data.Maybe (isJust, listToMaybe,
maybeToList, fromMaybe)
import Data.Maybe (fromMaybe, isJust,
listToMaybe, maybeToList)
import Data.Text (Text)
import Development.IDE (IdeState, NormalizedFilePath,
Pretty (..), Recorder (..),
Expand All @@ -36,11 +38,11 @@ import Development.IDE.Core.Shake (define, use)
import qualified Development.IDE.Core.Shake as Shake
import Development.IDE.GHC.Compat (HsConDetails (RecCon),
HsRecFields (..), LPat,
Outputable, getLoc, unLoc,
recDotDot)
Outputable, getLoc, recDotDot,
unLoc)
import Development.IDE.GHC.Compat.Core (Extension (NamedFieldPuns),
GhcPass,
HsExpr (RecordCon, rcon_flds),
GhcPass, HsExpansion (..),
HsExpr (RecordCon, XExpr, rcon_flds),
HsRecField, LHsExpr, LocatedA,
Name, Pass (..), Pat (..),
RealSrcSpan, UniqFM,
Expand Down Expand Up @@ -329,8 +331,13 @@ showRecordCon expr@(RecordCon _ _ flds) =
expr { rcon_flds = preprocessRecordCon flds }
showRecordCon _ = Nothing

-- 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.
collectRecords :: GenericQ [RecordInfo]
collectRecords = everything (<>) (maybeToList . (Nothing `mkQ` getRecPatterns `extQ` getRecCons))
collectRecords =
everythingBut (<>) (first maybeToList . ((Nothing, False) `mkQ` getRecPatterns' `extQ` getRecCons))
where
getRecPatterns' = (,False) . getRecPatterns

-- | Collect 'Name's into a map, indexed by the names' unique identifiers.
-- The 'Eq' instance of 'Name's makes use of their unique identifiers, hence
Expand All @@ -347,14 +354,19 @@ collectRecords = everything (<>) (maybeToList . (Nothing `mkQ` getRecPatterns `e
collectNames :: GenericQ (UniqFM Name [Name])
collectNames = everything (plusUFM_C (<>)) (emptyUFM `mkQ` (\x -> unitUFM x [x]))

getRecCons :: LHsExpr (GhcPass 'Renamed) -> Maybe RecordInfo
getRecCons :: LHsExpr (GhcPass 'Renamed) -> (Maybe RecordInfo, Bool)
Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

The problem with returning a Maybe instead of a List here is that you can only return one match from within the HsExpanded expression, even though there could be multiple matches. This example showcases this.

{-# LANGUAGE Haskell2010 #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE OverloadedRecordDot #-}
module Construction where

data MyRec = MyRec
  { foo :: Int
  , bar :: Int
  , baz :: Char
  }

data YourRec = YourRec
  { foo2 :: MyRec
  , bar2 :: Int
  , baz2 :: Char
  }

myRecExample = MyRec {..}
  where
    foo = 5
    bar = 6
    baz = 'a'

yourRecExample = YourRec {..}
    where
        foo2 = myRecExample
        bar2 = 5
        baz2 = 'a'

convertMe :: () -> Int
convertMe _ =
  (let MyRec{..} = myRecExample
       YourRec{..} = yourRecExample
    in foo2).foo

In this case, your code, would only offer to rewrite the first matched wildcard instead of both.
This example is very constructed, however, HsExpansion could possibly be used for more cases in the future, which would cause these sorts of edge cases to also appear more often.

-- When we stumble upon an occurrence of HsExpanded, we only want to follow a
-- single 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.
getRecCons (unLoc -> XExpr (HsExpanded _ expanded)) = (listToMaybe (collectRecords expanded), True)
getRecCons e@(unLoc -> RecordCon _ _ flds)
| isJust (rec_dotdot flds) = mkRecInfo e
| isJust (rec_dotdot flds) = (mkRecInfo e, False)
where
mkRecInfo :: LHsExpr (GhcPass 'Renamed) -> Maybe RecordInfo
mkRecInfo expr = listToMaybe
[ RecordInfoCon realSpan' (unLoc expr) | RealSrcSpan realSpan' _ <- [ getLoc expr ]]
getRecCons _ = Nothing
getRecCons _ = (Nothing, False)

getRecPatterns :: LPat (GhcPass 'Renamed) -> Maybe RecordInfo
getRecPatterns conPat@(conPatDetails . unLoc -> Just (RecCon flds))
Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

ConPat can also occur inside an HsExpanded expression. For example, the constructed example above uses ConPat (because the wildcards occur in the let binding)

Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Actually thinking about it though, you shouldn't need to change this, because getRecCon should already, by calling collectRecords, return both RecordCon and ConPat matches. May want to point that out in the comments though.

Expand Down
11 changes: 8 additions & 3 deletions plugins/hls-explicit-record-fields-plugin/test/Main.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -27,6 +27,7 @@ test = testGroup "explicit-fields"
, mkTest "WithExplicitBind" "WithExplicitBind" 12 10 12 32
, mkTest "Mixed" "Mixed" 14 10 14 37
, mkTest "Construction" "Construction" 16 5 16 15
, mkTest "Construction (Dot)" "3574" 16 5 16 15
, mkTestNoAction "ExplicitBinds" "ExplicitBinds" 11 10 11 52
, mkTestNoAction "Puns" "Puns" 12 10 12 31
, mkTestNoAction "Infix" "Infix" 11 11 11 31
Expand All @@ -41,12 +42,16 @@ mkTestNoAction title fp x1 y1 x2 y2 =
actions <- getExplicitFieldsActions doc x1 y1 x2 y2
liftIO $ actions @?= []

mkTest :: TestName -> FilePath -> UInt -> UInt -> UInt -> UInt -> TestTree
mkTest title fp x1 y1 x2 y2 =
mkTestWithCount :: Int -> TestName -> FilePath -> UInt -> UInt -> UInt -> UInt -> TestTree
mkTestWithCount cnt title fp x1 y1 x2 y2 =
goldenWithHaskellDoc plugin title testDataDir fp "expected" "hs" $ \doc -> do
(act:_) <- getExplicitFieldsActions doc x1 y1 x2 y2
acts@(act:_) <- getExplicitFieldsActions doc x1 y1 x2 y2
liftIO $ length acts @?= cnt
executeCodeAction act

mkTest :: TestName -> FilePath -> UInt -> UInt -> UInt -> UInt -> TestTree
mkTest = mkTestWithCount 1

getExplicitFieldsActions
:: TextDocumentIdentifier
-> UInt -> UInt -> UInt -> UInt
Expand Down
18 changes: 18 additions & 0 deletions plugins/hls-explicit-record-fields-plugin/test/testdata/3574.expected.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -0,0 +1,18 @@
{-# LANGUAGE Haskell2010 #-}
{-# LANGUAGE RecordWildCards #-}
{-# Language OverloadedRecordDot #-}
{-# LANGUAGE NamedFieldPuns #-}
module Construction where

data MyRec = MyRec
{ foo :: Int
, bar :: Int
, baz :: Char
}

convertMe :: () -> Int
convertMe _ =
let foo = 3
bar = 5
baz = 'a'
in MyRec {foo, bar, baz}.foo
17 changes: 17 additions & 0 deletions plugins/hls-explicit-record-fields-plugin/test/testdata/3574.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -0,0 +1,17 @@
{-# LANGUAGE Haskell2010 #-}
{-# LANGUAGE RecordWildCards #-}
{-# Language OverloadedRecordDot #-}
module Construction where

data MyRec = MyRec
{ foo :: Int
, bar :: Int
, baz :: Char
}

convertMe :: () -> Int
convertMe _ =
let foo = 3
bar = 5
baz = 'a'
in MyRec {..}.foo