{-# LANGUAGE ViewPatterns #-}

module Ide.Plugin.Class.Utils where

import           Control.Monad.IO.Class          (MonadIO, liftIO)
import           Control.Monad.Trans.Except
import           Data.Char                       (isAlpha)
import           Data.List                       (isPrefixOf)
import           Data.String                     (IsString)
import qualified Data.Text                       as T
import           Development.IDE
import           Development.IDE.GHC.Compat
import           Development.IDE.GHC.Compat.Util
import           Development.IDE.Spans.Pragmas   (getNextPragmaInfo,
                                                  insertNewPragma)
import           GHC.LanguageExtensions.Type     (Extension)
import           Ide.PluginUtils
import           Language.LSP.Types

-- | All instance bindings are started with `$c`
bindingPrefix :: IsString s => s
bindingPrefix :: forall s. IsString s => s
bindingPrefix = s
"$c"

isBindingName :: Name -> Bool
isBindingName :: Name -> Bool
isBindingName Name
name = forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf forall s. IsString s => s
bindingPrefix forall a b. (a -> b) -> a -> b
$ OccName -> [Char]
occNameString forall a b. (a -> b) -> a -> b
$ Name -> OccName
nameOccName Name
name

-- | Check if some `HasSrcSpan` value in the given range
inRange :: Range -> SrcSpan -> Bool
inRange :: Range -> SrcSpan -> Bool
inRange Range
range SrcSpan
s = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Range -> Range -> Bool
subRange Range
range) (SrcSpan -> Maybe Range
srcSpanToRange SrcSpan
s)

ghostSpan :: RealSrcSpan
ghostSpan :: RealSrcSpan
ghostSpan = RealSrcLoc -> RealSrcSpan
realSrcLocSpan forall a b. (a -> b) -> a -> b
$ FastString -> Int -> Int -> RealSrcLoc
mkRealSrcLoc ([Char] -> FastString
fsLit [Char]
"<haskell-language-sever>") Int
1 Int
1

-- | "$cname" ==> "name"
prettyBindingNameString :: T.Text -> T.Text
prettyBindingNameString :: Text -> Text
prettyBindingNameString Text
name
    | Text -> Text -> Bool
T.isPrefixOf forall s. IsString s => s
bindingPrefix Text
name =
        Text -> Text
toMethodName forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.drop (Text -> Int
T.length forall s. IsString s => s
bindingPrefix) Text
name
    | Bool
otherwise = Text
name

-- | Paren the name for pretty display if necessary
toMethodName :: T.Text -> T.Text
toMethodName :: Text -> Text
toMethodName Text
n
    | Just (Char
h, Text
_) <- Text -> Maybe (Char, Text)
T.uncons Text
n
    , Bool -> Bool
not (Char -> Bool
isAlpha Char
h Bool -> Bool -> Bool
|| Char
h forall a. Eq a => a -> a -> Bool
== Char
'_')
    = Text
"(" forall a. Semigroup a => a -> a -> a
<> Text
n forall a. Semigroup a => a -> a -> a
<> Text
")"
    | Bool
otherwise
    = Text
n

insertPragmaIfNotPresent :: (MonadIO m)
    => IdeState
    -> NormalizedFilePath
    -> Extension
    -> ExceptT String m [TextEdit]
insertPragmaIfNotPresent :: forall (m :: * -> *).
MonadIO m =>
IdeState
-> NormalizedFilePath -> Extension -> ExceptT [Char] m [TextEdit]
insertPragmaIfNotPresent IdeState
state NormalizedFilePath
nfp Extension
pragma = do
    (HscEnvEq -> HscEnv
hscEnv -> HscEnv -> DynFlags
hsc_dflags -> DynFlags
sessionDynFlags, PositionMapping
_) <- forall (m :: * -> *) e b.
Monad m =>
e -> m (Maybe b) -> ExceptT e m b
handleMaybeM [Char]
"Unable to get GhcSession"
        forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
        forall a b. (a -> b) -> a -> b
$ forall a. [Char] -> IdeState -> Action a -> IO a
runAction [Char]
"classplugin.insertPragmaIfNotPresent.GhcSession" IdeState
state
        forall a b. (a -> b) -> a -> b
$ forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe (v, PositionMapping))
useWithStale GhcSession
GhcSession NormalizedFilePath
nfp
    (UTCTime
_, Maybe Text
fileContents) <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
        forall a b. (a -> b) -> a -> b
$ forall a. [Char] -> IdeState -> Action a -> IO a
runAction [Char]
"classplugin.insertPragmaIfNotPresent.GetFileContents" IdeState
state
        forall a b. (a -> b) -> a -> b
$ NormalizedFilePath -> Action (UTCTime, Maybe Text)
getFileContents NormalizedFilePath
nfp
    ParsedModule
pm <- forall (m :: * -> *) e b.
Monad m =>
e -> m (Maybe b) -> ExceptT e m b
handleMaybeM [Char]
"Unable to GetParsedModuleWithComments"
        forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
        forall a b. (a -> b) -> a -> b
$ forall a. [Char] -> IdeState -> Action a -> IO a
runAction [Char]
"classplugin.insertPragmaIfNotPresent.GetParsedModuleWithComments" IdeState
state
        forall a b. (a -> b) -> a -> b
$ forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe v)
use GetParsedModuleWithComments
GetParsedModuleWithComments NormalizedFilePath
nfp
    let exts :: [Extension]
exts = (forall a. Enum a => EnumSet a -> [a]
toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. DynFlags -> EnumSet Extension
extensionFlags forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModSummary -> DynFlags
ms_hspp_opts forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsedModule -> ModSummary
pm_mod_summary) ParsedModule
pm
        info :: NextPragmaInfo
info = DynFlags -> Maybe Text -> NextPragmaInfo
getNextPragmaInfo DynFlags
sessionDynFlags Maybe Text
fileContents
    forall (f :: * -> *) a. Applicative f => a -> f a
pure [NextPragmaInfo -> Extension -> TextEdit
insertNewPragma NextPragmaInfo
info Extension
pragma | Extension
pragma forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Extension]
exts]