module Development.IDE.Plugin.Plugins.ImportUtils
  ( ImportStyle(..),
    quickFixImportKind',
    quickFixImportKind,
    renderImportStyle,
    unImportStyle,
    importStyles,
    QualifiedImportStyle(..),
    qualifiedImportStyle
  ) where

import           Data.List.NonEmpty                           (NonEmpty ((:|)))
import qualified Data.Text                                    as T
import           Development.IDE.GHC.Compat
import           Development.IDE.Plugin.CodeAction.ExactPrint (wildCardSymbol)
import           Development.IDE.Types.Exports
import           Language.LSP.Protocol.Types                  (CodeActionKind (..))

-- | Possible import styles for an 'IdentInfo'.
--
-- The first 'Text' parameter corresponds to the 'rendered' field of the
-- 'IdentInfo'.
data ImportStyle
    = ImportTopLevel T.Text
      -- ^ Import a top-level export from a module, e.g., a function, a type, a
      -- class.
      --
      -- > import M (?)
      --
      -- Some exports that have a parent, like a type-class method or an
      -- associated type/data family, can still be imported as a top-level
      -- import.
      --
      -- Note that this is not the case for constructors, they must always be
      -- imported as part of their parent data type.

    | ImportViaParent T.Text T.Text
      -- ^ Import an export (first parameter) through its parent (second
      -- parameter).
      --
      -- import M (P(?))
      --
      -- @P@ and @?@ can be a data type and a constructor, a class and a method,
      -- a class and an associated type/data family, etc.

    | ImportAllConstructors T.Text
      -- ^ Import all constructors for a specific data type.
      --
      -- import M (P(..))
      --
      -- @P@ can be a data type or a class.
  deriving Int -> ImportStyle -> ShowS
[ImportStyle] -> ShowS
ImportStyle -> String
(Int -> ImportStyle -> ShowS)
-> (ImportStyle -> String)
-> ([ImportStyle] -> ShowS)
-> Show ImportStyle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ImportStyle -> ShowS
showsPrec :: Int -> ImportStyle -> ShowS
$cshow :: ImportStyle -> String
show :: ImportStyle -> String
$cshowList :: [ImportStyle] -> ShowS
showList :: [ImportStyle] -> ShowS
Show

importStyles :: IdentInfo -> NonEmpty ImportStyle
importStyles :: IdentInfo -> NonEmpty ImportStyle
importStyles i :: IdentInfo
i@(IdentInfo {Maybe OccName
parent :: Maybe OccName
parent :: IdentInfo -> Maybe OccName
parent})
  | Just Text
p <- Maybe Text
pr
    -- Constructors always have to be imported via their parent data type, but
    -- methods and associated type/data families can also be imported as
    -- top-level exports.
  = Text -> Text -> ImportStyle
ImportViaParent Text
rend Text
p
      ImportStyle -> [ImportStyle] -> NonEmpty ImportStyle
forall a. a -> [a] -> NonEmpty a
:| [Text -> ImportStyle
ImportTopLevel Text
rend | Bool -> Bool
not (IdentInfo -> Bool
isDatacon IdentInfo
i)]
      [ImportStyle] -> [ImportStyle] -> [ImportStyle]
forall a. Semigroup a => a -> a -> a
<> [Text -> ImportStyle
ImportAllConstructors Text
p]
  | Bool
otherwise
  = Text -> ImportStyle
ImportTopLevel Text
rend ImportStyle -> [ImportStyle] -> NonEmpty ImportStyle
forall a. a -> [a] -> NonEmpty a
:| []
  where rend :: Text
rend = IdentInfo -> Text
rendered IdentInfo
i
        pr :: Maybe Text
pr = OccName -> Text
occNameText (OccName -> Text) -> Maybe OccName -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe OccName
parent

