{-# LANGUAGE OverloadedStrings #-}
module Ide.Plugin.Cabal.Completion.Completions (contextToCompleter, getContext, getCabalPrefixInfo) where
import Control.Lens ((^.))
import Control.Monad.IO.Class (MonadIO)
import Control.Monad.Trans.Maybe
import Data.Foldable (asum)
import qualified Data.List as List
import Data.Map (Map)
import qualified Data.Map as Map
import qualified Data.Text as T
import qualified Data.Text.Utf16.Lines as Rope (Position (..))
import Data.Text.Utf16.Rope.Mixed (Rope)
import qualified Data.Text.Utf16.Rope.Mixed as Rope
import Development.IDE as D
import qualified Development.IDE.Plugin.Completions.Types as Ghcide
import Ide.Plugin.Cabal.Completion.Completer.Simple
import Ide.Plugin.Cabal.Completion.Completer.Snippet
import Ide.Plugin.Cabal.Completion.Completer.Types (Completer)
import Ide.Plugin.Cabal.Completion.Data
import Ide.Plugin.Cabal.Completion.Types
import qualified Language.LSP.Protocol.Lens as JL
import qualified System.FilePath as FP
import System.FilePath (takeBaseName)
contextToCompleter :: Context -> Completer
contextToCompleter :: Context -> Completer
contextToCompleter (StanzaContext
TopLevel, FieldContext
None) =
Completer
snippetCompleter
Completer -> Completer -> Completer
forall a. Semigroup a => a -> a -> a
<> ( [Text] -> Completer
constantCompleter ([Text] -> Completer) -> [Text] -> Completer
forall a b. (a -> b) -> a -> b
$
Map Text Completer -> [Text]
forall k a. Map k a -> [k]
Map.keys (Map Text Completer
cabalVersionKeyword Map Text Completer -> Map Text Completer -> Map Text Completer
forall a. Semigroup a => a -> a -> a
<> Map Text Completer
cabalKeywords) [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ Map Text (Map Text Completer) -> [Text]
forall k a. Map k a -> [k]
Map.keys Map Text (Map Text Completer)
stanzaKeywordMap
)
contextToCompleter (StanzaContext
TopLevel, KeyWord Text
kw) =
case Text -> Map Text Completer -> Maybe Completer
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
kw (Map Text Completer
cabalVersionKeyword Map Text Completer -> Map Text Completer -> Map Text Completer
forall a. Semigroup a => a -> a -> a
<> Map Text Completer
cabalKeywords) of
Maybe Completer
Nothing -> Log -> Completer
errorNoopCompleter (Text -> Log
LogUnknownKeyWordInContextError Text
kw)
Just Completer
l -> Completer
l
contextToCompleter (Stanza Text
s Maybe Text
_, FieldContext
None) =
case Text -> Map Text (Map Text Completer) -> Maybe (Map Text Completer)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
s Map Text (Map Text Completer)
stanzaKeywordMap of
Maybe (Map Text Completer)
Nothing -> Log -> Completer
errorNoopCompleter (Text -> Log
LogUnknownStanzaNameInContextError Text
s)
Just Map Text Completer
l -> [Text] -> Completer
constantCompleter ([Text] -> Completer) -> [Text] -> Completer
forall a b. (a -> b) -> a -> b
$ Map Text Completer -> [Text]
forall k a. Map k a -> [k]
Map.keys Map Text Completer
l
contextToCompleter (Stanza Text
s Maybe Text
_, KeyWord Text
kw) =
case Text -> Map Text (Map Text Completer) -> Maybe (Map Text Completer)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
s Map Text (Map Text Completer)
stanzaKeywordMap of
Maybe (Map Text Completer)
Nothing -> Log -> Completer
errorNoopCompleter (Text -> Log
LogUnknownStanzaNameInContextError Text
s)
Just Map Text Completer
m -> case Text -> Map Text Completer -> Maybe Completer
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
kw Map Text Completer
m of
Maybe Completer
Nothing -> Log -> Completer
errorNoopCompleter (Text -> Log
LogUnknownKeyWordInContextError Text
kw)
Just Completer
l -> Completer
l
getContext :: (MonadIO m) => Recorder (WithPriority Log) -> CabalPrefixInfo -> Rope -> MaybeT m Context
getContext :: forall (m :: * -> *).
MonadIO m =>
Recorder (WithPriority Log)
-> CabalPrefixInfo -> Rope -> MaybeT m Context
getContext Recorder (WithPriority Log)
recorder CabalPrefixInfo
prefInfo Rope
ls =
case Maybe [Text]
prevLinesM of
Just [Text]
prevLines -> do
let lvlContext :: StanzaContext
lvlContext =
if CabalPrefixInfo -> Int
completionIndentation CabalPrefixInfo
prefInfo Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
then StanzaContext
TopLevel
else [Text] -> StanzaContext
currentLevel [Text]
prevLines
case StanzaContext
lvlContext of
StanzaContext
TopLevel -> do
FieldContext
kwContext <- m (Maybe FieldContext) -> MaybeT m FieldContext
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (m (Maybe FieldContext) -> MaybeT m FieldContext)
-> (Maybe FieldContext -> m (Maybe FieldContext))
-> Maybe FieldContext
-> MaybeT m FieldContext
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe FieldContext -> m (Maybe FieldContext)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe FieldContext -> MaybeT m FieldContext)
-> Maybe FieldContext -> MaybeT m FieldContext
forall a b. (a -> b) -> a -> b
$ CabalPrefixInfo
-> [Text] -> Map Text Completer -> Maybe FieldContext
forall a.
CabalPrefixInfo -> [Text] -> Map Text a -> Maybe FieldContext
getKeyWordContext CabalPrefixInfo
prefInfo [Text]
prevLines (Map Text Completer
cabalVersionKeyword Map Text Completer -> Map Text Completer -> Map Text Completer
forall a. Semigroup a => a -> a -> a
<> Map Text Completer
cabalKeywords)
Context -> MaybeT m Context
forall a. a -> MaybeT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (StanzaContext
TopLevel, FieldContext
kwContext)
Stanza Text
s Maybe Text
n ->
case Text -> Map Text (Map Text Completer) -> Maybe (Map Text Completer)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
s Map Text (Map Text Completer)
stanzaKeywordMap of
Maybe (Map Text Completer)
Nothing -> do
Context -> MaybeT m Context
forall a. a -> MaybeT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Maybe Text -> StanzaContext
Stanza Text
s Maybe Text
n, FieldContext
None)
Just Map Text Completer
m -> do
FieldContext
kwContext <- m (Maybe FieldContext) -> MaybeT m FieldContext
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (m (Maybe FieldContext) -> MaybeT m FieldContext)
-> (Maybe FieldContext -> m (Maybe FieldContext))
-> Maybe FieldContext
-> MaybeT m FieldContext
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe FieldContext -> m (Maybe FieldContext)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe FieldContext -> MaybeT m FieldContext)
-> Maybe FieldContext -> MaybeT m FieldContext
forall a b. (a -> b) -> a -> b
$ CabalPrefixInfo
-> [Text] -> Map Text Completer -> Maybe FieldContext
forall a.
CabalPrefixInfo -> [Text] -> Map Text a -> Maybe FieldContext
getKeyWordContext CabalPrefixInfo
prefInfo [Text]
prevLines Map Text Completer
m
Context -> MaybeT m Context
forall a. a -> MaybeT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Maybe Text -> StanzaContext
Stanza Text
s Maybe Text
n, FieldContext
kwContext)
Maybe [Text]
Nothing -> do
Recorder (WithPriority Log) -> Priority -> Log -> MaybeT m ()
forall (m :: * -> *) msg.
(HasCallStack, MonadIO m) =>
Recorder (WithPriority msg) -> Priority -> msg -> m ()
logWith Recorder (WithPriority Log)
recorder Priority
Warning (Log -> MaybeT m ()) -> Log -> MaybeT m ()
forall a b. (a -> b) -> a -> b
$ Position -> Log
LogFileSplitError Position
pos
String -> MaybeT m Context
forall a. String -> MaybeT m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Abort computation"
where
pos :: Position
pos = CabalPrefixInfo -> Position
completionCursorPosition CabalPrefixInfo
prefInfo
prevLinesM :: Maybe [Text]
prevLinesM = Position -> Rope -> Maybe [Text]
splitAtPosition Position
pos Rope
ls
getCabalPrefixInfo :: FilePath -> Ghcide.PosPrefixInfo -> CabalPrefixInfo
getCabalPrefixInfo :: String -> PosPrefixInfo -> CabalPrefixInfo
getCabalPrefixInfo String
fp PosPrefixInfo
prefixInfo =
CabalPrefixInfo
{ completionPrefix :: Text
completionPrefix = Text
completionPrefix',
isStringNotation :: Maybe Apostrophe
isStringNotation = Char -> Text -> Maybe Apostrophe
mkIsStringNotation Char
separator Text
afterCursorText,
completionCursorPosition :: Position
completionCursorPosition = PosPrefixInfo -> Position
Ghcide.cursorPos PosPrefixInfo
prefixInfo,
completionRange :: Range
completionRange = Position -> Position -> Range
Range Position
completionStart Position
completionEnd,
completionWorkingDir :: String
completionWorkingDir = String -> String
FP.takeDirectory String
fp,
completionFileName :: Text
completionFileName = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String -> String
takeBaseName String
fp
}
where
completionEnd :: Position
completionEnd = PosPrefixInfo -> Position
Ghcide.cursorPos PosPrefixInfo
prefixInfo
completionStart :: Position
completionStart =
UInt -> UInt -> Position
Position
(Position -> UInt
_line Position
completionEnd)
(Position -> UInt
_character Position
completionEnd UInt -> UInt -> UInt
forall a. Num a => a -> a -> a
- (Int -> UInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> UInt) -> Int -> UInt
forall a b. (a -> b) -> a -> b
$ Text -> Int
T.length Text
completionPrefix'))
(Text
beforeCursorText, Text
afterCursorText) = Int -> Text -> (Text, Text)
T.splitAt Int
cursorColumn (Text -> (Text, Text)) -> Text -> (Text, Text)
forall a b. (a -> b) -> a -> b
$ PosPrefixInfo -> Text
Ghcide.fullLine PosPrefixInfo
prefixInfo
completionPrefix' :: Text
completionPrefix' = (Char -> Bool) -> Text -> Text
T.takeWhileEnd (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
stopConditionChars)) Text
beforeCursorText
separator :: Char
separator =
if Int -> Bool
forall a. Integral a => a -> Bool
odd (Int -> Bool) -> Int -> Bool
forall a b. (a -> b) -> a -> b
$ HasCallStack => Text -> Text -> Int
Text -> Text -> Int
T.count Text
"\"" Text
beforeCursorText
then Char
'\"'
else Char
' '
cursorColumn :: Int
cursorColumn = UInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (UInt -> Int) -> UInt -> Int
forall a b. (a -> b) -> a -> b
$ PosPrefixInfo -> Position
Ghcide.cursorPos PosPrefixInfo
prefixInfo Position -> Getting UInt Position UInt -> UInt
forall s a. s -> Getting a s a -> a
^. Getting UInt Position UInt
forall s a. HasCharacter s a => Lens' s a
Lens' Position UInt
JL.character
stopConditionChars :: String
stopConditionChars = Char
separator Char -> String -> String
forall a. a -> [a] -> [a]
: [Char
',', Char
':']
mkIsStringNotation :: Char -> T.Text -> Maybe Apostrophe
mkIsStringNotation :: Char -> Text -> Maybe Apostrophe
mkIsStringNotation Char
'\"' Text
restLine
| Just (Char
'\"', Text
_) <- Text -> Maybe (Char, Text)
T.uncons Text
restLine = Apostrophe -> Maybe Apostrophe
forall a. a -> Maybe a
Just Apostrophe
Surrounded
| Bool
otherwise = Apostrophe -> Maybe Apostrophe
forall a. a -> Maybe a
Just Apostrophe
LeftSide
mkIsStringNotation Char
_ Text
_ = Maybe Apostrophe
forall a. Maybe a
Nothing
getKeyWordContext :: CabalPrefixInfo -> [T.Text] -> Map KeyWordName a -> Maybe FieldContext
getKeyWordContext :: forall a.
CabalPrefixInfo -> [Text] -> Map Text a -> Maybe FieldContext
getKeyWordContext CabalPrefixInfo
prefInfo [Text]
ls Map Text a
keywords = do
case Maybe Text
lastNonEmptyLineM of
Maybe Text
Nothing -> FieldContext -> Maybe FieldContext
forall a. a -> Maybe a
Just FieldContext
None
Just Text
lastLine' -> do
let (Text
whiteSpaces, Text
lastLine) = (Char -> Bool) -> Text -> (Text, Text)
T.span (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') Text
lastLine'
let keywordIndentation :: Int
keywordIndentation = Text -> Int
T.length Text
whiteSpaces
let cursorIndentation :: Int
cursorIndentation = CabalPrefixInfo -> Int
completionIndentation CabalPrefixInfo
prefInfo
if Int
cursorIndentation Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
keywordIndentation
then
case (Text -> Bool) -> [Text] -> Maybe Text
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
List.find (Text -> Text -> Bool
`T.isPrefixOf` Text
lastLine) (Map Text a -> [Text]
forall k a. Map k a -> [k]
Map.keys Map Text a
keywords) of
Maybe Text
Nothing -> FieldContext -> Maybe FieldContext
forall a. a -> Maybe a
Just FieldContext
None
Just Text
kw -> FieldContext -> Maybe FieldContext
forall a. a -> Maybe a
Just (FieldContext -> Maybe FieldContext)
-> FieldContext -> Maybe FieldContext
forall a b. (a -> b) -> a -> b
$ Text -> FieldContext
KeyWord Text
kw
else FieldContext -> Maybe FieldContext
forall a. a -> Maybe a
Just FieldContext
None
where
lastNonEmptyLineM :: Maybe T.Text
lastNonEmptyLineM :: Maybe Text
lastNonEmptyLineM = do
(Text
curLine, [Text]
rest) <- [Text] -> Maybe (Text, [Text])
forall a. [a] -> Maybe (a, [a])
List.uncons [Text]
ls
let cur :: Text
cur = Text -> Text
stripPartiallyWritten Text
curLine
(Text -> Bool) -> [Text] -> Maybe Text
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
List.find (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
T.null (Text -> Bool) -> (Text -> Text) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.stripEnd) ([Text] -> Maybe Text) -> [Text] -> Maybe Text
forall a b. (a -> b) -> a -> b
$
Text
cur Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
rest
currentLevel :: [T.Text] -> StanzaContext
currentLevel :: [Text] -> StanzaContext
currentLevel [] = StanzaContext
TopLevel
currentLevel (Text
cur : [Text]
xs)
| Just (Text
s, Maybe Text
n) <- Maybe (Text, Maybe Text)
stanza = Text -> Maybe Text -> StanzaContext
Stanza Text
s Maybe Text
n
| Bool
otherwise = [Text] -> StanzaContext
currentLevel [Text]
xs
where
stanza :: Maybe (Text, Maybe Text)
stanza = [Maybe (Text, Maybe Text)] -> Maybe (Text, Maybe Text)
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum ([Maybe (Text, Maybe Text)] -> Maybe (Text, Maybe Text))
-> [Maybe (Text, Maybe Text)] -> Maybe (Text, Maybe Text)
forall a b. (a -> b) -> a -> b
$ (Text -> Maybe (Text, Maybe Text))
-> [Text] -> [Maybe (Text, Maybe Text)]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Maybe (Text, Maybe Text)
checkStanza (Map Text (Map Text Completer) -> [Text]
forall k a. Map k a -> [k]
Map.keys Map Text (Map Text Completer)
stanzaKeywordMap)
checkStanza :: StanzaType -> Maybe (StanzaType, Maybe StanzaName)
checkStanza :: Text -> Maybe (Text, Maybe Text)
checkStanza Text
t =
case Text -> Text -> Maybe Text
T.stripPrefix Text
t (Text -> Text
T.strip Text
cur) of
Just Text
n
| Text -> Bool
T.null Text
n -> (Text, Maybe Text) -> Maybe (Text, Maybe Text)
forall a. a -> Maybe a
Just (Text
t, Maybe Text
forall a. Maybe a
Nothing)
| Bool
otherwise -> (Text, Maybe Text) -> Maybe (Text, Maybe Text)
forall a. a -> Maybe a
Just (Text
t, Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
T.strip Text
n)
Maybe Text
Nothing -> Maybe (Text, Maybe Text)
forall a. Maybe a
Nothing
splitAtPosition :: Position -> Rope -> Maybe [T.Text]
splitAtPosition :: Position -> Rope -> Maybe [Text]
splitAtPosition Position
pos Rope
ls = do
(Rope, Rope)
split <- Maybe (Rope, Rope)
splitFile
[Text] -> Maybe [Text]
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Text] -> Maybe [Text]) -> [Text] -> Maybe [Text]
forall a b. (a -> b) -> a -> b
$ [Text] -> [Text]
forall a. [a] -> [a]
reverse ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ Rope -> [Text]
Rope.lines (Rope -> [Text]) -> Rope -> [Text]
forall a b. (a -> b) -> a -> b
$ (Rope, Rope) -> Rope
forall a b. (a, b) -> a
fst (Rope, Rope)
split
where
splitFile :: Maybe (Rope, Rope)
splitFile = Position -> Rope -> Maybe (Rope, Rope)
Rope.utf16SplitAtPosition Position
ropePos Rope
ls
ropePos :: Position
ropePos =
Rope.Position
{ posLine :: Word
Rope.posLine = UInt -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (UInt -> Word) -> UInt -> Word
forall a b. (a -> b) -> a -> b
$ Position
pos Position -> Getting UInt Position UInt -> UInt
forall s a. s -> Getting a s a -> a
^. Getting UInt Position UInt
forall s a. HasLine s a => Lens' s a
Lens' Position UInt
JL.line,
posColumn :: Word
Rope.posColumn = UInt -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (UInt -> Word) -> UInt -> Word
forall a b. (a -> b) -> a -> b
$ Position
pos Position -> Getting UInt Position UInt -> UInt
forall s a. s -> Getting a s a -> a
^. Getting UInt Position UInt
forall s a. HasCharacter s a => Lens' s a
Lens' Position UInt
JL.character
}
stripPartiallyWritten :: T.Text -> T.Text
stripPartiallyWritten :: Text -> Text
stripPartiallyWritten = (Char -> Bool) -> Text -> Text
T.dropWhileEnd (\Char
y -> (Char
y Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
' ') Bool -> Bool -> Bool
&& (Char
y Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
':'))
completionIndentation :: CabalPrefixInfo -> Int
completionIndentation :: CabalPrefixInfo -> Int
completionIndentation CabalPrefixInfo
prefInfo = UInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Position
pos Position -> Getting UInt Position UInt -> UInt
forall s a. s -> Getting a s a -> a
^. Getting UInt Position UInt
forall s a. HasCharacter s a => Lens' s a
Lens' Position UInt
JL.character) Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Text -> Int
T.length (Text -> Int) -> Text -> Int
forall a b. (a -> b) -> a -> b
$ CabalPrefixInfo -> Text
completionPrefix CabalPrefixInfo
prefInfo)
where
pos :: Position
pos = CabalPrefixInfo -> Position
completionCursorPosition CabalPrefixInfo
prefInfo