{-# LANGUAGE DataKinds     #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TypeFamilies  #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE ViewPatterns  #-}
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)
import qualified Data.Text                       as T
import           Development.IDE                 (GetParsedModule (GetParsedModule),
                                                  GhcSession (GhcSession),
                                                  IdeState, RuleResult, Rules,
                                                  define, getFileContents,
                                                  hscEnv, ideLogger,
                                                  realSrcSpanToRange, runAction,
                                                  use, useWithStale)
import qualified Development.IDE.Core.Shake      as Shake
import           Development.IDE.GHC.Compat      hiding (getSrcSpan)
import           Development.IDE.GHC.Compat.Util (toList)
import           Development.IDE.Graph.Classes   (Hashable, NFData, rnf)
import           Development.IDE.Spans.Pragmas   (NextPragmaInfo,
                                                  getNextPragmaInfo,
                                                  insertNewPragma)
import           Development.IDE.Types.Logger    as Logger
import           GHC.Generics                    (Generic)
import           GHC.LanguageExtensions.Type     (Extension)
import           Ide.Plugin.Conversion           (AlternateFormat,
                                                  ExtensionNeeded (NeedsExtension, NoExtension),
                                                  alternateFormat)
import           Ide.Plugin.Literals
import           Ide.PluginUtils                 (handleMaybe, handleMaybeM,
                                                  response)
import           Ide.Types
import           Language.LSP.Types
import           Language.LSP.Types.Lens         (uri)

newtype Log = LogShake Shake.Log deriving Int -> Log -> ShowS
[Log] -> ShowS
Log -> String
(Int -> Log -> ShowS)
-> (Log -> String) -> ([Log] -> ShowS) -> Show Log
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Log] -> ShowS
$cshowList :: [Log] -> ShowS
show :: Log -> String
$cshow :: Log -> String
showsPrec :: Int -> Log -> ShowS
$cshowsPrec :: Int -> Log -> ShowS
Show

instance Pretty Log where
  pretty :: Log -> Doc ann
pretty = \case
    LogShake Log
log -> Log -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Log
log

descriptor :: Recorder (WithPriority Log) -> PluginId -> PluginDescriptor IdeState
descriptor :: Recorder (WithPriority Log)
-> PluginId -> PluginDescriptor IdeState
descriptor Recorder (WithPriority Log)
recorder 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 = Recorder (WithPriority Log) -> Rules ()
collectLiteralsRule Recorder (WithPriority Log)
recorder
    }

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 -> [GhcExtension]
enabledExtensions :: [GhcExtension]
    } 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)

newtype GhcExtension = GhcExtension { GhcExtension -> Extension
unExt :: Extension }

instance NFData GhcExtension where
    rnf :: GhcExtension -> ()
rnf GhcExtension
x = GhcExtension
x GhcExtension -> () -> ()
`seq` ()

instance Show CollectLiteralsResult where
    show :: CollectLiteralsResult -> String
show CollectLiteralsResult
_ = String
"<CollectLiteralResult>"

instance NFData CollectLiteralsResult

collectLiteralsRule :: Recorder (WithPriority Log) -> Rules ()
collectLiteralsRule :: Recorder (WithPriority Log) -> Rules ()
collectLiteralsRule Recorder (WithPriority Log)
recorder = Recorder (WithPriority Log)
-> (CollectLiterals
    -> NormalizedFilePath -> Action (IdeResult CollectLiteralsResult))
-> Rules ()
forall k v.
IdeRule k v =>
Recorder (WithPriority Log)
-> (k -> NormalizedFilePath -> Action (IdeResult v)) -> Rules ()
define ((Log -> Log)
-> Recorder (WithPriority Log) -> Recorder (WithPriority Log)
forall a b.
(a -> b) -> Recorder (WithPriority b) -> Recorder (WithPriority a)
cmapWithPrio Log -> Log
LogShake Recorder (WithPriority Log)
recorder) ((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
    -- get the current extensions active and transform them into FormatTypes
    let exts :: Maybe [GhcExtension]
exts = ParsedModule -> [GhcExtension]
getExtensions (ParsedModule -> [GhcExtension])
-> Maybe ParsedModule -> Maybe [GhcExtension]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ParsedModule
pm
        -- collect all the literals for a file
        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] -> [GhcExtension] -> CollectLiteralsResult
CLR ([Literal] -> [GhcExtension] -> CollectLiteralsResult)
-> Maybe [Literal]
-> Maybe ([GhcExtension] -> CollectLiteralsResult)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [Literal]
lits Maybe ([GhcExtension] -> CollectLiteralsResult)
-> Maybe [GhcExtension] -> Maybe CollectLiteralsResult
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe [GhcExtension]
exts)
    where
        getExtensions :: ParsedModule -> [GhcExtension]
