{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies      #-}

module Ide.Plugin.Cabal.Completion.Types where

import           Control.DeepSeq                 (NFData)
import           Control.Lens                    ((^.))
import           Data.Hashable
import qualified Data.Text                       as T
import           Data.Typeable
import           Development.IDE                 as D
import qualified Distribution.Fields             as Syntax
import qualified Distribution.PackageDescription as PD
import qualified Distribution.Parsec.Position    as Syntax
import           GHC.Generics
import qualified Language.LSP.Protocol.Lens      as JL

data Log
  = LogFileSplitError Position
  | -- | This should never occur since we extract the word to lookup from the same map we look it up in.
    LogUnknownKeyWordInContextError KeyWordName
  | -- | This should never occur since we extract the word to lookup from the same map we look it up in.
    LogUnknownStanzaNameInContextError StanzaName
  | LogFilePathCompleterIOError FilePath IOError
  | LogUseWithStaleFastNoResult
  | LogMapLookUpOfKnownKeyFailed T.Text
  | LogCompletionContext Context
  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
$cshowsPrec :: Int -> Log -> ShowS
showsPrec :: Int -> Log -> ShowS
$cshow :: Log -> String
show :: Log -> String
$cshowList :: [Log] -> ShowS
showList :: [Log] -> ShowS
Show)

instance Pretty Log where
  pretty :: forall ann. Log -> Doc ann
pretty = \case
    LogFileSplitError Position
pos -> Doc ann
"An error occurred when trying to separate the lines of the cabal file at position:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Position -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Position -> Doc ann
pretty Position
pos
    LogUnknownKeyWordInContextError Text
kw ->
      Doc ann
"Lookup of key word failed for:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Text -> Doc ann
forall a ann. Show a => a -> Doc ann
viaShow Text
kw
    LogUnknownStanzaNameInContextError Text
sn ->
      Doc ann
"Lookup of stanza name failed for:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Text -> Doc ann
forall a ann. Show a => a -> Doc ann
viaShow Text
sn
    LogFilePathCompleterIOError String
fp IOError
ioErr ->
      Doc ann
"When trying to complete the file path:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
fp Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"the following unexpected IO error occurred" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> IOError -> Doc ann
forall a ann. Show a => a -> Doc ann
viaShow IOError
ioErr
    Log
LogUseWithStaleFastNoResult -> Doc ann
"Package description couldn't be read"
    LogMapLookUpOfKnownKeyFailed Text
key -> Doc ann
"Lookup of key in map failed even though it should exist" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Text -> Doc ann
forall ann. Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Text
key
    LogCompletionContext Context
ctx -> Doc ann
"Completion context is:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Context -> Doc ann
forall ann. Context -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Context
ctx

type instance RuleResult ParseCabalFile = PD.GenericPackageDescription

data ParseCabalFile = ParseCabalFile
  deriving (ParseCabalFile -> ParseCabalFile -> Bool
(ParseCabalFile -> ParseCabalFile -> Bool)
-> (ParseCabalFile -> ParseCabalFile -> Bool) -> Eq ParseCabalFile
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ParseCabalFile -> ParseCabalFile -> Bool
== :: ParseCabalFile -> ParseCabalFile -> Bool
$c/= :: ParseCabalFile -> ParseCabalFile -> Bool
/= :: ParseCabalFile -> ParseCabalFile -> Bool
Eq, Int -> ParseCabalFile -> ShowS
[ParseCabalFile] -> ShowS
ParseCabalFile -> String
(Int -> ParseCabalFile -> ShowS)
-> (ParseCabalFile -> String)
-> ([ParseCabalFile] -> ShowS)
-> Show ParseCabalFile
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ParseCabalFile -> ShowS
showsPrec :: Int -> ParseCabalFile -> ShowS
$cshow :: ParseCabalFile -> String
show :: ParseCabalFile -> String
$cshowList :: [ParseCabalFile] -> ShowS
showList :: [ParseCabalFile] -> ShowS
Show, Typeable, (forall x. ParseCabalFile -> Rep ParseCabalFile x)
-> (forall x. Rep ParseCabalFile x -> ParseCabalFile)
-> Generic ParseCabalFile
forall x. Rep ParseCabalFile x -> ParseCabalFile
forall x. ParseCabalFile -> Rep ParseCabalFile x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ParseCabalFile -> Rep ParseCabalFile x
from :: forall x. ParseCabalFile -> Rep ParseCabalFile x
$cto :: forall x. Rep ParseCabalFile x -> ParseCabalFile
to :: forall x. Rep ParseCabalFile x -> ParseCabalFile
Generic)

instance Hashable ParseCabalFile

instance NFData ParseCabalFile