-- | Used for adding new imports
renderImportStyle :: ImportStyle -> T.Text
renderImportStyle :: ImportStyle -> Text
renderImportStyle (ImportTopLevel Text
x)   = Text
x
renderImportStyle (ImportViaParent Text
x p :: Text
p@(Text -> Maybe (Char, Text)
T.uncons -> Just (Char
'(', Text
_))) = Text
"type " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
p Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
renderImportStyle (ImportViaParent Text
x Text
p) = Text
p Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
renderImportStyle (ImportAllConstructors Text
p) = Text
p Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"(..)"

-- | Used for extending import lists
unImportStyle :: ImportStyle -> (Maybe String, String)
unImportStyle :: ImportStyle -> (Maybe String, String)
unImportStyle (ImportTopLevel Text
x)        = (Maybe String
forall a. Maybe a
Nothing, Text -> String
T.unpack Text
x)
unImportStyle (ImportViaParent Text
x Text
y)     = (String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
y, Text -> String
T.unpack Text
x)
unImportStyle (ImportAllConstructors Text
x) = (String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
x, String
wildCardSymbol)


quickFixImportKind' :: T.Text -> ImportStyle -> CodeActionKind
quickFixImportKind' :: Text -> ImportStyle -> CodeActionKind
quickFixImportKind' Text
x (ImportTopLevel Text
_) = Text -> CodeActionKind
CodeActionKind_Custom (Text -> CodeActionKind) -> Text -> CodeActionKind
forall a b. (a -> b) -> a -> b
$ Text
"quickfix.import." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".list.topLevel"
quickFixImportKind' Text
x (ImportViaParent Text
_ Text
_) = Text -> CodeActionKind
CodeActionKind_Custom (Text -> CodeActionKind) -> Text -> CodeActionKind
forall a b. (a -> b) -> a -> b
$ Text
"quickfix.import." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".list.withParent"
quickFixImportKind' Text
x (ImportAllConstructors Text
_) = Text -> CodeActionKind
CodeActionKind_Custom (Text -> CodeActionKind) -> Text -> CodeActionKind
forall a b. (a -> b) -> a -> b
$ Text
"quickfix.import." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".list.allConstructors"

quickFixImportKind :: T.Text -> CodeActionKind
quickFixImportKind :: Text -> CodeActionKind
quickFixImportKind Text
x = Text -> CodeActionKind
CodeActionKind_Custom (Text -> CodeActionKind) -> Text -> CodeActionKind
forall a b. (a -> b) -> a -> b
$ Text
"quickfix.import." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x

-- | Possible import styles for qualified imports
data QualifiedImportStyle = QualifiedImportPostfix | QualifiedImportPrefix
    deriving Int -> QualifiedImportStyle -> ShowS
[QualifiedImportStyle] -> ShowS
QualifiedImportStyle -> String
(Int -> QualifiedImportStyle -> ShowS)
-> (QualifiedImportStyle -> String)
-> ([QualifiedImportStyle] -> ShowS)
-> Show QualifiedImportStyle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> QualifiedImportStyle -> ShowS
showsPrec :: Int -> QualifiedImportStyle -> ShowS
$cshow :: QualifiedImportStyle -> String
show :: QualifiedImportStyle -> String
$cshowList :: [QualifiedImportStyle] -> ShowS
showList :: [QualifiedImportStyle] -> ShowS
Show

qualifiedImportStyle :: DynFlags -> QualifiedImportStyle
qualifiedImportStyle :: DynFlags -> QualifiedImportStyle
qualifiedImportStyle DynFlags
df | Bool
hasImportQualifedPostEnabled Bool -> Bool -> Bool
&& Bool
hasPrePositiveQualifiedWarning = QualifiedImportStyle
QualifiedImportPostfix
                        | Bool
otherwise = QualifiedImportStyle
QualifiedImportPrefix
  where hasImportQualifedPostEnabled :: Bool
hasImportQualifedPostEnabled = Extension -> DynFlags -> Bool
xopt Extension
ImportQualifiedPost DynFlags
df
        hasPrePositiveQualifiedWarning :: Bool
hasPrePositiveQualifiedWarning = WarningFlag -> DynFlags -> Bool
wopt WarningFlag
Opt_WarnPrepositiveQualifiedModule DynFlags
df