getExtensions = (Extension -> GhcExtension) -> [Extension] -> [GhcExtension]
forall a b. (a -> b) -> [a] -> [b]
map Extension -> GhcExtension
GhcExtension ([Extension] -> [GhcExtension])
-> (ParsedModule -> [Extension]) -> ParsedModule -> [GhcExtension]
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]
[GhcExtension]
enabledExtensions :: [GhcExtension]
literals :: [Literal]
enabledExtensions :: CollectLiteralsResult -> [GhcExtension]
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
    NextPragmaInfo
pragma <- IdeState
-> NormalizedFilePath
-> ExceptT String (LspT Config IO) NextPragmaInfo
forall (m :: * -> *).
MonadIO m =>
IdeState -> NormalizedFilePath -> ExceptT String m NextPragmaInfo
getFirstPragma IdeState
state NormalizedFilePath
nfp
        -- remove any invalid literals (see validTarget comment)
    let litsInRange :: [Literal]
litsInRange = (Literal -> Bool) -> [Literal] -> [Literal]
forall a. (a -> Bool) -> [a] -> [a]
filter Literal -> Bool
inCurrentRange [Literal]
literals
        -- generate alternateFormats and zip with the literal that generated the alternates
        literalPairs :: [(Literal, [AlternateFormat])]
literalPairs = (Literal -> (Literal, [AlternateFormat]))
-> [Literal] -> [(Literal, [AlternateFormat])]
forall a b. (a -> b) -> [a] -> [b]
map (\Literal
lit -> (Literal
lit, Literal -> [AlternateFormat]
alternateFormat Literal
lit)) [Literal]
litsInRange
        -- make a code action for every literal and its' alternates (then flatten the result)
        actions :: [Command |? CodeAction]
actions = ((Literal, [AlternateFormat]) -> [Command |? CodeAction])
-> [(Literal, [AlternateFormat])] -> [Command |? CodeAction]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(Literal
lit, [AlternateFormat]
alts) -> (AlternateFormat -> Command |? CodeAction)
-> [AlternateFormat] -> [Command |? CodeAction]
forall a b. (a -> b) -> [a] -> [b]
map (NormalizedFilePath
-> Literal
-> [GhcExtension]
-> NextPragmaInfo
-> AlternateFormat
-> Command |? CodeAction
mkCodeAction NormalizedFilePath
nfp Literal
lit [GhcExtension]
enabledExtensions NextPragmaInfo
pragma) [AlternateFormat]
alts) [(Literal, [AlternateFormat])]
literalPairs

    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 -> [GhcExtension] -> NextPragmaInfo -> AlternateFormat -> Command |? CodeAction
        mkCodeAction :: NormalizedFilePath
-> Literal
-> [GhcExtension]
-> NextPragmaInfo
-> AlternateFormat
-> Command |? CodeAction
mkCodeAction NormalizedFilePath
nfp Literal
lit [GhcExtension]
enabled NextPragmaInfo
npi af :: AlternateFormat
af@(Text
alt, ExtensionNeeded
ext) = 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 = Literal -> AlternateFormat -> [GhcExtension] -> Text
mkCodeActionTitle Literal
lit AlternateFormat
af [GhcExtension]
enabled
            , $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 -> [TextEdit] -> WorkspaceEdit
mkWorkspaceEdit NormalizedFilePath
nfp [TextEdit]
edits
            , $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
            }
            where
                edits :: [TextEdit]
edits =  [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] [TextEdit] -> [TextEdit] -> [TextEdit]
forall a. Semigroup a => a -> a -> a
<> [TextEdit]
pragmaEdit
                pragmaEdit :: [TextEdit]
pragmaEdit = case ExtensionNeeded
ext of
                    NeedsExtension Extension
ext' -> [NextPragmaInfo -> Extension -> TextEdit
insertNewPragma NextPragmaInfo
npi Extension
ext' | Extension -> [GhcExtension] -> Bool
needsExtension Extension
ext' [GhcExtension]
enabled]
                    ExtensionNeeded
NoExtension         -> []

        mkWorkspaceEdit :: NormalizedFilePath -> [TextEdit] -> WorkspaceEdit
        mkWorkspaceEdit :: NormalizedFilePath -> [TextEdit] -> WorkspaceEdit
mkWorkspaceEdit NormalizedFilePath
nfp [TextEdit]
edits = 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
                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]
edits)]

