{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
module Ide.Plugin.AlternateNumberFormat (descriptor, Log(..)) where
import Control.Lens ((^.))
import Control.Monad.Except (ExceptT, MonadIO, liftIO)
import qualified Data.HashMap.Strict as HashMap
import Data.Text (Text, unpack)
import qualified Data.Text as T
import Development.IDE (GetParsedModule (GetParsedModule),
IdeState, RuleResult, Rules,
define, realSrcSpanToRange,
runAction, use)
import qualified Development.IDE.Core.Shake as Shake
import Development.IDE.GHC.Compat hiding (getSrcSpan)
import Development.IDE.GHC.Util (getExtensions)
import Development.IDE.Graph.Classes (Hashable, NFData, rnf)
import Development.IDE.Spans.Pragmas (NextPragmaInfo, getFirstPragma,
insertNewPragma)
import Development.IDE.Types.Logger as Logger
import GHC.Generics (Generic)
import Ide.Plugin.Conversion (AlternateFormat,
ExtensionNeeded (NeedsExtension, NoExtension),
alternateFormat)
import Ide.Plugin.Literals
import Ide.Plugin.RangeMap (RangeMap)
import qualified Ide.Plugin.RangeMap as RangeMap
import Ide.PluginUtils (getNormalizedFilePath,
handleMaybeM, pluginResponse)
import Ide.Types
import Language.LSP.Types
import qualified Language.LSP.Types.Lens as L
newtype Log = LogShake Shake.Log deriving Show
instance Pretty Log where
pretty = \case
LogShake log -> pretty log
descriptor :: Recorder (WithPriority Log) -> PluginId -> PluginDescriptor IdeState
descriptor recorder pId = (defaultPluginDescriptor pId)
{ pluginHandlers = mkPluginHandler STextDocumentCodeAction codeActionHandler
, pluginRules = collectLiteralsRule recorder
}
data CollectLiterals = CollectLiterals
deriving (Show, Eq, Generic)
instance Hashable CollectLiterals
instance NFData CollectLiterals
type instance RuleResult CollectLiterals = CollectLiteralsResult
data CollectLiteralsResult = CLR
{ literals :: RangeMap Literal
, enabledExtensions :: [GhcExtension]
} deriving (Generic)
newtype GhcExtension = GhcExtension { unExt :: Extension }
instance NFData GhcExtension where
rnf x = x `seq` ()
instance Show CollectLiteralsResult where
show _ = "<CollectLiteralResult>"
instance NFData CollectLiteralsResult
collectLiteralsRule :: Recorder (WithPriority Log) -> Rules ()
collectLiteralsRule recorder = define (cmapWithPrio LogShake recorder) $ \CollectLiterals nfp -> do
pm <- use GetParsedModule nfp
-- get the current extensions active and transform them into FormatTypes
let exts = map GhcExtension . getExtensions <$> pm
-- collect all the literals for a file
lits = collectLiterals . pm_parsed_source <$> pm
litMap = RangeMap.fromList (realSrcSpanToRange . getSrcSpan) <$> lits
pure ([], CLR <$> litMap <*> exts)
codeActionHandler :: PluginMethodHandler IdeState 'TextDocumentCodeAction
codeActionHandler state pId (CodeActionParams _ _ docId currRange _) = pluginResponse $ do
nfp <- getNormalizedFilePath (docId ^. L.uri)
CLR{..} <- requestLiterals pId state nfp
pragma <- getFirstPragma pId state nfp
-- remove any invalid literals (see validTarget comment)
let litsInRange = RangeMap.filterByRange currRange literals
-- generate alternateFormats and zip with the literal that generated the alternates
literalPairs = map (\lit -> (lit, alternateFormat lit)) litsInRange
-- make a code action for every literal and its' alternates (then flatten the result)
actions = concatMap (\(lit, alts) -> map (mkCodeAction nfp lit enabledExtensions pragma) alts) literalPairs
pure $ List actions
where
mkCodeAction :: NormalizedFilePath -> Literal -> [GhcExtension] -> NextPragmaInfo -> AlternateFormat -> Command |? CodeAction
mkCodeAction nfp lit enabled npi af@(alt, ext) = InR CodeAction {
_title = mkCodeActionTitle lit af enabled
, _kind = Just $ CodeActionUnknown "quickfix.literals.style"
, _diagnostics = Nothing
, _isPreferred = Nothing
, _disabled = Nothing
, _edit = Just $ mkWorkspaceEdit nfp edits
, _command = Nothing
, _xdata = Nothing
}
where
edits = [TextEdit (realSrcSpanToRange $ getSrcSpan lit) alt] <> pragmaEdit
pragmaEdit = case ext of
NeedsExtension ext' -> [insertNewPragma npi ext' | needsExtension ext' enabled]
NoExtension -> []
mkWorkspaceEdit :: NormalizedFilePath -> [TextEdit] -> WorkspaceEdit
mkWorkspaceEdit nfp edits = WorkspaceEdit changes Nothing Nothing
where
changes = Just $ HashMap.fromList [(filePathToUri $ fromNormalizedFilePath nfp, List edits)]
mkCodeActionTitle :: Literal -> AlternateFormat -> [GhcExtension] -> Text
mkCodeActionTitle lit (alt, ext) ghcExts
| (NeedsExtension ext') <- ext
, needsExtension ext' ghcExts = title <> " (needs extension: " <> T.pack (show ext') <> ")"
| otherwise = title
where
title = "Convert " <> getSrcText lit <> " into " <> alt
-- | Checks whether the extension given is already enabled
needsExtension :: Extension -> [GhcExtension] -> Bool
needsExtension ext ghcExts = ext `notElem` map unExt ghcExts
requestLiterals :: MonadIO m => PluginId -> IdeState -> NormalizedFilePath -> ExceptT String m CollectLiteralsResult
requestLiterals (PluginId pId) state = handleMaybeM "Could not Collect Literals"
. liftIO
. runAction (unpack pId <> ".CollectLiterals") state
. use CollectLiterals