type instance RuleResult ParseCabalFields = [Syntax.Field Syntax.Position]

data ParseCabalFields = ParseCabalFields
  deriving (ParseCabalFields -> ParseCabalFields -> Bool
(ParseCabalFields -> ParseCabalFields -> Bool)
-> (ParseCabalFields -> ParseCabalFields -> Bool)
-> Eq ParseCabalFields
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ParseCabalFields -> ParseCabalFields -> Bool
== :: ParseCabalFields -> ParseCabalFields -> Bool
$c/= :: ParseCabalFields -> ParseCabalFields -> Bool
/= :: ParseCabalFields -> ParseCabalFields -> Bool
Eq, Int -> ParseCabalFields -> ShowS
[ParseCabalFields] -> ShowS
ParseCabalFields -> String
(Int -> ParseCabalFields -> ShowS)
-> (ParseCabalFields -> String)
-> ([ParseCabalFields] -> ShowS)
-> Show ParseCabalFields
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ParseCabalFields -> ShowS
showsPrec :: Int -> ParseCabalFields -> ShowS
$cshow :: ParseCabalFields -> String
show :: ParseCabalFields -> String
$cshowList :: [ParseCabalFields] -> ShowS
showList :: [ParseCabalFields] -> ShowS
Show, Typeable, (forall x. ParseCabalFields -> Rep ParseCabalFields x)
-> (forall x. Rep ParseCabalFields x -> ParseCabalFields)
-> Generic ParseCabalFields
forall x. Rep ParseCabalFields x -> ParseCabalFields
forall x. ParseCabalFields -> Rep ParseCabalFields x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ParseCabalFields -> Rep ParseCabalFields x
from :: forall x. ParseCabalFields -> Rep ParseCabalFields x
$cto :: forall x. Rep ParseCabalFields x -> ParseCabalFields
to :: forall x. Rep ParseCabalFields x -> ParseCabalFields
Generic)

instance Hashable ParseCabalFields

instance NFData ParseCabalFields

-- | The context a cursor can be in within a cabal file.
--
--  We can be in stanzas or the top level,
--  and additionally we can be in a context where we have already
--  written a keyword but no value for it yet
type Context = (StanzaContext, FieldContext)

-- | Context inside a cabal file.
--  Used to decide which keywords to suggest.
data StanzaContext
  = -- | Top level context in a cabal file such as 'author'
    TopLevel
  | -- | Nested context in a cabal file, such as 'library'.
    --
    -- Stanzas have their own fields which differ from top-level fields.
    -- Each stanza must be named, such as 'executable exe',
    -- except for the main library.
    Stanza !StanzaType !(Maybe StanzaName)
  deriving (StanzaContext -> StanzaContext -> Bool
(StanzaContext -> StanzaContext -> Bool)
-> (StanzaContext -> StanzaContext -> Bool) -> Eq StanzaContext
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StanzaContext -> StanzaContext -> Bool
== :: StanzaContext -> StanzaContext -> Bool
$c/= :: StanzaContext -> StanzaContext -> Bool
/= :: StanzaContext -> StanzaContext -> Bool
Eq, Int -> StanzaContext -> ShowS
[StanzaContext] -> ShowS
StanzaContext -> String
(Int -> StanzaContext -> ShowS)
-> (StanzaContext -> String)
-> ([StanzaContext] -> ShowS)
-> Show StanzaContext
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StanzaContext -> ShowS
showsPrec :: Int -> StanzaContext -> ShowS
$cshow :: StanzaContext -> String
show :: StanzaContext -> String
$cshowList :: [StanzaContext] -> ShowS
showList :: [StanzaContext] -> ShowS
Show, ReadPrec [StanzaContext]
ReadPrec StanzaContext
Int -> ReadS StanzaContext
ReadS [StanzaContext]
(Int -> ReadS StanzaContext)
-> ReadS [StanzaContext]
-> ReadPrec StanzaContext
-> ReadPrec [StanzaContext]
-> Read StanzaContext
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS StanzaContext
readsPrec :: Int -> ReadS StanzaContext
$creadList :: ReadS [StanzaContext]
readList :: ReadS [StanzaContext]
$creadPrec :: ReadPrec StanzaContext
readPrec :: ReadPrec StanzaContext
$creadListPrec :: ReadPrec [StanzaContext]
readListPrec :: ReadPrec [StanzaContext]
Read)

instance Pretty StanzaContext where
    pretty :: forall ann. StanzaContext -> Doc ann
pretty StanzaContext
TopLevel      = Doc ann
"TopLevel"
    pretty (Stanza Text
t Maybe Text
ms) = Doc ann
"Stanza" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Text -> Doc ann
forall ann. Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Text
t Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> (Doc ann -> (Text -> Doc ann) -> Maybe Text -> Doc ann
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc ann
forall a. Monoid a => a
mempty Text -> Doc ann
forall ann. Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Maybe Text
ms)