mkCodeActionTitle :: Literal -> AlternateFormat -> [GhcExtension] -> Text
mkCodeActionTitle :: Literal -> AlternateFormat -> [GhcExtension] -> Text
mkCodeActionTitle Literal
lit (Text
alt, ExtensionNeeded
ext) [GhcExtension]
ghcExts
    | (NeedsExtension Extension
ext') <- ExtensionNeeded
ext
    , Extension -> [GhcExtension] -> Bool
needsExtension Extension
ext' [GhcExtension]
ghcExts = Text
title Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" (needs extension: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Extension -> String
forall a. Show a => a -> String
show Extension
ext') Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
    | Bool
otherwise = Text
title
    where
        title :: 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


-- | Checks whether the extension given is already enabled
needsExtension :: Extension -> [GhcExtension] -> Bool
needsExtension :: Extension -> [GhcExtension] -> Bool
needsExtension Extension
ext [GhcExtension]
ghcExts = Extension
ext Extension -> [Extension] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` (GhcExtension -> Extension) -> [GhcExtension] -> [Extension]
forall a b. (a -> b) -> [a] -> [b]
map GhcExtension -> Extension
unExt [GhcExtension]
ghcExts

-- from HaddockComments.hs
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

getFirstPragma :: MonadIO m => IdeState -> NormalizedFilePath -> ExceptT String m NextPragmaInfo
getFirstPragma :: IdeState -> NormalizedFilePath -> ExceptT String m NextPragmaInfo
getFirstPragma IdeState
state NormalizedFilePath
nfp = String
-> m (Maybe NextPragmaInfo) -> ExceptT String m NextPragmaInfo
forall (m :: * -> *) e b.
Monad m =>
e -> m (Maybe b) -> ExceptT e m b
handleMaybeM String
"Error: Could not get NextPragmaInfo" (m (Maybe NextPragmaInfo) -> ExceptT String m NextPragmaInfo)
-> m (Maybe NextPragmaInfo) -> ExceptT String m NextPragmaInfo
forall a b. (a -> b) -> a -> b
$ do
      Maybe (HscEnvEq, PositionMapping)
ghcSession <- IO (Maybe (HscEnvEq, PositionMapping))
-> m (Maybe (HscEnvEq, PositionMapping))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe (HscEnvEq, PositionMapping))
 -> m (Maybe (HscEnvEq, PositionMapping)))
-> IO (Maybe (HscEnvEq, PositionMapping))
-> m (Maybe (HscEnvEq, PositionMapping))
forall a b. (a -> b) -> a -> b
$ String
-> IdeState
-> Action (Maybe (HscEnvEq, PositionMapping))
-> IO (Maybe (HscEnvEq, PositionMapping))
forall a. String -> IdeState -> Action a -> IO a
runAction String
"AlternateNumberFormat.GhcSession" IdeState
state (Action (Maybe (HscEnvEq, PositionMapping))
 -> IO (Maybe (HscEnvEq, PositionMapping)))
-> Action (Maybe (HscEnvEq, PositionMapping))
-> IO (Maybe (HscEnvEq, PositionMapping))
forall a b. (a -> b) -> a -> b
$ GhcSession
-> NormalizedFilePath -> Action (Maybe (HscEnvEq, PositionMapping))
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe (v, PositionMapping))
useWithStale GhcSession
GhcSession NormalizedFilePath
nfp
      (UTCTime
_, Maybe Text
fileContents) <- IO (UTCTime, Maybe Text) -> m (UTCTime, Maybe Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (UTCTime, Maybe Text) -> m (UTCTime, Maybe Text))
-> IO (UTCTime, Maybe Text) -> m (UTCTime, Maybe Text)
forall a b. (a -> b) -> a -> b
$ String
-> IdeState
-> Action (UTCTime, Maybe Text)
-> IO (UTCTime, Maybe Text)
forall a. String -> IdeState -> Action a -> IO a
runAction String
"AlternateNumberFormat.GetFileContents" IdeState
state (Action (UTCTime, Maybe Text) -> IO (UTCTime, Maybe Text))
-> Action (UTCTime, Maybe Text) -> IO (UTCTime, Maybe Text)
forall a b. (a -> b) -> a -> b
$ NormalizedFilePath -> Action (UTCTime, Maybe Text)
getFileContents NormalizedFilePath
nfp
      case Maybe (HscEnvEq, PositionMapping)
ghcSession of
        Just (HscEnvEq -> HscEnv
hscEnv -> HscEnv -> DynFlags
hsc_dflags -> DynFlags
sessionDynFlags, PositionMapping
_) -> Maybe NextPragmaInfo -> m (Maybe NextPragmaInfo)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe NextPragmaInfo -> m (Maybe NextPragmaInfo))
-> Maybe NextPragmaInfo -> m (Maybe NextPragmaInfo)
forall a b. (a -> b) -> a -> b
$ NextPragmaInfo -> Maybe NextPragmaInfo
forall a. a -> Maybe a
Just (NextPragmaInfo -> Maybe NextPragmaInfo)
-> NextPragmaInfo -> Maybe NextPragmaInfo
forall a b. (a -> b) -> a -> b
$ DynFlags -> Maybe Text -> NextPragmaInfo
getNextPragmaInfo DynFlags
sessionDynFlags Maybe Text
fileContents
        Maybe (HscEnvEq, PositionMapping)
Nothing -> Maybe NextPragmaInfo -> m (Maybe NextPragmaInfo)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe NextPragmaInfo
forall a. Maybe a
Nothing


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