{-# LANGUAGE CPP               #-}
{-# LANGUAGE DataKinds         #-}
{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms   #-}
{-# LANGUAGE RecordWildCards   #-}
{-# 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                        (replicateM)
import           Control.Monad.IO.Class               (MonadIO, liftIO)
import           Control.Monad.Trans.Except           (ExceptT)
import           Data.Aeson                           (FromJSON, ToJSON, toJSON)
import           Data.Generics                        (GenericQ, everythingBut,
                                                       mkQ)
import qualified Data.IntMap.Strict                   as IntMap
import qualified Data.Map                             as Map
import           Data.Maybe                           (mapMaybe, maybeToList)
import           Data.Text                            (Text)
import           Data.Unique                          (hashUnique, newUnique)
import           Development.IDE                      (IdeState,
                                                       NormalizedFilePath,
                                                       Pretty (..), Range,
                                                       Recorder (..), Rules,
                                                       WithPriority (..),
                                                       realSrcSpanToRange)
import           Development.IDE.Core.RuleTypes       (TcModuleResult (..),
                                                       TypeCheck (..))
import           Development.IDE.Core.Shake           (define, 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.PluginUtils
import           Development.IDE.Core.PositionMapping (PositionMapping,
                                                       toCurrentRange)
import           Development.IDE.GHC.Compat           (Extension (OverloadedRecordDot),
                                                       GhcPass,
                                                       HsExpansion (HsExpanded),
                                                       HsExpr (HsApp, HsVar, OpApp, XExpr),
                                                       LHsExpr, Outputable,
                                                       Pass (..), appPrec,
                                                       dollarName, getLoc,
                                                       hs_valds,
                                                       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           GHC.Generics                         (Generic)
import           Ide.Logger                           (Priority (..),
                                                       cmapWithPrio, logWith,
                                                       (<+>))
import           Ide.Plugin.Error                     (PluginError (..),
                                                       getNormalizedFilePathE,
                                                       handleMaybe)
import           Ide.Plugin.RangeMap                  (RangeMap)
import qualified Ide.Plugin.RangeMap                  as RangeMap
import           Ide.Plugin.Resolve                   (mkCodeActionHandlerWithResolve)
import           Ide.Types                            (PluginDescriptor (..),
                                                       PluginId (..),
                                                       PluginMethodHandler,
                                                       ResolveFunction,
                                                       defaultPluginDescriptor)
import qualified Language.LSP.Protocol.Lens           as L
import           Language.LSP.Protocol.Message        (Method (..))
import           Language.LSP.Protocol.Types          (CodeAction (..),
                                                       CodeActionKind (CodeActionKind_RefactorRewrite),
                                                       CodeActionParams (..),
                                                       TextEdit (..), Uri (..),
                                                       WorkspaceEdit (WorkspaceEdit, _changeAnnotations, _changes, _documentChanges),
                                                       type (|?) (..))

data Log
    = LogShake Shake.Log
    | LogCollectedRecordSelectors [RecordSelectorExpr]
    | forall a. (Pretty a) => LogResolve a

instance Pretty Log where
    pretty :: forall ann. Log -> Doc ann
pretty = \case
        LogShake Log
shakeLog -> forall a ann. Pretty a => a -> Doc ann
pretty Log
shakeLog
        LogCollectedRecordSelectors [RecordSelectorExpr]
recs -> Doc ann
"Collected record selectors:"
                                                forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty [RecordSelectorExpr]
recs
        LogResolve a
msg -> forall a ann. Pretty a => a -> Doc ann
pretty a
msg

data CollectRecordSelectors = CollectRecordSelectors
                    deriving (CollectRecordSelectors -> CollectRecordSelectors -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CollectRecordSelectors -> CollectRecordSelectors -> Bool
$c/= :: CollectRecordSelectors -> CollectRecordSelectors -> Bool
== :: CollectRecordSelectors -> CollectRecordSelectors -> Bool
$c== :: CollectRecordSelectors -> CollectRecordSelectors -> Bool
Eq, Int -> CollectRecordSelectors -> ShowS
[CollectRecordSelectors] -> ShowS
CollectRecordSelectors -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CollectRecordSelectors] -> ShowS
$cshowList :: [CollectRecordSelectors] -> ShowS
show :: CollectRecordSelectors -> String
$cshow :: CollectRecordSelectors -> String
showsPrec :: Int -> CollectRecordSelectors -> ShowS
$cshowsPrec :: Int -> CollectRecordSelectors -> ShowS
Show, forall x. Rep CollectRecordSelectors x -> CollectRecordSelectors
forall x. CollectRecordSelectors -> Rep CollectRecordSelectors x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CollectRecordSelectors x -> CollectRecordSelectors
$cfrom :: forall x. CollectRecordSelectors -> Rep CollectRecordSelectors x
Generic)

instance Hashable CollectRecordSelectors
instance NFData CollectRecordSelectors

data CollectRecordSelectorsResult = CRSR
    { -- |We store everything in here that we need to create the unresolved
      -- codeAction: the range, an uniquely identifiable int, and the selector
      --selector expression  (HSExpr) that we use to generate the name
      CollectRecordSelectorsResult
-> RangeMap (Int, HsExpr (GhcPass 'Renamed))
records           :: RangeMap (Int, HsExpr (GhcPass 'Renamed))
      -- |This is for when we need to fully generate a textEdit. It contains the
      -- whole expression we are interested in indexed to the unique id we got
      -- from the previous field
    , CollectRecordSelectorsResult -> IntMap RecordSelectorExpr
recordInfos       :: IntMap.IntMap RecordSelectorExpr
    , CollectRecordSelectorsResult -> [Extension]
enabledExtensions :: [Extension]
    }
    deriving (forall x.
Rep CollectRecordSelectorsResult x -> CollectRecordSelectorsResult
forall x.
CollectRecordSelectorsResult -> Rep CollectRecordSelectorsResult x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CollectRecordSelectorsResult x -> CollectRecordSelectorsResult
$cfrom :: forall x.
CollectRecordSelectorsResult -> Rep CollectRecordSelectorsResult x
Generic)

instance NFData CollectRecordSelectorsResult

instance Show CollectRecordSelectorsResult where
    show :: CollectRecordSelectorsResult -> String
show CollectRecordSelectorsResult
_ = String
"<CollectRecordsResult>"

type instance RuleResult CollectRecordSelectors = CollectRecordSelectorsResult

-- |Where we store our collected record selectors
data RecordSelectorExpr = RecordSelectorExpr
    { -- |The location of the matched expression
    RecordSelectorExpr -> Range
location     :: Range,
    -- |The record selector, this is found in front of recordExpr, but get's
    -- placed after it when converted into record dot syntax
    RecordSelectorExpr -> LHsExpr (GhcPass 'Renamed)
selectorExpr :: LHsExpr (GhcPass 'Renamed),
    -- |The record expression. The only requirement is that it evaluates to a
    -- record in the end
    RecordSelectorExpr -> LHsExpr (GhcPass 'Renamed)
recordExpr   :: LHsExpr (GhcPass 'Renamed) }

instance Pretty RecordSelectorExpr where
    pretty :: forall ann. RecordSelectorExpr -> Doc ann
pretty (RecordSelectorExpr Range
_ LHsExpr (GhcPass 'Renamed)
rs LHsExpr (GhcPass 'Renamed)
se) = forall a ann. Pretty a => a -> Doc ann
pretty (forall a. Outputable a => a -> Text
printOutputable LHsExpr (GhcPass 'Renamed)
rs) forall a. Semigroup a => a -> a -> a
<> Doc ann
":"
                                            forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty (forall a. Outputable a => a -> Text
printOutputable LHsExpr (GhcPass 'Renamed)
se)

instance NFData RecordSelectorExpr where
  rnf :: RecordSelectorExpr -> ()
rnf = forall a. a -> ()
rwhnf

-- |The data that is serialized and placed in the data field of resolvable
-- code actions
data ORDResolveData = ORDRD {
  -- |We need the uri to get shake results
  ORDResolveData -> Uri
uri      :: Uri
  -- |The unique id that allows us to find the specific codeAction we want
, ORDResolveData -> Int
uniqueID :: Int
} deriving (forall x. Rep ORDResolveData x -> ORDResolveData
forall x. ORDResolveData -> Rep ORDResolveData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ORDResolveData x -> ORDResolveData
$cfrom :: forall x. ORDResolveData -> Rep ORDResolveData x
Generic, Int -> ORDResolveData -> ShowS
[ORDResolveData] -> ShowS
ORDResolveData -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ORDResolveData] -> ShowS
$cshowList :: [ORDResolveData] -> ShowS
show :: ORDResolveData -> String
$cshow :: ORDResolveData -> String
showsPrec :: Int -> ORDResolveData -> ShowS
$cshowsPrec :: Int -> ORDResolveData -> ShowS
Show)
instance ToJSON ORDResolveData
instance FromJSON ORDResolveData

descriptor :: Recorder (WithPriority Log) -> PluginId
                -> PluginDescriptor IdeState
descriptor :: Recorder (WithPriority Log)
-> PluginId -> PluginDescriptor IdeState
descriptor Recorder (WithPriority Log)
recorder PluginId
plId =
  let resolveRecorder :: Recorder (WithPriority Log)
resolveRecorder = forall a b.
(a -> b) -> Recorder (WithPriority b) -> Recorder (WithPriority a)
cmapWithPrio forall a. Pretty a => a -> Log
LogResolve Recorder (WithPriority Log)
recorder
      pluginHandler :: PluginHandlers IdeState
pluginHandler = forall ideState a.
FromJSON a =>
Recorder (WithPriority Log)
-> PluginMethodHandler ideState 'Method_TextDocumentCodeAction
-> ResolveFunction ideState a 'Method_CodeActionResolve
-> PluginHandlers ideState
mkCodeActionHandlerWithResolve Recorder (WithPriority Log)
resolveRecorder PluginMethodHandler IdeState 'Method_TextDocumentCodeAction
codeActionProvider ResolveFunction IdeState ORDResolveData 'Method_CodeActionResolve
resolveProvider
  in (forall ideState. PluginId -> PluginDescriptor ideState
defaultPluginDescriptor PluginId
plId)
    { pluginHandlers :: PluginHandlers IdeState
pluginHandlers = PluginHandlers IdeState
pluginHandler
    , pluginRules :: Rules ()
pluginRules = Recorder (WithPriority Log) -> Rules ()
collectRecSelsRule Recorder (WithPriority Log)
recorder
    }

resolveProvider :: ResolveFunction IdeState ORDResolveData 'Method_CodeActionResolve
resolveProvider :: ResolveFunction IdeState ORDResolveData 'Method_CodeActionResolve
resolveProvider IdeState
ideState PluginId
plId MessageParams 'Method_CodeActionResolve
ca Uri
uri (ORDRD Uri
_ Int
int) =
  do
    NormalizedFilePath
nfp <- forall (m :: * -> *).
Monad m =>
Uri -> ExceptT PluginError m NormalizedFilePath
getNormalizedFilePathE Uri
uri
    CRSR RangeMap (Int, HsExpr (GhcPass 'Renamed))
_ IntMap RecordSelectorExpr
crsDetails [Extension]
exts <- forall (m :: * -> *).
MonadIO m =>
IdeState
-> NormalizedFilePath
-> ExceptT PluginError m CollectRecordSelectorsResult
collectRecSelResult IdeState
ideState NormalizedFilePath
nfp
    NextPragmaInfo
pragma <- forall (m :: * -> *).
MonadIO m =>
PluginId
-> IdeState
-> NormalizedFilePath
-> ExceptT PluginError m NextPragmaInfo
getFirstPragma PluginId
plId IdeState
ideState NormalizedFilePath
nfp
    RecordSelectorExpr
rse <- forall (m :: * -> *) e b. Monad m => e -> Maybe b -> ExceptT e m b
handleMaybe PluginError
PluginStaleResolve forall a b. (a -> b) -> a -> b
$ forall a. Int -> IntMap a -> Maybe a
IntMap.lookup Int
int IntMap RecordSelectorExpr
crsDetails
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ MessageParams 'Method_CodeActionResolve
ca {$sel:_edit:CodeAction :: Maybe WorkspaceEdit
_edit = Uri
-> RecordSelectorExpr
-> [Extension]
-> NextPragmaInfo
-> Maybe WorkspaceEdit
mkWorkspaceEdit Uri
uri RecordSelectorExpr
rse [Extension]
exts NextPragmaInfo
pragma}

codeActionProvider :: PluginMethodHandler IdeState 'Method_TextDocumentCodeAction
codeActionProvider :: PluginMethodHandler IdeState 'Method_TextDocumentCodeAction
codeActionProvider IdeState
ideState PluginId
_ (CodeActionParams Maybe ProgressToken
_ Maybe ProgressToken
_ TextDocumentIdentifier
caDocId Range
caRange CodeActionContext
_) =
    do
        NormalizedFilePath
nfp <- forall (m :: * -> *).
Monad m =>
Uri -> ExceptT PluginError m NormalizedFilePath
getNormalizedFilePathE (TextDocumentIdentifier
caDocId forall s a. s -> Getting a s a -> a
^. forall s a. HasUri s a => Lens' s a
L.uri)
        CRSR RangeMap (Int, HsExpr (GhcPass 'Renamed))
crsMap IntMap RecordSelectorExpr
_ [Extension]
exts <- forall (m :: * -> *).
MonadIO m =>
IdeState
-> NormalizedFilePath
-> ExceptT PluginError m CollectRecordSelectorsResult
collectRecSelResult IdeState
ideState NormalizedFilePath
nfp
        let mkCodeAction :: (Int, HsExpr (GhcPass 'Renamed)) -> Command |? CodeAction
mkCodeAction (Int
crsM, HsExpr (GhcPass 'Renamed)
nse)  = forall a b. b -> a |? b
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
                  $sel:_title:CodeAction :: Text
_title = [Extension] -> HsExpr (GhcPass 'Renamed) -> Text
mkCodeActionTitle [Extension]
exts HsExpr (GhcPass 'Renamed)
nse
                , $sel:_kind:CodeAction :: Maybe CodeActionKind
_kind = forall a. a -> Maybe a
Just CodeActionKind
CodeActionKind_RefactorRewrite
                , $sel:_diagnostics:CodeAction :: Maybe [Diagnostic]
_diagnostics = forall a. Maybe a
Nothing
                , $sel:_isPreferred:CodeAction :: Maybe Bool
_isPreferred = forall a. Maybe a
Nothing
                , $sel:_disabled:CodeAction :: Maybe (Rec (("reason" .== Text) .+ Empty))
_disabled = forall a. Maybe a
Nothing
                , $sel:_edit:CodeAction :: Maybe WorkspaceEdit
_edit = forall a. Maybe a
Nothing
                , $sel:_command:CodeAction :: Maybe Command
_command = forall a. Maybe a
Nothing
                , $sel:_data_:CodeAction :: Maybe Value
_data_ = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => a -> Value
toJSON forall a b. (a -> b) -> a -> b
$ Uri -> Int -> ORDResolveData
ORDRD (TextDocumentIdentifier
caDocId forall s a. s -> Getting a s a -> a
^. forall s a. HasUri s a => Lens' s a
L.uri) Int
crsM
                }
            actions :: [Command |? CodeAction]
actions = forall a b. (a -> b) -> [a] -> [b]
map (Int, HsExpr (GhcPass 'Renamed)) -> Command |? CodeAction
mkCodeAction (forall a. Range -> RangeMap a -> [a]
RangeMap.filterByRange Range
caRange RangeMap (Int, HsExpr (GhcPass 'Renamed))
crsMap)
        forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. a -> a |? b
InL [Command |? CodeAction]
actions
    where
    mkCodeActionTitle :: [Extension] -> HsExpr (GhcPass 'Renamed) -> Text
    mkCodeActionTitle :: [Extension] -> HsExpr (GhcPass 'Renamed) -> Text
mkCodeActionTitle [Extension]
exts HsExpr (GhcPass 'Renamed)
se =
        if Extension
OverloadedRecordDot forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Extension]
exts
            then Text
title
            else Text
title forall a. Semigroup a => a -> a -> a
<> Text
" (needs extension: OverloadedRecordDot)"
        where
            title :: Text
title = Text
"Convert `" forall a. Semigroup a => a -> a -> a
<> forall a. Outputable a => a -> Text
printOutputable HsExpr (GhcPass 'Renamed)
se forall a. Semigroup a => a -> a -> a
<> Text
"` to record dot syntax"

mkWorkspaceEdit:: Uri -> RecordSelectorExpr -> [Extension] -> NextPragmaInfo-> Maybe WorkspaceEdit
mkWorkspaceEdit :: Uri
-> RecordSelectorExpr
-> [Extension]
-> NextPragmaInfo
-> Maybe WorkspaceEdit
mkWorkspaceEdit Uri
uri RecordSelectorExpr
recSel [Extension]
exts NextPragmaInfo
pragma =
    forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ WorkspaceEdit
    { $sel:_changes:WorkspaceEdit :: Maybe (Map Uri [TextEdit])
_changes =
        forall a. a -> Maybe a
Just (forall k a. k -> a -> Map k a
Map.singleton Uri
uri (RecordSelectorExpr -> TextEdit
convertRecordSelectors RecordSelectorExpr
recSel forall a. a -> [a] -> [a]
: forall a. Maybe a -> [a]
maybeToList Maybe TextEdit
pragmaEdit))
    , $sel:_documentChanges:WorkspaceEdit :: Maybe
  [TextDocumentEdit |? (CreateFile |? (RenameFile |? DeleteFile))]
_documentChanges = forall a. Maybe a
Nothing
    , $sel:_changeAnnotations:WorkspaceEdit :: Maybe (Map ChangeAnnotationIdentifier ChangeAnnotation)
_changeAnnotations = forall a. Maybe a
Nothing}
    where pragmaEdit :: Maybe TextEdit
pragmaEdit =
            if Extension
OverloadedRecordDot forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Extension]
exts
            then forall a. Maybe a
Nothing
            else forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ NextPragmaInfo -> Extension -> TextEdit
insertNewPragma NextPragmaInfo
pragma Extension
OverloadedRecordDot

collectRecSelsRule :: Recorder (WithPriority Log) -> Rules ()
collectRecSelsRule :: Recorder (WithPriority Log) -> Rules ()
collectRecSelsRule Recorder (WithPriority Log)
recorder = forall k v.
IdeRule k v =>
Recorder (WithPriority Log)
-> (k -> NormalizedFilePath -> Action (IdeResult v)) -> Rules ()
define (forall a b.
(a -> b) -> Recorder (WithPriority b) -> Recorder (WithPriority a)
cmapWithPrio Log -> Log
LogShake Recorder (WithPriority Log)
recorder) forall a b. (a -> b) -> a -> b
$
    \CollectRecordSelectors
CollectRecordSelectors NormalizedFilePath
nfp ->
        forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe (v, PositionMapping))
useWithStale TypeCheck
TypeCheck NormalizedFilePath
nfp forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \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.
        Maybe (TcModuleResult, PositionMapping)
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ([], forall a. Maybe a
Nothing)
        Just (TcModuleResult
tmr, PositionMapping
pm) -> do
            let -- We need the file's extensions to check whether we need to add
                -- the OverloadedRecordDot pragma
                exts :: [Extension]
exts = TcModuleResult -> [Extension]
getEnabledExtensions TcModuleResult
tmr
                recSels :: [RecordSelectorExpr]
recSels = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (PositionMapping -> RecordSelectorExpr -> Maybe RecordSelectorExpr
rewriteRange PositionMapping
pm) (TcModuleResult -> [RecordSelectorExpr]
getRecordSelectors TcModuleResult
tmr)
            -- We are creating a list as long as our rec selectors of unique int s
            -- created by calling hashUnique on a Unique. The reason why we are
            -- extracting the ints is because they don't need any work to serialize.
            [Int]
uniques <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (forall (t :: * -> *) a. Foldable t => t a -> Int
length [RecordSelectorExpr]
recSels) (Unique -> Int
hashUnique forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Unique
newUnique)
            forall (m :: * -> *) msg.
(HasCallStack, MonadIO m) =>
Recorder (WithPriority msg) -> Priority -> msg -> m ()
logWith Recorder (WithPriority Log)
recorder Priority
Debug ([RecordSelectorExpr] -> Log
LogCollectedRecordSelectors [RecordSelectorExpr]
recSels)
            let crsUniquesAndDetails :: [(Int, RecordSelectorExpr)]
crsUniquesAndDetails =  forall a b. [a] -> [b] -> [(a, b)]
zip [Int]
uniques [RecordSelectorExpr]
recSels
                -- We need the rangeMap to be able to filter by range later
                rangeAndUnique :: [(Range, (Int, HsExpr (GhcPass 'Renamed)))]
rangeAndUnique = forall {a}.
(a, RecordSelectorExpr) -> (Range, (a, HsExpr (GhcPass 'Renamed)))
toRangeAndUnique forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Int, RecordSelectorExpr)]
crsUniquesAndDetails
                crsMap :: RangeMap (Int,  HsExpr (GhcPass 'Renamed))
                crsMap :: RangeMap (Int, HsExpr (GhcPass 'Renamed))
crsMap = forall a. [(Range, a)] -> RangeMap a
RangeMap.fromList' [(Range, (Int, HsExpr (GhcPass 'Renamed)))]
rangeAndUnique
            forall (f :: * -> *) a. Applicative f => a -> f a
pure ([], RangeMap (Int, HsExpr (GhcPass 'Renamed))
-> IntMap RecordSelectorExpr
-> [Extension]
-> CollectRecordSelectorsResult
CRSR forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. a -> Maybe a
Just RangeMap (Int, HsExpr (GhcPass 'Renamed))
crsMap forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. a -> Maybe a
Just (forall a. [(Int, a)] -> IntMap a
IntMap.fromList [(Int, RecordSelectorExpr)]
crsUniquesAndDetails) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. a -> Maybe a
Just [Extension]
exts)
    where getEnabledExtensions :: TcModuleResult -> [Extension]
          getEnabledExtensions :: TcModuleResult -> [Extension]
getEnabledExtensions = ParsedModule -> [Extension]
getExtensions forall b c a. (b -> c) -> (a -> b) -> a -> c
. TcModuleResult -> ParsedModule
tmrParsed
          getRecordSelectors :: TcModuleResult -> [RecordSelectorExpr]
          getRecordSelectors :: TcModuleResult -> [RecordSelectorExpr]
getRecordSelectors (TcModuleResult -> RenamedSource
tmrRenamed -> (forall p. HsGroup p -> HsValBinds p
hs_valds -> HsValBinds (GhcPass 'Renamed)
valBinds,[LImportDecl (GhcPass 'Renamed)]
_,Maybe [(LIE (GhcPass 'Renamed), Avails)]
_,Maybe LHsDocString
_)) =
            GenericQ [RecordSelectorExpr]
collectRecordSelectors HsValBinds (GhcPass 'Renamed)
valBinds
          rewriteRange :: PositionMapping -> RecordSelectorExpr
                            -> Maybe RecordSelectorExpr
          rewriteRange :: PositionMapping -> RecordSelectorExpr -> Maybe RecordSelectorExpr
rewriteRange PositionMapping
pm RecordSelectorExpr
recSel =
            case PositionMapping -> Range -> Maybe Range
toCurrentRange PositionMapping
pm (RecordSelectorExpr -> Range
location RecordSelectorExpr
recSel) of
                Just Range
newLoc -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ RecordSelectorExpr
recSel{location :: Range
location = Range
newLoc}
                Maybe Range
Nothing     -> forall a. Maybe a
Nothing
          toRangeAndUnique :: (a, RecordSelectorExpr) -> (Range, (a, HsExpr (GhcPass 'Renamed)))
toRangeAndUnique (a
uid, RecordSelectorExpr Range
l (forall l e. GenLocated l e -> e
unLoc -> HsExpr (GhcPass 'Renamed)
se) LHsExpr (GhcPass 'Renamed)
_) = (Range
l, (a
uid, HsExpr (GhcPass 'Renamed)
se))

convertRecordSelectors :: RecordSelectorExpr ->  TextEdit
convertRecordSelectors :: RecordSelectorExpr -> TextEdit
convertRecordSelectors RecordSelectorExpr{LHsExpr (GhcPass 'Renamed)
Range
recordExpr :: LHsExpr (GhcPass 'Renamed)
selectorExpr :: LHsExpr (GhcPass 'Renamed)
location :: Range
recordExpr :: RecordSelectorExpr -> LHsExpr (GhcPass 'Renamed)
selectorExpr :: RecordSelectorExpr -> LHsExpr (GhcPass 'Renamed)
location :: RecordSelectorExpr -> Range
..} =
    Range -> Text -> TextEdit
TextEdit Range
location forall a b. (a -> b) -> a -> b
$ Outputable (LHsExpr (GhcPass 'Renamed)) =>
LHsExpr (GhcPass 'Renamed) -> LHsExpr (GhcPass 'Renamed) -> Text
convertRecSel LHsExpr (GhcPass 'Renamed)
selectorExpr LHsExpr (GhcPass 'Renamed)
recordExpr

-- |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 :: Outputable (LHsExpr (GhcPass 'Renamed)) =>
LHsExpr (GhcPass 'Renamed) -> LHsExpr (GhcPass 'Renamed) -> Text
convertRecSel LHsExpr (GhcPass 'Renamed)
se LHsExpr (GhcPass 'Renamed)
re = forall a. Outputable a => a -> Text
printOutputable (forall (p :: Pass).
IsPass p =>
PprPrec -> LHsExpr (GhcPass p) -> LHsExpr (GhcPass p)
parenthesizeHsExpr PprPrec
appPrec LHsExpr (GhcPass 'Renamed)
re) forall a. Semigroup a => a -> a -> a
<> Text
"."
                        forall a. Semigroup a => a -> a -> a
<> forall a. Outputable a => a -> Text
printOutputable LHsExpr (GhcPass 'Renamed)
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 :: GenericQ [RecordSelectorExpr]
collectRecordSelectors = forall r. (r -> r -> r) -> GenericQ (r, Bool) -> GenericQ r
everythingBut forall a. Semigroup a => a -> a -> a
(<>) (([], Bool
False) forall a b r. (Typeable a, Typeable b) => r -> (b -> r) -> a -> r
`mkQ` LHsExpr (GhcPass 'Renamed) -> ([RecordSelectorExpr], Bool)
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 :: LHsExpr (GhcPass 'Renamed) -> ([RecordSelectorExpr], Bool)
getRecSels (forall l e. GenLocated l e -> e
unLoc -> XExpr (HsExpanded HsExpr (GhcPass 'Renamed)
a HsExpr (GhcPass 'Renamed)
_)) = (GenericQ [RecordSelectorExpr]
collectRecordSelectors HsExpr (GhcPass 'Renamed)
a, Bool
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 :: LHsExpr (GhcPass 'Renamed)
e@(forall l e. GenLocated l e -> e
unLoc -> HsApp XApp (GhcPass 'Renamed)
_ se :: LHsExpr (GhcPass 'Renamed)
se@(forall l e. GenLocated l e -> e
unLoc -> HsRecFld XRecFld (GhcPass 'Renamed)
_ AmbiguousFieldOcc (GhcPass 'Renamed)
_) LHsExpr (GhcPass 'Renamed)
re) =
    ( [ Range
-> LHsExpr (GhcPass 'Renamed)
-> LHsExpr (GhcPass 'Renamed)
-> RecordSelectorExpr
RecordSelectorExpr (RealSrcSpan -> Range
realSrcSpanToRange RealSrcSpan
realSpan') LHsExpr (GhcPass 'Renamed)
se LHsExpr (GhcPass 'Renamed)
re
      | RealSrcSpan RealSrcSpan
realSpan' Maybe BufSpan
_ <- [ forall a. HasSrcSpan a => a -> SrcSpan
getLoc LHsExpr (GhcPass 'Renamed)
e ] ], Bool
False )
getRecSels e :: LHsExpr (GhcPass 'Renamed)
e@(forall l e. GenLocated l e -> e
unLoc -> OpApp XOpApp (GhcPass 'Renamed)
_ se :: LHsExpr (GhcPass 'Renamed)
se@(forall l e. GenLocated l e -> e
unLoc -> HsRecFld XRecFld (GhcPass 'Renamed)
_ AmbiguousFieldOcc (GhcPass 'Renamed)
_)
                        (forall l e. GenLocated l e -> e
unLoc -> HsVar XVar (GhcPass 'Renamed)
_ (forall l e. GenLocated l e -> e
unLoc -> Name
d)) LHsExpr (GhcPass 'Renamed)
re) | Name
d forall a. Eq a => a -> a -> Bool
== Name
dollarName =
    ( [ Range
-> LHsExpr (GhcPass 'Renamed)
-> LHsExpr (GhcPass 'Renamed)
-> RecordSelectorExpr
RecordSelectorExpr (RealSrcSpan -> Range
realSrcSpanToRange RealSrcSpan
realSpan')  LHsExpr (GhcPass 'Renamed)
se LHsExpr (GhcPass 'Renamed)
re
      | RealSrcSpan RealSrcSpan
realSpan' Maybe BufSpan
_ <- [ forall a. HasSrcSpan a => a -> SrcSpan
getLoc LHsExpr (GhcPass 'Renamed)
e ] ], Bool
False )
#endif
getRecSels LHsExpr (GhcPass 'Renamed)
_ = ([], Bool
False)

collectRecSelResult :: MonadIO m => IdeState -> NormalizedFilePath
                        -> ExceptT PluginError m CollectRecordSelectorsResult
collectRecSelResult :: forall (m :: * -> *).
MonadIO m =>
IdeState
-> NormalizedFilePath
-> ExceptT PluginError m CollectRecordSelectorsResult
collectRecSelResult IdeState
ideState =
    forall (m :: * -> *) e a.
MonadIO m =>
String -> IdeState -> ExceptT e Action a -> ExceptT e m a
runActionE String
"overloadedRecordDot.collectRecordSelectors" IdeState
ideState
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> ExceptT PluginError Action v
useE CollectRecordSelectors
CollectRecordSelectors