-- | Keyword context in a cabal file.
--
--  Used to decide whether to suggest values or keywords.
data FieldContext
  = -- | Key word context, where a keyword
    -- occurs right before the current word
    -- to be completed
    KeyWord !KeyWordName
  | -- | Keyword context where no keyword occurs
    -- right before the current word to be completed
    None
  deriving (FieldContext -> FieldContext -> Bool
(FieldContext -> FieldContext -> Bool)
-> (FieldContext -> FieldContext -> Bool) -> Eq FieldContext
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FieldContext -> FieldContext -> Bool
== :: FieldContext -> FieldContext -> Bool
$c/= :: FieldContext -> FieldContext -> Bool
/= :: FieldContext -> FieldContext -> Bool
Eq, Int -> FieldContext -> ShowS
[FieldContext] -> ShowS
FieldContext -> String
(Int -> FieldContext -> ShowS)
-> (FieldContext -> String)
-> ([FieldContext] -> ShowS)
-> Show FieldContext
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FieldContext -> ShowS
showsPrec :: Int -> FieldContext -> ShowS
$cshow :: FieldContext -> String
show :: FieldContext -> String
$cshowList :: [FieldContext] -> ShowS
showList :: [FieldContext] -> ShowS
Show, ReadPrec [FieldContext]
ReadPrec FieldContext
Int -> ReadS FieldContext
ReadS [FieldContext]
(Int -> ReadS FieldContext)
-> ReadS [FieldContext]
-> ReadPrec FieldContext
-> ReadPrec [FieldContext]
-> Read FieldContext
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS FieldContext
readsPrec :: Int -> ReadS FieldContext
$creadList :: ReadS [FieldContext]
readList :: ReadS [FieldContext]
$creadPrec :: ReadPrec FieldContext
readPrec :: ReadPrec FieldContext
$creadListPrec :: ReadPrec [FieldContext]
readListPrec :: ReadPrec [FieldContext]
Read)

instance Pretty FieldContext where
    pretty :: forall ann. FieldContext -> Doc ann
pretty (KeyWord Text
kw) = Doc ann
"KeyWord" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Text -> Doc ann
forall ann. Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Text
kw
    pretty FieldContext
None         = Doc ann
"No Keyword"

type KeyWordName = T.Text

type StanzaName = T.Text

type StanzaType = T.Text

-- | Information regarding the current completion status
--
--  Example: @"dir1/fi@ having been written to the file
--  would correspond to:
--
--  @
--    completionPrefix = "dir1/fi"
--    isStringNotation = LeftSide
--    ...
--  @
--
--  We define this type instead of simply using
--  VFS.PosPrefixInfo since e.g. for filepaths we
--  need more than just the word before the
--  cursor (as can be seen above),
--  since we want to capture the whole filepath
--  before the cursor.
--
--  We also use this type to wrap all information
--  necessary to complete filepaths and other values
--  in a cabal file.
data CabalPrefixInfo = CabalPrefixInfo
  { -- | text prefix to complete
    CabalPrefixInfo -> Text
completionPrefix         :: T.Text,
    -- | Did the completion happen in the context of a string notation,
    -- i.e. are there apostrophes around the item to be completed
    CabalPrefixInfo -> Maybe Apostrophe
isStringNotation         :: Maybe Apostrophe,
    -- | the current position of the cursor in the file
    CabalPrefixInfo -> Position
completionCursorPosition :: Position,
    -- | range where completion is to be inserted
    CabalPrefixInfo -> Range
completionRange          :: Range,
    -- | directory of the handled cabal file
    CabalPrefixInfo -> String
completionWorkingDir     :: FilePath,
    -- | filename of the handled cabal file
    CabalPrefixInfo -> Text
completionFileName       :: T.Text
  }
  deriving (CabalPrefixInfo -> CabalPrefixInfo -> Bool
(CabalPrefixInfo -> CabalPrefixInfo -> Bool)
-> (CabalPrefixInfo -> CabalPrefixInfo -> Bool)
-> Eq CabalPrefixInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CabalPrefixInfo -> CabalPrefixInfo -> Bool
== :: CabalPrefixInfo -> CabalPrefixInfo -> Bool
$c/= :: CabalPrefixInfo -> CabalPrefixInfo -> Bool
/= :: CabalPrefixInfo -> CabalPrefixInfo -> Bool
Eq, Int -> CabalPrefixInfo -> ShowS
[CabalPrefixInfo] -> ShowS
CabalPrefixInfo -> String
(Int -> CabalPrefixInfo -> ShowS)
-> (CabalPrefixInfo -> String)
-> ([CabalPrefixInfo] -> ShowS)
-> Show CabalPrefixInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CabalPrefixInfo -> ShowS
showsPrec :: Int -> CabalPrefixInfo -> ShowS
$cshow :: CabalPrefixInfo -> String
show :: CabalPrefixInfo -> String
$cshowList :: [CabalPrefixInfo] -> ShowS
showList :: [CabalPrefixInfo] -> ShowS
Show)

