{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE ScopedTypeVariables #-}

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           Data.Text.Utf16.Rope                          (Rope)
import qualified Data.Text.Utf16.Rope                          as Rope
import           Development.IDE                               as D
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 Language.LSP.VFS                              as VFS
import qualified System.FilePath                               as FP
import           System.FilePath                               (takeBaseName)

-- ----------------------------------------------------------------
-- Public API for Completions
-- ----------------------------------------------------------------

-- | Takes information about the completion context within the file
--  and finds the correct completer to be applied.
contextToCompleter :: Context -> Completer
-- if we are in the top level of the cabal file and not in a keyword context,
-- we can write any top level keywords or a stanza declaration
contextToCompleter :: Context -> Completer
contextToCompleter (StanzaContext
TopLevel, FieldContext
None) =
  Completer
snippetCompleter
    forall a. Semigroup a => a -> a -> a
<> ( [Text] -> Completer
constantCompleter forall a b. (a -> b) -> a -> b
$
           forall k a. Map k a -> [k]
Map.keys (Map Text Completer
cabalVersionKeyword forall a. Semigroup a => a -> a -> a
<> Map Text Completer
cabalKeywords) forall a. [a] -> [a] -> [a]
++ forall k a. Map k a -> [k]
Map.keys Map Text (Map Text Completer)
stanzaKeywordMap
       )
-- if we are in a keyword context in the top level,
-- we look up that keyword in the top level context and can complete its possible values
contextToCompleter (StanzaContext
TopLevel, KeyWord Text
kw) =
  case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
kw (Map Text Completer
cabalVersionKeyword 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
-- if we are in a stanza and not in a keyword context,
-- we can write any of the stanza's keywords or a stanza declaration
contextToCompleter (Stanza Text
s Maybe Text
_, FieldContext
None) =
  case 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 forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [k]
Map.keys Map Text Completer
l
-- if we are in a stanza's keyword's context we can complete possible values of that keyword
contextToCompleter (Stanza Text
s Maybe Text
_, KeyWord Text
kw) =
  case 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 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

-- | Takes prefix info about the previously written text
--  and a rope (representing a file), returns the corresponding context.
--
--  Can return Nothing if an error occurs.
--
--  TODO: first line can only have cabal-version: keyword
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 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 <- forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a.
CabalPrefixInfo -> [Text] -> Map Text a -> Maybe FieldContext
getKeyWordContext CabalPrefixInfo
prefInfo [Text]
prevLines (Map Text Completer
cabalVersionKeyword forall a. Semigroup a => a -> a -> a
<> Map Text Completer
cabalKeywords)
          forall (f :: * -> *) a. Applicative f => a -> f a
pure (StanzaContext
TopLevel, FieldContext
kwContext)
        Stanza Text
s Maybe Text
n ->
          case 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
              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 <- forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a.
CabalPrefixInfo -> [Text] -> Map Text a -> Maybe FieldContext
getKeyWordContext CabalPrefixInfo
prefInfo [Text]
prevLines Map Text Completer
m
              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
      forall (m :: * -> *) msg.
(HasCallStack, MonadIO m) =>
Recorder (WithPriority msg) -> Priority -> msg -> m ()
logWith Recorder (WithPriority Log)
recorder Priority
Warning forall a b. (a -> b) -> a -> b
$ Position -> Log
LogFileSplitError Position
pos
      -- basically returns nothing
      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

-- | Takes information about the current file's file path,
--  and the cursor position in the file; and builds a CabalPrefixInfo
--  with the prefix up to that cursor position.
--  Checks whether a suffix needs to be completed
--  and calculates the range in the document
--  where the completion action should be applied.
getCabalPrefixInfo :: FilePath -> VFS.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
VFS.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 forall a b. (a -> b) -> a -> b
$ String -> String
takeBaseName String
fp
    }
  where
    completionEnd :: Position
completionEnd = PosPrefixInfo -> Position
VFS.cursorPos PosPrefixInfo
prefixInfo
    completionStart :: Position
completionStart =
      UInt -> UInt -> Position
Position
        (Position -> UInt
_line Position
completionEnd)
        (Position -> UInt
_character Position
completionEnd forall a. Num a => a -> a -> a
- (forall a b. (Integral a, Num b) => a -> b
fromIntegral 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 forall a b. (a -> b) -> a -> b
$ PosPrefixInfo -> Text
VFS.fullLine PosPrefixInfo
prefixInfo
    completionPrefix' :: Text
completionPrefix' = (Char -> Bool) -> Text -> Text
T.takeWhileEnd (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
stopConditionChars)) Text
beforeCursorText
    separator :: Char
separator =
      -- if there is an opening apostrophe before the cursor in the line somewhere,
      -- everything after that apostrophe is the completion prefix
      if forall a. Integral a => a -> Bool
odd forall a b. (a -> b) -> a -> b
$ Text -> Text -> Int
T.count Text
"\"" Text
beforeCursorText
        then Char
'\"'
        else Char
' '
    cursorColumn :: Int
cursorColumn = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ PosPrefixInfo -> Position
VFS.cursorPos PosPrefixInfo
prefixInfo forall s a. s -> Getting a s a -> a
^. forall s a. HasCharacter s a => Lens' s a
JL.character
    stopConditionChars :: String
stopConditionChars = Char
separator forall a. a -> [a] -> [a]
: [Char
',', Char
':']

    -- \| Takes the character occurring exactly before,
    --  and the text occurring after the item to be completed and
    --  returns whether the item is already surrounded by apostrophes.
    --
    --  Example: (@|@ indicates the cursor position)
    --
    --  @"./src|@ would call @'\"'@ @""@ and result in Just LeftSide
    --
    --  @"./src|"@ would call @'\"'@ @'\"'@ and result in Just Surrounded
    --
    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 = forall a. a -> Maybe a
Just Apostrophe
Surrounded
      | Bool
otherwise = forall a. a -> Maybe a
Just Apostrophe
LeftSide
    mkIsStringNotation Char
_ Text
_ = forall a. Maybe a
Nothing

-- ----------------------------------------------------------------
-- Implementation Details
-- ----------------------------------------------------------------

-- | Takes prefix info about the previously written text,
--  a list of lines (representing a file) and a map of
--  keywords and returns a keyword context if the
--  previously written keyword matches one in the map.
--
--  From a cursor position, we traverse the cabal file upwards to
--  find the latest written keyword if there is any.
--  Values may be written on subsequent lines,
--  in order to allow for this we take the indentation of the current
--  word to be completed into account to find the correct keyword context.
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 -> forall a. a -> Maybe a
Just FieldContext
None
    Just Text
lastLine' -> do
      let (Text
whiteSpaces, Text
lastLine) = (Char -> Bool) -> Text -> (Text, Text)
T.span (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
      -- in order to be in a keyword context the cursor needs
      -- to be indented more than the keyword
      if Int
cursorIndentation forall a. Ord a => a -> a -> Bool
> Int
keywordIndentation
        then -- if the last thing written was a keyword without a value
        case forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
List.find (Text -> Text -> Bool
`T.isPrefixOf` Text
lastLine) (forall k a. Map k a -> [k]
Map.keys Map Text a
keywords) of
          Maybe Text
Nothing -> forall a. a -> Maybe a
Just FieldContext
None
          Just Text
kw -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Text -> FieldContext
KeyWord Text
kw
        else forall a. a -> Maybe a
Just FieldContext
None
  where
    lastNonEmptyLineM :: Maybe T.Text
    lastNonEmptyLineM :: Maybe Text
lastNonEmptyLineM = do
      (Text
curLine, [Text]
rest) <- forall a. [a] -> Maybe (a, [a])
List.uncons [Text]
ls
      -- represents the current line while disregarding the
      -- currently written text we want to complete
      let cur :: Text
cur = Text -> Text
stripPartiallyWritten Text
curLine
      forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
List.find (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
T.null forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.stripEnd) forall a b. (a -> b) -> a -> b
$
        Text
cur forall a. a -> [a] -> [a]
: [Text]
rest

-- | Traverse the given lines (starting before current cursor position
--  up to the start of the file) to find the nearest stanza declaration,
--  if none is found we are in the top level context.
--
--  TODO: this could be merged with getKeyWordContext in order to increase
--  performance by reducing the number of times we have to traverse the cabal file.
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 = forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Text -> Maybe (Text, Maybe Text)
checkStanza (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 -> forall a. a -> Maybe a
Just (Text
t, forall a. Maybe a
Nothing)
          | Bool
otherwise -> forall a. a -> Maybe a
Just (Text
t, forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Text -> Text
T.strip Text
n)
        Maybe Text
Nothing -> forall a. Maybe a
Nothing

-- | Get all lines before the given cursor position in the given file
--  and reverse their order to traverse backwards starting from the given position.
splitAtPosition :: Position -> Rope -> Maybe [T.Text]
splitAtPosition :: Position -> Rope -> Maybe [Text]
splitAtPosition Position
pos Rope
ls = do
  (Rope, Rope)
split <- Maybe (Rope, Rope)
splitFile
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ Rope -> [Text]
Rope.lines forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> a
fst (Rope, Rope)
split
  where
    splitFile :: Maybe (Rope, Rope)
splitFile = Position -> Rope -> Maybe (Rope, Rope)
Rope.splitAtPosition Position
ropePos Rope
ls
    ropePos :: Position
ropePos =
      Rope.Position
        { posLine :: Word
Rope.posLine = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Position
pos forall s a. s -> Getting a s a -> a
^. forall s a. HasLine s a => Lens' s a
JL.line,
          posColumn :: Word
Rope.posColumn = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Position
pos forall s a. s -> Getting a s a -> a
^. forall s a. HasCharacter s a => Lens' s a
JL.character
        }

-- | Takes a line of text and removes the last partially
-- written word to be completed.
stripPartiallyWritten :: T.Text -> T.Text
stripPartiallyWritten :: Text -> Text
stripPartiallyWritten = (Char -> Bool) -> Text -> Text
T.dropWhileEnd (\Char
y -> (Char
y forall a. Eq a => a -> a -> Bool
/= Char
' ') Bool -> Bool -> Bool
&& (Char
y forall a. Eq a => a -> a -> Bool
/= Char
':'))

-- | Calculates how many spaces the currently completed item is indented.
completionIndentation :: CabalPrefixInfo -> Int
completionIndentation :: CabalPrefixInfo -> Int
completionIndentation CabalPrefixInfo
prefInfo = forall a b. (Integral a, Num b) => a -> b
fromIntegral (Position
pos forall s a. s -> Getting a s a -> a
^. forall s a. HasCharacter s a => Lens' s a
JL.character) forall a. Num a => a -> a -> a
- (Text -> Int
T.length forall a b. (a -> b) -> a -> b
$ CabalPrefixInfo -> Text
completionPrefix CabalPrefixInfo
prefInfo)
  where
    pos :: Position
pos = CabalPrefixInfo -> Position
completionCursorPosition CabalPrefixInfo
prefInfo