{-# LANGUAGE OverloadedStrings #-}
module Ide.Plugin.Cabal.Completion.Completions (contextToCompleter, getContext, getCabalPrefixInfo) where
import Control.Lens ((^.))
import Control.Monad.IO.Class (MonadIO)
import Data.List.NonEmpty (NonEmpty)
import qualified Data.List.NonEmpty as NE
import qualified Data.Map as Map
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import Development.IDE as D
import qualified Development.IDE.Plugin.Completions.Types as Ghcide
import qualified Distribution.Fields as Syntax
import qualified Distribution.Parsec.Position as Syntax
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
<> ( [KeyWordName] -> Completer
constantCompleter ([KeyWordName] -> Completer) -> [KeyWordName] -> Completer
forall a b. (a -> b) -> a -> b
$
Map KeyWordName Completer -> [KeyWordName]
forall k a. Map k a -> [k]
Map.keys (Map KeyWordName Completer
cabalVersionKeyword Map KeyWordName Completer
-> Map KeyWordName Completer -> Map KeyWordName Completer
forall a. Semigroup a => a -> a -> a
<> Map KeyWordName Completer
cabalKeywords) [KeyWordName] -> [KeyWordName] -> [KeyWordName]
forall a. [a] -> [a] -> [a]
++ Map KeyWordName (Map KeyWordName Completer) -> [KeyWordName]
forall k a. Map k a -> [k]
Map.keys Map KeyWordName (Map KeyWordName Completer)
stanzaKeywordMap
)
contextToCompleter (StanzaContext
TopLevel, KeyWord KeyWordName
kw) =
case KeyWordName -> Map KeyWordName Completer -> Maybe Completer
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup KeyWordName
kw (Map KeyWordName Completer
cabalVersionKeyword Map KeyWordName Completer
-> Map KeyWordName Completer -> Map KeyWordName Completer
forall a. Semigroup a => a -> a -> a
<> Map KeyWordName Completer
cabalKeywords) of
Maybe Completer
Nothing -> Log -> Completer
errorNoopCompleter (KeyWordName -> Log
LogUnknownKeyWordInContextError KeyWordName
kw)
Just Completer
l -> Completer
l
contextToCompleter (Stanza KeyWordName
s Maybe KeyWordName
_, FieldContext
None) =
case KeyWordName
-> Map KeyWordName (Map KeyWordName Completer)
-> Maybe (Map KeyWordName Completer)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup KeyWordName
s Map KeyWordName (Map KeyWordName Completer)
stanzaKeywordMap of
Maybe (Map KeyWordName Completer)
Nothing -> Log -> Completer
errorNoopCompleter (KeyWordName -> Log
LogUnknownStanzaNameInContextError KeyWordName
s)
Just Map KeyWordName Completer
l -> [KeyWordName] -> Completer
constantCompleter ([KeyWordName] -> Completer) -> [KeyWordName] -> Completer
forall a b. (a -> b) -> a -> b
$ Map KeyWordName Completer -> [KeyWordName]
forall k a. Map k a -> [k]
Map.keys Map KeyWordName Completer
l
contextToCompleter (Stanza KeyWordName
s Maybe KeyWordName
_, KeyWord KeyWordName
kw) =
case KeyWordName
-> Map KeyWordName (Map KeyWordName Completer)
-> Maybe (Map KeyWordName Completer)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup KeyWordName
s Map KeyWordName (Map KeyWordName Completer)
stanzaKeywordMap of
Maybe (Map KeyWordName Completer)
Nothing -> Log -> Completer
errorNoopCompleter (KeyWordName -> Log
LogUnknownStanzaNameInContextError KeyWordName
s)
Just Map KeyWordName Completer
m -> case KeyWordName -> Map KeyWordName Completer -> Maybe Completer
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup KeyWordName
kw Map KeyWordName Completer
m of
Maybe Completer
Nothing -> Log -> Completer
errorNoopCompleter (KeyWordName -> Log
LogUnknownKeyWordInContextError KeyWordName
kw)
Just Completer
l -> Completer
l
getContext :: (MonadIO m) => Recorder (WithPriority Log) -> CabalPrefixInfo -> [Syntax.Field Syntax.Position] -> m Context
getContext :: forall (m :: * -> *).
MonadIO m =>
Recorder (WithPriority Log)
-> CabalPrefixInfo -> [Field Position] -> m Context
getContext Recorder (WithPriority Log)
recorder CabalPrefixInfo
prefInfo [Field Position]
fields = do
let ctx :: Context
ctx = Position
-> NonEmpty (Int, StanzaContext)
-> KeyWordName
-> [Field Position]
-> Context
findCursorContext Position
cursor ((Int, StanzaContext) -> NonEmpty (Int, StanzaContext)
forall a. a -> NonEmpty a
NE.singleton (Int
0, StanzaContext
TopLevel)) (CabalPrefixInfo -> KeyWordName
completionPrefix CabalPrefixInfo
prefInfo) [Field Position]
fields
Recorder (WithPriority Log) -> Priority -> Log -> m ()
forall (m :: * -> *) msg.
(HasCallStack, MonadIO m) =>
Recorder (WithPriority msg) -> Priority -> msg -> m ()
logWith Recorder (WithPriority Log)
recorder Priority
Debug (Log -> m ()) -> Log -> m ()
forall a b. (a -> b) -> a -> b
$ Context -> Log
LogCompletionContext Context
ctx
Context -> m Context
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Context
ctx
where
cursor :: Position
cursor = Position -> Position
lspPositionToCabalPosition (CabalPrefixInfo -> Position
completionCursorPosition CabalPrefixInfo
prefInfo)
getCabalPrefixInfo :: FilePath -> Ghcide.PosPrefixInfo -> CabalPrefixInfo
getCabalPrefixInfo :: FilePath -> PosPrefixInfo -> CabalPrefixInfo
getCabalPrefixInfo FilePath
fp PosPrefixInfo
prefixInfo =
CabalPrefixInfo
{ completionPrefix :: KeyWordName
completionPrefix = KeyWordName
completionPrefix',
isStringNotation :: Maybe Apostrophe
isStringNotation = Char -> KeyWordName -> Maybe Apostrophe
mkIsStringNotation Char
separator KeyWordName
afterCursorText,
completionCursorPosition :: Position
completionCursorPosition = PosPrefixInfo -> Position
Ghcide.cursorPos PosPrefixInfo
prefixInfo,
completionRange :: Range
completionRange = Position -> Position -> Range
Range Position
completionStart Position
completionEnd,
completionWorkingDir :: FilePath
completionWorkingDir = FilePath -> FilePath
FP.takeDirectory FilePath
fp,
completionFileName :: KeyWordName
completionFileName = FilePath -> KeyWordName
T.pack (FilePath -> KeyWordName) -> FilePath -> KeyWordName
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
takeBaseName FilePath
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
$ KeyWordName -> Int
T.length KeyWordName
completionPrefix'))
(KeyWordName
beforeCursorText, KeyWordName
afterCursorText) = Int -> KeyWordName -> (KeyWordName, KeyWordName)
T.splitAt Int
cursorColumn (KeyWordName -> (KeyWordName, KeyWordName))
-> KeyWordName -> (KeyWordName, KeyWordName)
forall a b. (a -> b) -> a -> b
$ PosPrefixInfo -> KeyWordName
Ghcide.fullLine PosPrefixInfo
prefixInfo
completionPrefix' :: KeyWordName
completionPrefix' = (Char -> Bool) -> KeyWordName -> KeyWordName
T.takeWhileEnd (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> FilePath -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` FilePath
stopConditionChars)) KeyWordName
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 => KeyWordName -> KeyWordName -> Int
KeyWordName -> KeyWordName -> Int
T.count KeyWordName
"\"" KeyWordName
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 :: FilePath
stopConditionChars = Char
separator Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
: [Char
',', Char
':']
mkIsStringNotation :: Char -> T.Text -> Maybe Apostrophe
mkIsStringNotation :: Char -> KeyWordName -> Maybe Apostrophe
mkIsStringNotation Char
'\"' KeyWordName
restLine
| Just (Char
'\"', KeyWordName
_) <- KeyWordName -> Maybe (Char, KeyWordName)
T.uncons KeyWordName
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
_ KeyWordName
_ = Maybe Apostrophe
forall a. Maybe a
Nothing
findCursorContext ::
Syntax.Position ->
NonEmpty (Int, StanzaContext) ->
T.Text ->
[Syntax.Field Syntax.Position] ->
Context
findCursorContext :: Position
-> NonEmpty (Int, StanzaContext)
-> KeyWordName
-> [Field Position]
-> Context
findCursorContext Position
cursor NonEmpty (Int, StanzaContext)
parentHistory KeyWordName
prefixText [Field Position]
fields =
case Position -> [Field Position] -> Maybe (Field Position)
findFieldSection Position
cursor [Field Position]
fields of
Maybe (Field Position)
Nothing -> ((Int, StanzaContext) -> StanzaContext
forall a b. (a, b) -> b
snd ((Int, StanzaContext) -> StanzaContext)
-> (Int, StanzaContext) -> StanzaContext
forall a b. (a -> b) -> a -> b
$ NonEmpty (Int, StanzaContext) -> (Int, StanzaContext)
forall a. NonEmpty a -> a
NE.head NonEmpty (Int, StanzaContext)
parentHistory, FieldContext
None)
Just field :: Field Position
field@(Syntax.Field Name Position
_ [FieldLine Position]
_) -> NonEmpty (Int, StanzaContext)
-> Position -> Field Position -> Context
classifyFieldContext NonEmpty (Int, StanzaContext)
parentHistory Position
cursor Field Position
field
Just section :: Field Position
section@(Syntax.Section Name Position
_ [SectionArg Position]
args [Field Position]
sectionFields)
| Field Position -> Bool
inSameLineAsSectionName Field Position
section -> (StanzaContext
stanzaCtx, FieldContext
None)
| Bool
otherwise ->
Position
-> NonEmpty (Int, StanzaContext)
-> KeyWordName
-> [Field Position]
-> Context
findCursorContext Position
cursor
((Int, StanzaContext)
-> NonEmpty (Int, StanzaContext) -> NonEmpty (Int, StanzaContext)
forall a. a -> NonEmpty a -> NonEmpty a
NE.cons (Position -> Int
Syntax.positionCol (Field Position -> Position
forall ann. Field ann -> ann
getAnnotation Field Position
section) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, KeyWordName -> Maybe KeyWordName -> StanzaContext
Stanza (Field Position -> KeyWordName
forall ann. Field ann -> KeyWordName
getFieldName Field Position
section) ([SectionArg Position] -> Maybe KeyWordName
forall ann. [SectionArg ann] -> Maybe KeyWordName
getOptionalSectionName [SectionArg Position]
args)) NonEmpty (Int, StanzaContext)
parentHistory)
KeyWordName
prefixText [Field Position]
sectionFields
where
inSameLineAsSectionName :: Field Position -> Bool
inSameLineAsSectionName Field Position
section = Position -> Int
Syntax.positionRow (Field Position -> Position
forall ann. Field ann -> ann
getAnnotation Field Position
section) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Position -> Int
Syntax.positionRow Position
cursor
stanzaCtx :: StanzaContext
stanzaCtx = (Int, StanzaContext) -> StanzaContext
forall a b. (a, b) -> b
snd ((Int, StanzaContext) -> StanzaContext)
-> (Int, StanzaContext) -> StanzaContext
forall a b. (a -> b) -> a -> b
$ NonEmpty (Int, StanzaContext) -> (Int, StanzaContext)
forall a. NonEmpty a -> a
NE.head NonEmpty (Int, StanzaContext)
parentHistory
classifyFieldContext :: NonEmpty (Int, StanzaContext) -> Syntax.Position -> Syntax.Field Syntax.Position -> Context
classifyFieldContext :: NonEmpty (Int, StanzaContext)
-> Position -> Field Position -> Context
classifyFieldContext NonEmpty (Int, StanzaContext)
ctx Position
cursor Field Position
field
| Int
cursorColumn Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
fieldColumn Bool -> Bool -> Bool
&& Int
minIndent Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
cursorColumn = (StanzaContext
stanzaCtx, FieldContext
None)
| Int
cursorColumn Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
minIndent = Int -> NonEmpty (Int, StanzaContext) -> Context
findStanzaForColumn Int
cursorColumn NonEmpty (Int, StanzaContext)
ctx
| Bool
cursorIsInFieldName = (StanzaContext
stanzaCtx, FieldContext
None)
| Bool
cursorIsBeforeFieldName = (StanzaContext
stanzaCtx, FieldContext
None)
| Bool
otherwise = (StanzaContext
stanzaCtx, KeyWordName -> FieldContext
KeyWord (Field Position -> KeyWordName
forall ann. Field ann -> KeyWordName
getFieldName Field Position
field KeyWordName -> KeyWordName -> KeyWordName
forall a. Semigroup a => a -> a -> a
<> KeyWordName
":"))
where
(Int
minIndent, StanzaContext
stanzaCtx) = NonEmpty (Int, StanzaContext) -> (Int, StanzaContext)
forall a. NonEmpty a -> a
NE.head NonEmpty (Int, StanzaContext)
ctx
cursorIsInFieldName :: Bool
cursorIsInFieldName = Bool
inSameLineAsFieldName Bool -> Bool -> Bool
&&
Int
fieldColumn Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
cursorColumn Bool -> Bool -> Bool
&&
Int
cursorColumn Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
fieldColumn Int -> Int -> Int
forall a. Num a => a -> a -> a
+ KeyWordName -> Int
T.length (Field Position -> KeyWordName
forall ann. Field ann -> KeyWordName
getFieldName Field Position
field)
cursorIsBeforeFieldName :: Bool
cursorIsBeforeFieldName = Bool
inSameLineAsFieldName Bool -> Bool -> Bool
&&
Int
cursorColumn Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
fieldColumn
inSameLineAsFieldName :: Bool
inSameLineAsFieldName = Position -> Int
Syntax.positionRow (Field Position -> Position
forall ann. Field ann -> ann
getAnnotation Field Position
field) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Position -> Int
Syntax.positionRow Position
cursor
cursorColumn :: Int
cursorColumn = Position -> Int
Syntax.positionCol Position
cursor
fieldColumn :: Int
fieldColumn = Position -> Int
Syntax.positionCol (Field Position -> Position
forall ann. Field ann -> ann
getAnnotation Field Position
field)
findStanzaForColumn :: Int -> NonEmpty (Int, StanzaContext) -> (StanzaContext, FieldContext)
findStanzaForColumn :: Int -> NonEmpty (Int, StanzaContext) -> Context
findStanzaForColumn Int
col NonEmpty (Int, StanzaContext)
ctx = case NonEmpty (Int, StanzaContext)
-> ((Int, StanzaContext), Maybe (NonEmpty (Int, StanzaContext)))
forall a. NonEmpty a -> (a, Maybe (NonEmpty a))
NE.uncons NonEmpty (Int, StanzaContext)
ctx of
((Int
_, StanzaContext
stanza), Maybe (NonEmpty (Int, StanzaContext))
Nothing) -> (StanzaContext
stanza, FieldContext
None)
((Int
indentation, StanzaContext
stanza), Just NonEmpty (Int, StanzaContext)
res)
| Int
col Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
indentation -> Int -> NonEmpty (Int, StanzaContext) -> Context
findStanzaForColumn Int
col NonEmpty (Int, StanzaContext)
res
| Bool
otherwise -> (StanzaContext
stanza, FieldContext
None)
findFieldSection :: Syntax.Position -> [Syntax.Field Syntax.Position] -> Maybe (Syntax.Field Syntax.Position)
findFieldSection :: Position -> [Field Position] -> Maybe (Field Position)
findFieldSection Position
_cursor [] = Maybe (Field Position)
forall a. Maybe a
Nothing
findFieldSection Position
_cursor [Field Position
x] =
Field Position -> Maybe (Field Position)
forall a. a -> Maybe a
Just Field Position
x
findFieldSection Position
cursor (Field Position
x:Field Position
y:[Field Position]
ys)
| Position -> Int
Syntax.positionRow (Field Position -> Position
forall ann. Field ann -> ann
getAnnotation Field Position
x) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
cursorLine Bool -> Bool -> Bool
&& Int
cursorLine Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Position -> Int
Syntax.positionRow (Field Position -> Position
forall ann. Field ann -> ann
getAnnotation Field Position
y)
= Field Position -> Maybe (Field Position)
forall a. a -> Maybe a
Just Field Position
x
| Bool
otherwise = Position -> [Field Position] -> Maybe (Field Position)
findFieldSection Position
cursor (Field Position
yField Position -> [Field Position] -> [Field Position]
forall a. a -> [a] -> [a]
:[Field Position]
ys)
where
cursorLine :: Int
cursorLine = Position -> Int
Syntax.positionRow Position
cursor
type FieldName = T.Text
getAnnotation :: Syntax.Field ann -> ann
getAnnotation :: forall ann. Field ann -> ann
getAnnotation (Syntax.Field (Syntax.Name ann
ann FieldName
_) [FieldLine ann]
_) = ann
ann
getAnnotation (Syntax.Section (Syntax.Name ann
ann FieldName
_) [SectionArg ann]
_ [Field ann]
_) = ann
ann
getFieldName :: Syntax.Field ann -> FieldName
getFieldName :: forall ann. Field ann -> KeyWordName
getFieldName (Syntax.Field (Syntax.Name ann
_ FieldName
fn) [FieldLine ann]
_) = FieldName -> KeyWordName
T.decodeUtf8 FieldName
fn
getFieldName (Syntax.Section (Syntax.Name ann
_ FieldName
fn) [SectionArg ann]
_ [Field ann]
_) = FieldName -> KeyWordName
T.decodeUtf8 FieldName
fn
getOptionalSectionName :: [Syntax.SectionArg ann] -> Maybe T.Text
getOptionalSectionName :: forall ann. [SectionArg ann] -> Maybe KeyWordName
getOptionalSectionName [] = Maybe KeyWordName
forall a. Maybe a
Nothing
getOptionalSectionName (SectionArg ann
x:[SectionArg ann]
xs) = case SectionArg ann
x of
Syntax.SecArgName ann
_ FieldName
name -> KeyWordName -> Maybe KeyWordName
forall a. a -> Maybe a
Just (FieldName -> KeyWordName
T.decodeUtf8 FieldName
name)
SectionArg ann
_ -> [SectionArg ann] -> Maybe KeyWordName
forall ann. [SectionArg ann] -> Maybe KeyWordName
getOptionalSectionName [SectionArg ann]
xs