-- | Where are the apostrophes around the item to be completed?
--
--  'Surrounded' means the item to complete already has the necessary apostrophes,
--  while 'LeftSide' means, a closing apostrophe has to be added after the completion item.
data Apostrophe = Surrounded | LeftSide
  deriving (Apostrophe -> Apostrophe -> Bool
(Apostrophe -> Apostrophe -> Bool)
-> (Apostrophe -> Apostrophe -> Bool) -> Eq Apostrophe
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Apostrophe -> Apostrophe -> Bool
== :: Apostrophe -> Apostrophe -> Bool
$c/= :: Apostrophe -> Apostrophe -> Bool
/= :: Apostrophe -> Apostrophe -> Bool
Eq, Eq Apostrophe
Eq Apostrophe =>
(Apostrophe -> Apostrophe -> Ordering)
-> (Apostrophe -> Apostrophe -> Bool)
-> (Apostrophe -> Apostrophe -> Bool)
-> (Apostrophe -> Apostrophe -> Bool)
-> (Apostrophe -> Apostrophe -> Bool)
-> (Apostrophe -> Apostrophe -> Apostrophe)
-> (Apostrophe -> Apostrophe -> Apostrophe)
-> Ord Apostrophe
Apostrophe -> Apostrophe -> Bool
Apostrophe -> Apostrophe -> Ordering
Apostrophe -> Apostrophe -> Apostrophe
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Apostrophe -> Apostrophe -> Ordering
compare :: Apostrophe -> Apostrophe -> Ordering
$c< :: Apostrophe -> Apostrophe -> Bool
< :: Apostrophe -> Apostrophe -> Bool
$c<= :: Apostrophe -> Apostrophe -> Bool
<= :: Apostrophe -> Apostrophe -> Bool
$c> :: Apostrophe -> Apostrophe -> Bool
> :: Apostrophe -> Apostrophe -> Bool
$c>= :: Apostrophe -> Apostrophe -> Bool
>= :: Apostrophe -> Apostrophe -> Bool
$cmax :: Apostrophe -> Apostrophe -> Apostrophe
max :: Apostrophe -> Apostrophe -> Apostrophe
$cmin :: Apostrophe -> Apostrophe -> Apostrophe
min :: Apostrophe -> Apostrophe -> Apostrophe
Ord, Int -> Apostrophe -> ShowS
[Apostrophe] -> ShowS
Apostrophe -> String
(Int -> Apostrophe -> ShowS)
-> (Apostrophe -> String)
-> ([Apostrophe] -> ShowS)
-> Show Apostrophe
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Apostrophe -> ShowS
showsPrec :: Int -> Apostrophe -> ShowS
$cshow :: Apostrophe -> String
show :: Apostrophe -> String
$cshowList :: [Apostrophe] -> ShowS
showList :: [Apostrophe] -> ShowS
Show)

-- | Wraps a completion in apostrophes where appropriate.
--
--  If a completion starts with an apostrophe we want to end it with an apostrophe.
--  If a completed filepath contains a space, it can only be written in the cabal
--  file if it is wrapped in apostrophes, thus we wrap it.
applyStringNotation :: Maybe Apostrophe -> T.Text -> T.Text
applyStringNotation :: Maybe Apostrophe -> Text -> Text
applyStringNotation (Just Apostrophe
Surrounded) Text
compl = Text
compl
applyStringNotation (Just Apostrophe
LeftSide) Text
compl = Text
compl Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\""
applyStringNotation Maybe Apostrophe
Nothing Text
compl
  | Just Char
_ <- (Char -> Bool) -> Text -> Maybe Char
T.find (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') Text
compl = Text
"\"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
compl Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\""
  | Bool
otherwise = Text
compl

-- | Convert an LSP 'Position' to a 'Syntax.Position'.
--
-- Cabal Positions start their indexing at 1 while LSP starts at 0.
-- This helper makes sure, the translation is done properly.
lspPositionToCabalPosition :: Position -> Syntax.Position
lspPositionToCabalPosition :: Position -> Position
lspPositionToCabalPosition Position
pos = Int -> Int -> Position
Syntax.Position
  (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. HasLine s a => Lens' s a
Lens' Position UInt
JL.line) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
  (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
+ Int
1)