{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
module Ide.Plugin.AlternateNumberFormat (descriptor) where
import Control.Lens ((^.))
import Control.Monad.Except (ExceptT, MonadIO, liftIO)
import qualified Data.HashMap.Strict as HashMap
import Data.Text (Text)
import qualified Data.Text as T
import Development.IDE (GetParsedModule (GetParsedModule),
IdeState, RuleResult, Rules,
define, ideLogger,
realSrcSpanToRange, runAction,
use)
import Development.IDE.GHC.Compat hiding (getSrcSpan)
import Development.IDE.GHC.Compat.Util (toList)
import Development.IDE.Graph.Classes (Hashable, NFData)
import Development.IDE.Types.Logger as Logger
import GHC.Generics (Generic)
import Ide.Plugin.Conversion (FormatType, alternateFormat,
toFormatTypes)
import Ide.Plugin.Literals (Literal (..), collectLiterals,
getSrcSpan, getSrcText)
import Ide.PluginUtils (handleMaybe, handleMaybeM,
response)
import Ide.Types
import Language.LSP.Types
import Language.LSP.Types.Lens (uri)
descriptor :: PluginId -> PluginDescriptor IdeState
descriptor :: PluginId -> PluginDescriptor IdeState
descriptor PluginId
plId = (PluginId -> PluginDescriptor IdeState
forall ideState. PluginId -> PluginDescriptor ideState
defaultPluginDescriptor PluginId
plId)
{ pluginHandlers :: PluginHandlers IdeState
pluginHandlers = SClientMethod 'TextDocumentCodeAction
-> PluginMethodHandler IdeState 'TextDocumentCodeAction
-> PluginHandlers IdeState
forall (m :: Method 'FromClient 'Request) ideState.
PluginMethod m =>
SClientMethod m
-> PluginMethodHandler ideState m -> PluginHandlers ideState
mkPluginHandler SClientMethod 'TextDocumentCodeAction
STextDocumentCodeAction PluginMethodHandler IdeState 'TextDocumentCodeAction
codeActionHandler
, pluginRules :: Rules ()
pluginRules = Rules ()
collectLiteralsRule
}
data CollectLiterals = CollectLiterals
deriving (Int -> CollectLiterals -> ShowS
[CollectLiterals] -> ShowS
CollectLiterals -> String
(Int -> CollectLiterals -> ShowS)
-> (CollectLiterals -> String)
-> ([CollectLiterals] -> ShowS)
-> Show CollectLiterals
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CollectLiterals] -> ShowS
$cshowList :: [CollectLiterals] -> ShowS
show :: CollectLiterals -> String
$cshow :: CollectLiterals -> String
showsPrec :: Int -> CollectLiterals -> ShowS
$cshowsPrec :: Int -> CollectLiterals -> ShowS
Show, CollectLiterals -> CollectLiterals -> Bool
(CollectLiterals -> CollectLiterals -> Bool)
-> (CollectLiterals -> CollectLiterals -> Bool)
-> Eq CollectLiterals
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CollectLiterals -> CollectLiterals -> Bool
$c/= :: CollectLiterals -> CollectLiterals -> Bool
== :: CollectLiterals -> CollectLiterals -> Bool
$c== :: CollectLiterals -> CollectLiterals -> Bool
Eq, (forall x. CollectLiterals -> Rep CollectLiterals x)
-> (forall x. Rep CollectLiterals x -> CollectLiterals)
-> Generic CollectLiterals
forall x. Rep CollectLiterals x -> CollectLiterals
forall x. CollectLiterals -> Rep CollectLiterals x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CollectLiterals x -> CollectLiterals
$cfrom :: forall x. CollectLiterals -> Rep CollectLiterals x
Generic)
instance Hashable CollectLiterals
instance NFData CollectLiterals
type instance RuleResult CollectLiterals = CollectLiteralsResult
data CollectLiteralsResult = CLR
{ CollectLiteralsResult -> [Literal]
literals :: [Literal]
, CollectLiteralsResult -> [FormatType]
formatTypes :: [FormatType]
} deriving ((forall x. CollectLiteralsResult -> Rep CollectLiteralsResult x)
-> (forall x. Rep CollectLiteralsResult x -> CollectLiteralsResult)
-> Generic CollectLiteralsResult
forall x. Rep CollectLiteralsResult x -> CollectLiteralsResult
forall x. CollectLiteralsResult -> Rep CollectLiteralsResult x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CollectLiteralsResult x -> CollectLiteralsResult
$cfrom :: forall x. CollectLiteralsResult -> Rep CollectLiteralsResult x
Generic)
instance Show CollectLiteralsResult where
show :: CollectLiteralsResult -> String
show CollectLiteralsResult
_ = String
"<CollectLiteralResult>"
instance NFData CollectLiteralsResult
collectLiteralsRule :: Rules ()
collectLiteralsRule :: Rules ()
collectLiteralsRule = (CollectLiterals
-> NormalizedFilePath -> Action (IdeResult CollectLiteralsResult))
-> Rules ()
forall k v.
IdeRule k v =>
(k -> NormalizedFilePath -> Action (IdeResult v)) -> Rules ()
define ((CollectLiterals
-> NormalizedFilePath -> Action (IdeResult CollectLiteralsResult))
-> Rules ())
-> (CollectLiterals
-> NormalizedFilePath -> Action (IdeResult CollectLiteralsResult))
-> Rules ()
forall a b. (a -> b) -> a -> b
$ \CollectLiterals
CollectLiterals NormalizedFilePath
nfp -> do
Maybe ParsedModule
pm <- GetParsedModule
-> NormalizedFilePath -> Action (Maybe ParsedModule)
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe v)
use GetParsedModule
GetParsedModule NormalizedFilePath
nfp
let fmts :: Maybe [FormatType]
fmts = ParsedModule -> [FormatType]
getFormatTypes (ParsedModule -> [FormatType])
-> Maybe ParsedModule -> Maybe [FormatType]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ParsedModule
pm
lits :: Maybe [Literal]
lits = ParsedSource -> [Literal]
forall ast. (Data ast, Typeable ast) => ast -> [Literal]
collectLiterals (ParsedSource -> [Literal])
-> (ParsedModule -> ParsedSource) -> ParsedModule -> [Literal]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsedModule -> ParsedSource
pm_parsed_source (ParsedModule -> [Literal])
-> Maybe ParsedModule -> Maybe [Literal]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ParsedModule
pm
IdeResult CollectLiteralsResult
-> Action (IdeResult CollectLiteralsResult)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([], [Literal] -> [FormatType] -> CollectLiteralsResult
CLR ([Literal] -> [FormatType] -> CollectLiteralsResult)
-> Maybe [Literal] -> Maybe ([FormatType] -> CollectLiteralsResult)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [Literal]
lits Maybe ([FormatType] -> CollectLiteralsResult)
-> Maybe [FormatType] -> Maybe CollectLiteralsResult
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe [FormatType]
fmts)
where
getFormatTypes :: ParsedModule -> [FormatType]
getFormatTypes = [Extension] -> [FormatType]
toFormatTypes ([Extension] -> [FormatType])
-> (ParsedModule -> [Extension]) -> ParsedModule -> [FormatType]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EnumSet Extension -> [Extension]
forall a. Enum a => EnumSet a -> [a]
toList (EnumSet Extension -> [Extension])
-> (ParsedModule -> EnumSet Extension)
-> ParsedModule
-> [Extension]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DynFlags -> EnumSet Extension
extensionFlags (DynFlags -> EnumSet Extension)
-> (ParsedModule -> DynFlags) -> ParsedModule -> EnumSet Extension
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModSummary -> DynFlags
ms_hspp_opts (ModSummary -> DynFlags)
-> (ParsedModule -> ModSummary) -> ParsedModule -> DynFlags
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsedModule -> ModSummary
pm_mod_summary
codeActionHandler :: PluginMethodHandler IdeState 'TextDocumentCodeAction
codeActionHandler :: PluginMethodHandler IdeState 'TextDocumentCodeAction
codeActionHandler IdeState
state PluginId
_ (CodeActionParams _ _ docId currRange _) = ExceptT String (LspT Config IO) (List (Command |? CodeAction))
-> LspT
Config IO (Either ResponseError (List (Command |? CodeAction)))
forall (m :: * -> *) a.
Monad m =>
ExceptT String m a -> m (Either ResponseError a)
response (ExceptT String (LspT Config IO) (List (Command |? CodeAction))
-> LspT
Config IO (Either ResponseError (List (Command |? CodeAction))))
-> ExceptT String (LspT Config IO) (List (Command |? CodeAction))
-> LspT
Config IO (Either ResponseError (List (Command |? CodeAction)))
forall a b. (a -> b) -> a -> b
$ do
NormalizedFilePath
nfp <- TextDocumentIdentifier
-> ExceptT String (LspT Config IO) NormalizedFilePath
forall (m :: * -> *).
Monad m =>
TextDocumentIdentifier -> ExceptT String m NormalizedFilePath
getNormalizedFilePath TextDocumentIdentifier
docId
CLR{[Literal]
[FormatType]
formatTypes :: [FormatType]
literals :: [Literal]
formatTypes :: CollectLiteralsResult -> [FormatType]
literals :: CollectLiteralsResult -> [Literal]
..} <- IdeState
-> NormalizedFilePath
-> ExceptT String (LspT Config IO) CollectLiteralsResult
forall (m :: * -> *).
MonadIO m =>
IdeState
-> NormalizedFilePath -> ExceptT String m CollectLiteralsResult
requestLiterals IdeState
state NormalizedFilePath
nfp
let litsInRange :: [Literal]
litsInRange = (Literal -> Bool) -> [Literal] -> [Literal]
forall a. (a -> Bool) -> [a] -> [a]
filter Literal -> Bool
inCurrentRange [Literal]
literals
literalPairs :: [(Literal, [Text])]
literalPairs = (Literal -> (Literal, [Text])) -> [Literal] -> [(Literal, [Text])]
forall a b. (a -> b) -> [a] -> [b]
map (\Literal
lit -> (Literal
lit, [FormatType] -> Literal -> [Text]
alternateFormat [FormatType]
formatTypes Literal
lit)) [Literal]
litsInRange
actions :: [Command |? CodeAction]
actions = ((Literal, [Text]) -> [Command |? CodeAction])
-> [(Literal, [Text])] -> [Command |? CodeAction]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(Literal
lit, [Text]
alts) -> (Text -> Command |? CodeAction)
-> [Text] -> [Command |? CodeAction]
forall a b. (a -> b) -> [a] -> [b]
map (NormalizedFilePath -> Literal -> Text -> Command |? CodeAction
mkCodeAction NormalizedFilePath
nfp Literal
lit) [Text]
alts) [(Literal, [Text])]
literalPairs
IdeState -> String -> ExceptT String (LspT Config IO) ()
forall (m :: * -> *) a.
(MonadIO m, Show a) =>
IdeState -> a -> m ()
logIO IdeState
state (String -> ExceptT String (LspT Config IO) ())
-> String -> ExceptT String (LspT Config IO) ()
forall a b. (a -> b) -> a -> b
$ String
"Literals: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Literal] -> String
forall a. Show a => a -> String
show [Literal]
literals
List (Command |? CodeAction)
-> ExceptT String (LspT Config IO) (List (Command |? CodeAction))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (List (Command |? CodeAction)
-> ExceptT String (LspT Config IO) (List (Command |? CodeAction)))
-> List (Command |? CodeAction)
-> ExceptT String (LspT Config IO) (List (Command |? CodeAction))
forall a b. (a -> b) -> a -> b
$ [Command |? CodeAction] -> List (Command |? CodeAction)
forall a. [a] -> List a
List [Command |? CodeAction]
actions
where
inCurrentRange :: Literal -> Bool
inCurrentRange :: Literal -> Bool
inCurrentRange Literal
lit = let srcSpan :: RealSrcSpan
srcSpan = Literal -> RealSrcSpan
getSrcSpan Literal
lit
in Range
currRange Range -> RealSrcSpan -> Bool
`contains` RealSrcSpan
srcSpan
mkCodeAction :: NormalizedFilePath -> Literal -> Text -> Command |? CodeAction
mkCodeAction :: NormalizedFilePath -> Literal -> Text -> Command |? CodeAction
mkCodeAction NormalizedFilePath
nfp Literal
lit Text
alt = CodeAction -> Command |? CodeAction
forall a b. b -> a |? b
InR CodeAction :: Text
-> Maybe CodeActionKind
-> Maybe (List Diagnostic)
-> Maybe Bool
-> Maybe Reason
-> Maybe WorkspaceEdit
-> Maybe Command
-> Maybe Value
-> CodeAction
CodeAction {
$sel:_title:CodeAction :: Text
_title = Text
"Convert " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Literal -> Text
getSrcText Literal
lit Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" into " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
alt
, $sel:_kind:CodeAction :: Maybe CodeActionKind
_kind = CodeActionKind -> Maybe CodeActionKind
forall a. a -> Maybe a
Just (CodeActionKind -> Maybe CodeActionKind)
-> CodeActionKind -> Maybe CodeActionKind
forall a b. (a -> b) -> a -> b
$ Text -> CodeActionKind
CodeActionUnknown Text
"quickfix.literals.style"
, $sel:_diagnostics:CodeAction :: Maybe (List Diagnostic)
_diagnostics = Maybe (List Diagnostic)
forall a. Maybe a
Nothing
, $sel:_isPreferred:CodeAction :: Maybe Bool
_isPreferred = Maybe Bool
forall a. Maybe a
Nothing
, $sel:_disabled:CodeAction :: Maybe Reason
_disabled = Maybe Reason
forall a. Maybe a
Nothing
, $sel:_edit:CodeAction :: Maybe WorkspaceEdit
_edit = WorkspaceEdit -> Maybe WorkspaceEdit
forall a. a -> Maybe a
Just (WorkspaceEdit -> Maybe WorkspaceEdit)
-> WorkspaceEdit -> Maybe WorkspaceEdit
forall a b. (a -> b) -> a -> b
$ NormalizedFilePath -> Literal -> Text -> WorkspaceEdit
mkWorkspaceEdit NormalizedFilePath
nfp Literal
lit Text
alt
, $sel:_command:CodeAction :: Maybe Command
_command = Maybe Command
forall a. Maybe a
Nothing
, $sel:_xdata:CodeAction :: Maybe Value
_xdata = Maybe Value
forall a. Maybe a
Nothing
}
mkWorkspaceEdit :: NormalizedFilePath -> Literal -> Text -> WorkspaceEdit
mkWorkspaceEdit :: NormalizedFilePath -> Literal -> Text -> WorkspaceEdit
mkWorkspaceEdit NormalizedFilePath
nfp Literal
lit Text
alt = Maybe WorkspaceEditMap
-> Maybe (List DocumentChange)
-> Maybe ChangeAnnotationMap
-> WorkspaceEdit
WorkspaceEdit Maybe WorkspaceEditMap
changes Maybe (List DocumentChange)
forall a. Maybe a
Nothing Maybe ChangeAnnotationMap
forall a. Maybe a
Nothing
where
txtEdit :: TextEdit
txtEdit = Range -> Text -> TextEdit
TextEdit (RealSrcSpan -> Range
realSrcSpanToRange (RealSrcSpan -> Range) -> RealSrcSpan -> Range
forall a b. (a -> b) -> a -> b
$ Literal -> RealSrcSpan
getSrcSpan Literal
lit) Text
alt
changes :: Maybe WorkspaceEditMap
changes = WorkspaceEditMap -> Maybe WorkspaceEditMap
forall a. a -> Maybe a
Just (WorkspaceEditMap -> Maybe WorkspaceEditMap)
-> WorkspaceEditMap -> Maybe WorkspaceEditMap
forall a b. (a -> b) -> a -> b
$ [(Uri, List TextEdit)] -> WorkspaceEditMap
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList [( String -> Uri
filePathToUri (String -> Uri) -> String -> Uri
forall a b. (a -> b) -> a -> b
$ NormalizedFilePath -> String
fromNormalizedFilePath NormalizedFilePath
nfp, [TextEdit] -> List TextEdit
forall a. [a] -> List a
List [TextEdit
txtEdit])]
contains :: Range -> RealSrcSpan -> Bool
contains :: Range -> RealSrcSpan -> Bool
contains Range {Position
_start :: Range -> Position
_start :: Position
_start, Position
_end :: Range -> Position
_end :: Position
_end} RealSrcSpan
x = Position -> RealSrcSpan -> Bool
isInsideRealSrcSpan Position
_start RealSrcSpan
x Bool -> Bool -> Bool
|| Position -> RealSrcSpan -> Bool
isInsideRealSrcSpan Position
_end RealSrcSpan
x
isInsideRealSrcSpan :: Position -> RealSrcSpan -> Bool
Position
p isInsideRealSrcSpan :: Position -> RealSrcSpan -> Bool
`isInsideRealSrcSpan` RealSrcSpan
r = let (Range Position
sp Position
ep) = RealSrcSpan -> Range
realSrcSpanToRange RealSrcSpan
r in Position
sp Position -> Position -> Bool
forall a. Ord a => a -> a -> Bool
<= Position
p Bool -> Bool -> Bool
&& Position
p Position -> Position -> Bool
forall a. Ord a => a -> a -> Bool
<= Position
ep
getNormalizedFilePath :: Monad m => TextDocumentIdentifier -> ExceptT String m NormalizedFilePath
getNormalizedFilePath :: TextDocumentIdentifier -> ExceptT String m NormalizedFilePath
getNormalizedFilePath TextDocumentIdentifier
docId = String
-> Maybe NormalizedFilePath -> ExceptT String m NormalizedFilePath
forall (m :: * -> *) e b. Monad m => e -> Maybe b -> ExceptT e m b
handleMaybe String
"Error: converting to NormalizedFilePath"
(Maybe NormalizedFilePath -> ExceptT String m NormalizedFilePath)
-> Maybe NormalizedFilePath -> ExceptT String m NormalizedFilePath
forall a b. (a -> b) -> a -> b
$ NormalizedUri -> Maybe NormalizedFilePath
uriToNormalizedFilePath
(NormalizedUri -> Maybe NormalizedFilePath)
-> NormalizedUri -> Maybe NormalizedFilePath
forall a b. (a -> b) -> a -> b
$ Uri -> NormalizedUri
toNormalizedUri (TextDocumentIdentifier
docId TextDocumentIdentifier
-> Getting Uri TextDocumentIdentifier Uri -> Uri
forall s a. s -> Getting a s a -> a
^. Getting Uri TextDocumentIdentifier Uri
forall s a. HasUri s a => Lens' s a
uri)
requestLiterals :: MonadIO m => IdeState -> NormalizedFilePath -> ExceptT String m CollectLiteralsResult
requestLiterals :: IdeState
-> NormalizedFilePath -> ExceptT String m CollectLiteralsResult
requestLiterals IdeState
state = String
-> m (Maybe CollectLiteralsResult)
-> ExceptT String m CollectLiteralsResult
forall (m :: * -> *) e b.
Monad m =>
e -> m (Maybe b) -> ExceptT e m b
handleMaybeM String
"Error: Could not Collect Literals"
(m (Maybe CollectLiteralsResult)
-> ExceptT String m CollectLiteralsResult)
-> (NormalizedFilePath -> m (Maybe CollectLiteralsResult))
-> NormalizedFilePath
-> ExceptT String m CollectLiteralsResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Maybe CollectLiteralsResult) -> m (Maybe CollectLiteralsResult)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
(IO (Maybe CollectLiteralsResult)
-> m (Maybe CollectLiteralsResult))
-> (NormalizedFilePath -> IO (Maybe CollectLiteralsResult))
-> NormalizedFilePath
-> m (Maybe CollectLiteralsResult)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String
-> IdeState
-> Action (Maybe CollectLiteralsResult)
-> IO (Maybe CollectLiteralsResult)
forall a. String -> IdeState -> Action a -> IO a
runAction String
"AlternateNumberFormat.CollectLiterals" IdeState
state
(Action (Maybe CollectLiteralsResult)
-> IO (Maybe CollectLiteralsResult))
-> (NormalizedFilePath -> Action (Maybe CollectLiteralsResult))
-> NormalizedFilePath
-> IO (Maybe CollectLiteralsResult)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CollectLiterals
-> NormalizedFilePath -> Action (Maybe CollectLiteralsResult)
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe v)
use CollectLiterals
CollectLiterals
logIO :: (MonadIO m, Show a) => IdeState -> a -> m ()
logIO :: IdeState -> a -> m ()
logIO IdeState
state = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (a -> IO ()) -> a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Logger -> Text -> IO ()
Logger.logDebug (IdeState -> Logger
ideLogger IdeState
state) (Text -> IO ()) -> (a -> Text) -> a -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text) -> (a -> String) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show