-----------------------------------------------------------------------------
--
-- Module      : Language.PureScript.Ide.Imports
-- Description : Provides functionality to manage imports
-- Copyright   : Christoph Hegemann 2016
-- License     : MIT (http://opensource.org/licenses/MIT)
--
-- Maintainer  : Christoph Hegemann <christoph.hegemann1337@gmail.com>
-- Stability   : experimental
--
-- |
-- Provides functionality to manage imports
-----------------------------------------------------------------------------

module Language.PureScript.Ide.Imports
       ( addImplicitImport
       , addQualifiedImport
       , addImportForIdentifier
       , answerRequest
       , parseImportsFromFile
         -- for tests
       , parseImport
       , prettyPrintImportSection
       , addImplicitImport'
       , addQualifiedImport'
       , addExplicitImport'
       , sliceImportSection
       , prettyPrintImport'
       , Import(Import)
       )
       where

import           Protolude hiding (moduleName)

import           Control.Lens                       ((^.), (%~), ix, has)
import           Data.List                          (nubBy, partition)
import qualified Data.List.NonEmpty                 as NE
import qualified Data.Map                           as Map
import qualified Data.Text                          as T
import qualified Language.PureScript                as P
import qualified Language.PureScript.Constants.Prim as C
import qualified Language.PureScript.CST            as CST
import           Language.PureScript.Ide.Completion
import           Language.PureScript.Ide.Error
import           Language.PureScript.Ide.Filter
import           Language.PureScript.Ide.State
import           Language.PureScript.Ide.Prim
import           Language.PureScript.Ide.Types
import           Language.PureScript.Ide.Util
import           System.IO.UTF8                     (writeUTF8FileT)

data Import = Import P.ModuleName P.ImportDeclarationType (Maybe P.ModuleName)
              deriving (Import -> Import -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Import -> Import -> Bool
$c/= :: Import -> Import -> Bool
== :: Import -> Import -> Bool
$c== :: Import -> Import -> Bool
Eq, Int -> Import -> ShowS
[Import] -> ShowS
Import -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Import] -> ShowS
$cshowList :: [Import] -> ShowS
show :: Import -> String
$cshow :: Import -> String
showsPrec :: Int -> Import -> ShowS
$cshowsPrec :: Int -> Import -> ShowS
Show)

-- | Reads a file and returns the parsed module name as well as the parsed
-- imports, while ignoring eventual parse errors that aren't relevant to the
-- import section
parseImportsFromFile
  :: (MonadIO m, MonadError IdeError m)
  => FilePath
  -> m (P.ModuleName, [(P.ModuleName, P.ImportDeclarationType, Maybe P.ModuleName)])
parseImportsFromFile :: forall (m :: * -> *).
(MonadIO m, MonadError IdeError m) =>
String
-> m (ModuleName,
      [(ModuleName, ImportDeclarationType, Maybe ModuleName)])
parseImportsFromFile String
file = do
  (ModuleName
mn, [Text]
_, [Import]
imports, [Text]
_) <- forall (m :: * -> *).
(MonadIO m, MonadError IdeError m) =>
String -> m (ModuleName, [Text], [Import], [Text])
parseImportsFromFile' String
file
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (ModuleName
mn, Import -> (ModuleName, ImportDeclarationType, Maybe ModuleName)
unwrapImport forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Import]
imports)
  where
    unwrapImport :: Import -> (ModuleName, ImportDeclarationType, Maybe ModuleName)
unwrapImport (Import ModuleName
a ImportDeclarationType
b Maybe ModuleName
c) = (ModuleName
a, ImportDeclarationType
b, Maybe ModuleName
c)

-- | Reads a file and returns the (lines before the imports, the imports, the
-- lines after the imports)
parseImportsFromFile'
  :: (MonadIO m, MonadError IdeError m)
  => FilePath
  -> m (P.ModuleName, [Text], [Import], [Text])
parseImportsFromFile' :: forall (m :: * -> *).
(MonadIO m, MonadError IdeError m) =>
String -> m (ModuleName, [Text], [Import], [Text])
parseImportsFromFile' String
fp = do
  (String
_, Text
file) <- forall (m :: * -> *).
(MonadIO m, MonadError IdeError m) =>
String -> m (String, Text)
ideReadFile String
fp
  case [Text] -> Either Text (ModuleName, [Text], [Import], [Text])
sliceImportSection (Text -> [Text]
T.lines Text
file) of
    Right (ModuleName, [Text], [Import], [Text])
res -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (ModuleName, [Text], [Import], [Text])
res
    Left Text
err -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text -> IdeError
GeneralError Text
err)

-- | @ImportParse@ holds the data we extract out of a partial parse of the
-- sourcefile
data ImportParse = ImportParse
  { ImportParse -> ModuleName
ipModuleName :: P.ModuleName
  -- ^ the module name we parse
  , ImportParse -> SourcePos
ipStart :: P.SourcePos
  -- ^ the beginning of the import section. If `import Prelude` was the first
  -- import, this would point at `i`
  , ImportParse -> SourcePos
ipEnd :: P.SourcePos
  -- ^ the end of the import section
  , ImportParse -> [Import]
ipImports :: [Import]
  -- ^ the extracted import declarations
  }

parseModuleHeader :: Text -> Either (NE.NonEmpty CST.ParserError) ImportParse
parseModuleHeader :: Text -> Either (NonEmpty ParserError) ImportParse
parseModuleHeader Text
src = do
  CST.PartialResult Module ()
md ([ParserWarning], Either (NonEmpty ParserError) (Module ()))
_ <- [LexResult]
-> Either (NonEmpty ParserError) (PartialResult (Module ()))
CST.parseModule forall a b. (a -> b) -> a -> b
$ [LexResult] -> [LexResult]
CST.lenient forall a b. (a -> b) -> a -> b
$ Text -> [LexResult]
CST.lexModule Text
src
  let
    mn :: ModuleName
mn = forall a. Name a -> a
CST.nameValue forall a b. (a -> b) -> a -> b
$ forall a. Module a -> Name ModuleName
CST.modNamespace Module ()
md
    decls :: [(SourceSpan, Import)]
decls = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Module a -> [ImportDecl a]
CST.modImports Module ()
md) forall a b. (a -> b) -> a -> b
$ \ImportDecl ()
decl -> do
      let ((SourceSpan
ss, [Comment]
_), ModuleName
mn', ImportDeclarationType
it, Maybe ModuleName
qual) = forall a.
String
-> ImportDecl a
-> (SourceAnn, ModuleName, ImportDeclarationType, Maybe ModuleName)
CST.convertImportDecl String
"<purs-ide>" ImportDecl ()
decl
      (SourceSpan
ss, ModuleName -> ImportDeclarationType -> Maybe ModuleName -> Import
Import ModuleName
mn' ImportDeclarationType
it Maybe ModuleName
qual)
  case (forall (f :: * -> *) a. Foldable f => f a -> Maybe a
head [(SourceSpan, Import)]
decls, forall a. [a] -> Maybe a
lastMay [(SourceSpan, Import)]
decls) of
    (Just (SourceSpan, Import)
hd, Just (SourceSpan, Import)
ls) -> do
      let
        ipStart :: SourcePos
ipStart = SourceSpan -> SourcePos
P.spanStart forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> a
fst (SourceSpan, Import)
hd
        ipEnd :: SourcePos
ipEnd = SourceSpan -> SourcePos
P.spanEnd forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> a
fst (SourceSpan, Import)
ls
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ModuleName -> SourcePos -> SourcePos -> [Import] -> ImportParse
ImportParse ModuleName
mn SourcePos
ipStart SourcePos
ipEnd forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(SourceSpan, Import)]
decls
    (Maybe (SourceSpan, Import), Maybe (SourceSpan, Import))
_ -> do
      let pos :: SourcePos
pos = SourcePos -> SourcePos
CST.sourcePos forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourceRange -> SourcePos
CST.srcEnd forall b c a. (b -> c) -> (a -> b) -> a -> c
. TokenAnn -> SourceRange
CST.tokRange forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourceToken -> TokenAnn
CST.tokAnn forall a b. (a -> b) -> a -> b
$ forall a. Module a -> SourceToken
CST.modWhere Module ()
md
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ModuleName -> SourcePos -> SourcePos -> [Import] -> ImportParse
ImportParse ModuleName
mn SourcePos
pos SourcePos
pos []

sliceImportSection :: [Text] -> Either Text (P.ModuleName, [Text], [Import], [Text])
sliceImportSection :: [Text] -> Either Text (ModuleName, [Text], [Import], [Text])
sliceImportSection [Text]
fileLines = forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (forall a b. ConvertText a b => a -> b
toS forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParserError -> String
CST.prettyPrintError forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NonEmpty a -> a
NE.head) forall a b. (a -> b) -> a -> b
$ do
  ImportParse{[Import]
SourcePos
ModuleName
ipImports :: [Import]
ipEnd :: SourcePos
ipStart :: SourcePos
ipModuleName :: ModuleName
ipImports :: ImportParse -> [Import]
ipEnd :: ImportParse -> SourcePos
ipStart :: ImportParse -> SourcePos
ipModuleName :: ImportParse -> ModuleName
..} <- Text -> Either (NonEmpty ParserError) ImportParse
parseModuleHeader Text
file
  forall (f :: * -> *) a. Applicative f => a -> f a
pure
    ( ModuleName
ipModuleName
    , SourcePos -> SourcePos -> [Text]
sliceFile (Int -> Int -> SourcePos
P.SourcePos Int
1 Int
1) (SourcePos -> SourcePos
prevPos SourcePos
ipStart)
    , [Import]
ipImports
    -- Not sure why I need to drop 1 here, but it makes the tests pass
    , forall a. Int -> [a] -> [a]
drop Int
1 (SourcePos -> SourcePos -> [Text]
sliceFile (SourcePos -> SourcePos
nextPos SourcePos
ipEnd) (Int -> Int -> SourcePos
P.SourcePos (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
fileLines) (Int -> Int
lineLength (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
fileLines))))
    )
  where
    prevPos :: SourcePos -> SourcePos
prevPos (P.SourcePos Int
l Int
c)
      | Int
l forall a. Eq a => a -> a -> Bool
== Int
1 Bool -> Bool -> Bool
&& Int
c forall a. Eq a => a -> a -> Bool
== Int
1 = Int -> Int -> SourcePos
P.SourcePos Int
l Int
c
      | Int
c forall a. Eq a => a -> a -> Bool
== Int
1 = Int -> Int -> SourcePos
P.SourcePos (Int
l forall a. Num a => a -> a -> a
- Int
1) (Int -> Int
lineLength (Int
l forall a. Num a => a -> a -> a
- Int
1))
      | Bool
otherwise = Int -> Int -> SourcePos
P.SourcePos Int
l (Int
c forall a. Num a => a -> a -> a
- Int
1)
    nextPos :: SourcePos -> SourcePos
nextPos (P.SourcePos Int
l Int
c)
      | Int
c forall a. Eq a => a -> a -> Bool
== Int -> Int
lineLength Int
l = Int -> Int -> SourcePos
P.SourcePos (Int
l forall a. Num a => a -> a -> a
+ Int
1) Int
1
      | Bool
otherwise = Int -> Int -> SourcePos
P.SourcePos Int
l (Int
c forall a. Num a => a -> a -> a
+ Int
1)
    file :: Text
file = [Text] -> Text
T.unlines [Text]
fileLines
    lineLength :: Int -> Int
lineLength Int
l = Text -> Int
T.length ([Text]
fileLines forall s a. s -> Getting a s a -> a
^. forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix (Int
l forall a. Num a => a -> a -> a
- Int
1))
    sliceFile :: SourcePos -> SourcePos -> [Text]
sliceFile (P.SourcePos Int
l1 Int
c1) (P.SourcePos Int
l2 Int
c2) =
      [Text]
fileLines
      forall a b. a -> (a -> b) -> b
& forall a. Int -> [a] -> [a]
drop (Int
l1 forall a. Num a => a -> a -> a
- Int
1)
      forall a b. a -> (a -> b) -> b
& forall a. Int -> [a] -> [a]
take (Int
l2 forall a. Num a => a -> a -> a
- Int
l1 forall a. Num a => a -> a -> a
+ Int
1)
      forall a b. a -> (a -> b) -> b
& forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Int
0 forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Int -> Text -> Text
T.drop (Int
c1 forall a. Num a => a -> a -> a
- Int
1)
      forall a b. a -> (a -> b) -> b
& forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix (Int
l2 forall a. Num a => a -> a -> a
- Int
l1) forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Int -> Text -> Text
T.take Int
c2

-- | Adds an implicit import like @import Prelude@ to a Sourcefile.
addImplicitImport
  :: (MonadIO m, MonadError IdeError m)
  => FilePath     -- ^ The source file read from
  -> P.ModuleName -- ^ The module to import
  -> m [Text]
addImplicitImport :: forall (m :: * -> *).
(MonadIO m, MonadError IdeError m) =>
String -> ModuleName -> m [Text]
addImplicitImport String
fp ModuleName
mn = do
  (ModuleName
_, [Text]
pre, [Import]
imports, [Text]
post) <- forall (m :: * -> *).
(MonadIO m, MonadError IdeError m) =>
String -> m (ModuleName, [Text], [Import], [Text])
parseImportsFromFile' String
fp
  let newImportSection :: [Text]
newImportSection = [Import] -> ModuleName -> [Text]
addImplicitImport' [Import]
imports ModuleName
mn
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ([Text], [Text], [Text]) -> [Text]
joinSections ([Text]
pre, [Text]
newImportSection, [Text]
post)

addImplicitImport' :: [Import] -> P.ModuleName -> [Text]
addImplicitImport' :: [Import] -> ModuleName -> [Text]
addImplicitImport' [Import]
imports ModuleName
mn =
  [Import] -> [Text]
prettyPrintImportSection (ModuleName -> ImportDeclarationType -> Maybe ModuleName -> Import
Import ModuleName
mn ImportDeclarationType
P.Implicit forall a. Maybe a
Nothing forall a. a -> [a] -> [a]
: [Import]
imports)

-- | Adds a qualified import like @import Data.Map as Map@ to a source file.
addQualifiedImport
  :: (MonadIO m, MonadError IdeError m)
  => FilePath
  -- ^ The sourcefile read from
  -> P.ModuleName
  -- ^ The module to import
  -> P.ModuleName
  -- ^ The qualifier under which to import
  -> m [Text]
addQualifiedImport :: forall (m :: * -> *).
(MonadIO m, MonadError IdeError m) =>
String -> ModuleName -> ModuleName -> m [Text]
addQualifiedImport String
fp ModuleName
mn ModuleName
qualifier = do
  (ModuleName
_, [Text]
pre, [Import]
imports, [Text]
post) <- forall (m :: * -> *).
(MonadIO m, MonadError IdeError m) =>
String -> m (ModuleName, [Text], [Import], [Text])
parseImportsFromFile' String
fp
  let newImportSection :: [Text]
newImportSection = [Import] -> ModuleName -> ModuleName -> [Text]
addQualifiedImport' [Import]
imports ModuleName
mn ModuleName
qualifier
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ([Text], [Text], [Text]) -> [Text]
joinSections ([Text]
pre, [Text]
newImportSection, [Text]
post)

addQualifiedImport' :: [Import] -> P.ModuleName -> P.ModuleName -> [Text]
addQualifiedImport' :: [Import] -> ModuleName -> ModuleName -> [Text]
addQualifiedImport' [Import]
imports ModuleName
mn ModuleName
qualifier =
  [Import] -> [Text]
prettyPrintImportSection (ModuleName -> ImportDeclarationType -> Maybe ModuleName -> Import
Import ModuleName
mn ImportDeclarationType
P.Implicit (forall a. a -> Maybe a
Just ModuleName
qualifier) forall a. a -> [a] -> [a]
: [Import]
imports)

-- | Adds an explicit import like @import Prelude (unit)@ to a Sourcefile. If an
-- explicit import already exists for the given module, it adds the identifier
-- to that imports list.
--
-- So @addExplicitImport "/File.purs" "bind" "Prelude"@ with an already existing
-- @import Prelude (bind)@ in the file File.purs returns @["import Prelude
-- (bind, unit)"]@
addExplicitImport :: (MonadIO m, MonadError IdeError m) =>
                     FilePath -> IdeDeclaration -> P.ModuleName -> Maybe P.ModuleName -> m [Text]
addExplicitImport :: forall (m :: * -> *).
(MonadIO m, MonadError IdeError m) =>
String
-> IdeDeclaration -> ModuleName -> Maybe ModuleName -> m [Text]
addExplicitImport String
fp IdeDeclaration
decl ModuleName
moduleName Maybe ModuleName
qualifier = do
  (ModuleName
mn, [Text]
pre, [Import]
imports, [Text]
post) <- forall (m :: * -> *).
(MonadIO m, MonadError IdeError m) =>
String -> m (ModuleName, [Text], [Import], [Text])
parseImportsFromFile' String
fp
  let newImportSection :: [Import]
newImportSection =
        -- TODO: Open an issue when this PR is merged, we should optimise this
        -- so that this case does not write to disc
        if ModuleName
mn forall a. Eq a => a -> a -> Bool
== ModuleName
moduleName
        then [Import]
imports
        else IdeDeclaration
-> ModuleName -> Maybe ModuleName -> [Import] -> [Import]
addExplicitImport' IdeDeclaration
decl ModuleName
moduleName Maybe ModuleName
qualifier [Import]
imports
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ([Text], [Text], [Text]) -> [Text]
joinSections ([Text]
pre, [Import] -> [Text]
prettyPrintImportSection [Import]
newImportSection, [Text]
post)

addExplicitImport' :: IdeDeclaration -> P.ModuleName -> Maybe P.ModuleName -> [Import] -> [Import]
addExplicitImport' :: IdeDeclaration
-> ModuleName -> Maybe ModuleName -> [Import] -> [Import]
addExplicitImport' IdeDeclaration
decl ModuleName
moduleName Maybe ModuleName
qualifier [Import]
imports =
  let
    isImplicitlyImported :: Bool
isImplicitlyImported =
        forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\case
          Import ModuleName
mn ImportDeclarationType
P.Implicit Maybe ModuleName
qualifier' -> ModuleName
mn forall a. Eq a => a -> a -> Bool
== ModuleName
moduleName Bool -> Bool -> Bool
&& Maybe ModuleName
qualifier forall a. Eq a => a -> a -> Bool
== Maybe ModuleName
qualifier'
          Import
_ -> Bool
False) [Import]
imports
    isNotExplicitlyImportedFromPrim :: Bool
isNotExplicitlyImportedFromPrim =
      ModuleName
moduleName forall a. Eq a => a -> a -> Bool
== ModuleName
C.Prim Bool -> Bool -> Bool
&&
        Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\case
          Import ModuleName
C.Prim (P.Explicit [DeclarationRef]
_) Maybe ModuleName
Nothing -> Bool
True
          Import
_ -> Bool
False) [Import]
imports)
    -- We can't import Modules from other modules
    isModule :: Bool
isModule = forall s a. Getting Any s a -> s -> Bool
has Traversal' IdeDeclaration ModuleName
_IdeDeclModule IdeDeclaration
decl

    matches :: Import -> Bool
matches (Import ModuleName
mn (P.Explicit [DeclarationRef]
_) Maybe ModuleName
qualifier') = ModuleName
mn forall a. Eq a => a -> a -> Bool
== ModuleName
moduleName Bool -> Bool -> Bool
&& Maybe ModuleName
qualifier forall a. Eq a => a -> a -> Bool
== Maybe ModuleName
qualifier'
    matches Import
_ = Bool
False
    freshImport :: Import
freshImport = ModuleName -> ImportDeclarationType -> Maybe ModuleName -> Import
Import ModuleName
moduleName ([DeclarationRef] -> ImportDeclarationType
P.Explicit [IdeDeclaration -> DeclarationRef
refFromDeclaration IdeDeclaration
decl]) Maybe ModuleName
qualifier
  in
    if Bool
isImplicitlyImported Bool -> Bool -> Bool
|| Bool
isNotExplicitlyImportedFromPrim Bool -> Bool -> Bool
|| Bool
isModule
    then [Import]
imports
    else forall a. (a -> Bool) -> (a -> a) -> a -> [a] -> [a]
updateAtFirstOrPrepend Import -> Bool
matches (IdeDeclaration -> Import -> Import
insertDeclIntoImport IdeDeclaration
decl) Import
freshImport [Import]
imports
  where
    refFromDeclaration :: IdeDeclaration -> DeclarationRef
refFromDeclaration (IdeDeclTypeClass IdeTypeClass
tc) =
      SourceSpan -> ProperName 'ClassName -> DeclarationRef
P.TypeClassRef SourceSpan
ideSpan (IdeTypeClass
tc forall s a. s -> Getting a s a -> a
^. Lens' IdeTypeClass (ProperName 'ClassName)
ideTCName)
    refFromDeclaration (IdeDeclDataConstructor IdeDataConstructor
dtor) =
      SourceSpan
-> ProperName 'TypeName
-> Maybe [ProperName 'ConstructorName]
-> DeclarationRef
P.TypeRef SourceSpan
ideSpan (IdeDataConstructor
dtor forall s a. s -> Getting a s a -> a
^. Lens' IdeDataConstructor (ProperName 'TypeName)
ideDtorTypeName) forall a. Maybe a
Nothing
    refFromDeclaration (IdeDeclType IdeType
t) =
      SourceSpan
-> ProperName 'TypeName
-> Maybe [ProperName 'ConstructorName]
-> DeclarationRef
P.TypeRef SourceSpan
ideSpan (IdeType
t forall s a. s -> Getting a s a -> a
^. Lens' IdeType (ProperName 'TypeName)
ideTypeName) (forall a. a -> Maybe a
Just [])
    refFromDeclaration (IdeDeclValueOperator IdeValueOperator
op) =
      SourceSpan -> OpName 'ValueOpName -> DeclarationRef
P.ValueOpRef SourceSpan
ideSpan (IdeValueOperator
op forall s a. s -> Getting a s a -> a
^. Lens' IdeValueOperator (OpName 'ValueOpName)
ideValueOpName)
    refFromDeclaration (IdeDeclTypeOperator IdeTypeOperator
op) =
      SourceSpan -> OpName 'TypeOpName -> DeclarationRef
P.TypeOpRef SourceSpan
ideSpan (IdeTypeOperator
op forall s a. s -> Getting a s a -> a
^. Lens' IdeTypeOperator (OpName 'TypeOpName)
ideTypeOpName)
    refFromDeclaration IdeDeclaration
d =
      SourceSpan -> Ident -> DeclarationRef
P.ValueRef SourceSpan
ideSpan (Text -> Ident
P.Ident (IdeDeclaration -> Text
identifierFromIdeDeclaration IdeDeclaration
d))

    -- | Adds a declaration to an import:
    -- TypeDeclaration "Maybe" + Data.Maybe (maybe) -> Data.Maybe(Maybe, maybe)
    insertDeclIntoImport :: IdeDeclaration -> Import -> Import
    insertDeclIntoImport :: IdeDeclaration -> Import -> Import
insertDeclIntoImport IdeDeclaration
decl' (Import ModuleName
mn (P.Explicit [DeclarationRef]
refs) Maybe ModuleName
qual) =
      ModuleName -> ImportDeclarationType -> Maybe ModuleName -> Import
Import ModuleName
mn ([DeclarationRef] -> ImportDeclarationType
P.Explicit (forall a. Ord a => [a] -> [a]
sort (IdeDeclaration -> [DeclarationRef] -> [DeclarationRef]
insertDeclIntoRefs IdeDeclaration
decl' [DeclarationRef]
refs))) Maybe ModuleName
qual
    insertDeclIntoImport IdeDeclaration
_ Import
is = Import
is

    insertDeclIntoRefs :: IdeDeclaration -> [P.DeclarationRef] -> [P.DeclarationRef]
    insertDeclIntoRefs :: IdeDeclaration -> [DeclarationRef] -> [DeclarationRef]
insertDeclIntoRefs d :: IdeDeclaration
d@(IdeDeclDataConstructor IdeDataConstructor
dtor) [DeclarationRef]
refs =
      forall a. (a -> Bool) -> (a -> a) -> a -> [a] -> [a]
updateAtFirstOrPrepend
        (ProperName 'TypeName -> DeclarationRef -> Bool
matchType (IdeDataConstructor
dtor forall s a. s -> Getting a s a -> a
^. Lens' IdeDataConstructor (ProperName 'TypeName)
ideDtorTypeName))
        (forall {p}. p -> DeclarationRef -> DeclarationRef
insertDtor (IdeDataConstructor
dtor forall s a. s -> Getting a s a -> a
^. Lens' IdeDataConstructor (ProperName 'ConstructorName)
ideDtorName))
        (IdeDeclaration -> DeclarationRef
refFromDeclaration IdeDeclaration
d)
        [DeclarationRef]
refs
    insertDeclIntoRefs (IdeDeclType IdeType
t) [DeclarationRef]
refs
      | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any DeclarationRef -> Bool
matches [DeclarationRef]
refs = [DeclarationRef]
refs
      where
        matches :: DeclarationRef -> Bool
matches (P.TypeRef SourceSpan
_ ProperName 'TypeName
typeName Maybe [ProperName 'ConstructorName]
_) = IdeType -> ProperName 'TypeName
_ideTypeName IdeType
t forall a. Eq a => a -> a -> Bool
== ProperName 'TypeName
typeName
        matches DeclarationRef
_ = Bool
False
    insertDeclIntoRefs IdeDeclaration
dr [DeclarationRef]
refs = forall a. (a -> a -> Bool) -> [a] -> [a]
nubBy (forall a. Eq a => a -> a -> Bool
(==) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` DeclarationRef -> Maybe Text
P.prettyPrintRef) (IdeDeclaration -> DeclarationRef
refFromDeclaration IdeDeclaration
dr forall a. a -> [a] -> [a]
: [DeclarationRef]
refs)

    insertDtor :: p -> DeclarationRef -> DeclarationRef
insertDtor p
_ (P.TypeRef SourceSpan
ss ProperName 'TypeName
tn' Maybe [ProperName 'ConstructorName]
_) = SourceSpan
-> ProperName 'TypeName
-> Maybe [ProperName 'ConstructorName]
-> DeclarationRef
P.TypeRef SourceSpan
ss ProperName 'TypeName
tn' forall a. Maybe a
Nothing
    insertDtor p
_ DeclarationRef
refs = DeclarationRef
refs

    matchType :: P.ProperName 'P.TypeName -> P.DeclarationRef -> Bool
    matchType :: ProperName 'TypeName -> DeclarationRef -> Bool
matchType ProperName 'TypeName
tn (P.TypeRef SourceSpan
_ ProperName 'TypeName
n Maybe [ProperName 'ConstructorName]
_) = ProperName 'TypeName
tn forall a. Eq a => a -> a -> Bool
== ProperName 'TypeName
n
    matchType ProperName 'TypeName
_ DeclarationRef
_ = Bool
False

ideSpan :: P.SourceSpan
ideSpan :: SourceSpan
ideSpan = String -> SourceSpan
P.internalModuleSourceSpan String
"<psc-ide>"

-- | If none of the elements of the list satisfy the given predicate 'predicate', then prepend the default value 'def'
-- to the given list. Otherwise, update the first element of the list that satisfies 'predicate' with the updating
-- function 'update'.
updateAtFirstOrPrepend :: (a -> Bool) -> (a -> a) -> a -> [a] -> [a]
updateAtFirstOrPrepend :: forall a. (a -> Bool) -> (a -> a) -> a -> [a] -> [a]
updateAtFirstOrPrepend a -> Bool
predicate a -> a
update a
def [a]
xs =
  case forall a. (a -> Bool) -> [a] -> ([a], [a])
break a -> Bool
predicate [a]
xs of
    ([a]
before, []) -> a
def forall a. a -> [a] -> [a]
: [a]
before
    ([a]
before, a
x : [a]
after) -> [a]
before forall a. [a] -> [a] -> [a]
++ [a -> a
update a
x] forall a. [a] -> [a] -> [a]
++ [a]
after

-- | Looks up the given identifier in the currently loaded modules.
--
-- * Throws an error if the identifier cannot be found.
--
-- * If exactly one match is found, adds an explicit import to the importsection
--
-- * If more than one possible imports are found, reports the possibilities as a
-- list of completions.
addImportForIdentifier
  :: (Ide m, MonadError IdeError m)
  => FilePath -- ^ The Sourcefile to read from
  -> Text     -- ^ The identifier to import
  -> Maybe P.ModuleName  -- ^ The optional qualifier under which to import
  -> [Filter] -- ^ Filters to apply before searching for the identifier
  -> m (Either [Match IdeDeclaration] [Text])
addImportForIdentifier :: forall (m :: * -> *).
(Ide m, MonadError IdeError m) =>
String
-> Text
-> Maybe ModuleName
-> [Filter]
-> m (Either [Match IdeDeclaration] [Text])
addImportForIdentifier String
fp Text
ident Maybe ModuleName
qual [Filter]
filters = do
  let addPrim :: Map ModuleName [IdeDeclarationAnn]
-> Map ModuleName [IdeDeclarationAnn]
addPrim = forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union Map ModuleName [IdeDeclarationAnn]
idePrimDeclarations
  Map ModuleName [IdeDeclarationAnn]
modules <- forall (m :: * -> *).
Ide m =>
Maybe ModuleName -> m (Map ModuleName [IdeDeclarationAnn])
getAllModules forall a. Maybe a
Nothing
  let
    matches :: [Match IdeDeclaration]
matches =
      Text
-> [Filter]
-> Map ModuleName [IdeDeclarationAnn]
-> [Match IdeDeclarationAnn]
getExactMatches Text
ident [Filter]
filters (Map ModuleName [IdeDeclarationAnn]
-> Map ModuleName [IdeDeclarationAnn]
addPrim Map ModuleName [IdeDeclarationAnn]
modules)
        forall a b. a -> (a -> b) -> b
& forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap IdeDeclarationAnn -> IdeDeclaration
discardAnn)
        forall a b. a -> (a -> b) -> b
& forall a. (a -> Bool) -> [a] -> [a]
filter (\(Match (ModuleName
_, IdeDeclaration
d)) -> Bool -> Bool
not (forall s a. Getting Any s a -> s -> Bool
has Traversal' IdeDeclaration ModuleName
_IdeDeclModule IdeDeclaration
d))

  case [Match IdeDeclaration]
matches of
    [] ->
      forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text -> IdeError
NotFound Text
"Couldn't find the given identifier. \
                           \Have you loaded the corresponding module?")

    -- Only one match was found for the given identifier, so we can insert it
    -- right away
    [Match (ModuleName
m, IdeDeclaration
decl)] ->
      forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
(MonadIO m, MonadError IdeError m) =>
String
-> IdeDeclaration -> ModuleName -> Maybe ModuleName -> m [Text]
addExplicitImport String
fp IdeDeclaration
decl ModuleName
m Maybe ModuleName
qual

    -- This case comes up for newtypes and dataconstructors. Because values and
    -- types don't share a namespace we can get multiple matches from the same
    -- module. This also happens for parameterized types, as these generate both
    -- a type as well as a type synonym.

    ms :: [Match IdeDeclaration]
ms@[Match (ModuleName
m1, IdeDeclaration
d1), Match (ModuleName
m2, IdeDeclaration
d2)] ->
      if ModuleName
m1 forall a. Eq a => a -> a -> Bool
/= ModuleName
m2
         -- If the modules don't line up we just ask the user to specify the
         -- module
      then forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. a -> Either a b
Left [Match IdeDeclaration]
ms)
      else case IdeDeclaration -> IdeDeclaration -> Maybe IdeDeclaration
decideRedundantCase IdeDeclaration
d1 IdeDeclaration
d2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> IdeDeclaration -> IdeDeclaration -> Maybe IdeDeclaration
decideRedundantCase IdeDeclaration
d2 IdeDeclaration
d1 of
        -- If dataconstructor and type line up we just import the
        -- dataconstructor as that will give us an unnecessary import warning at
        -- worst
        Just IdeDeclaration
decl ->
          forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
(MonadIO m, MonadError IdeError m) =>
String
-> IdeDeclaration -> ModuleName -> Maybe ModuleName -> m [Text]
addExplicitImport String
fp IdeDeclaration
decl ModuleName
m1 Maybe ModuleName
qual
        -- Here we need the user to specify whether they wanted a 
        -- dataconstructor or a type
        Maybe IdeDeclaration
Nothing ->
          forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text -> IdeError
GeneralError Text
"Undecidable between type and dataconstructor")

    -- Multiple matches were found so we need to ask the user to clarify which
    -- module they meant
    [Match IdeDeclaration]
xs ->
      forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. a -> Either a b
Left [Match IdeDeclaration]
xs)
    where
      decideRedundantCase :: IdeDeclaration -> IdeDeclaration -> Maybe IdeDeclaration
decideRedundantCase d :: IdeDeclaration
d@(IdeDeclDataConstructor IdeDataConstructor
dtor) (IdeDeclType IdeType
t) =
        if IdeDataConstructor
dtor forall s a. s -> Getting a s a -> a
^. Lens' IdeDataConstructor (ProperName 'TypeName)
ideDtorTypeName forall a. Eq a => a -> a -> Bool
== IdeType
t forall s a. s -> Getting a s a -> a
^. Lens' IdeType (ProperName 'TypeName)
ideTypeName then forall a. a -> Maybe a
Just IdeDeclaration
d else forall a. Maybe a
Nothing
      decideRedundantCase IdeDeclType{} ts :: IdeDeclaration
ts@IdeDeclTypeSynonym{} =
        forall a. a -> Maybe a
Just IdeDeclaration
ts
      decideRedundantCase IdeDeclaration
_ IdeDeclaration
_ = forall a. Maybe a
Nothing

prettyPrintImport' :: Import -> Text
prettyPrintImport' :: Import -> Text
prettyPrintImport' (Import ModuleName
mn ImportDeclarationType
idt Maybe ModuleName
qual) =
  Text
"import " forall a. Semigroup a => a -> a -> a
<> ModuleName -> ImportDeclarationType -> Maybe ModuleName -> Text
P.prettyPrintImport ModuleName
mn ImportDeclarationType
idt Maybe ModuleName
qual

prettyPrintImportSection :: [Import] -> [Text]
prettyPrintImportSection :: [Import] -> [Text]
prettyPrintImportSection [Import]
imports =
  let
    ([Import]
implicitImports, [Import]
explicitImports) = forall a. (a -> Bool) -> [a] -> ([a], [a])
partition Import -> Bool
isImplicitImport [Import]
imports
  in
    forall a. Ord a => [a] -> [a]
sort (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map Import -> Text
prettyPrintImport' [Import]
implicitImports)
      -- Only add the extra spacing if both implicit as well as
      -- explicit/qualified imports exist
      forall a. Semigroup a => a -> a -> a
<> (forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Import]
explicitImports Bool -> Bool -> Bool
|| forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Import]
implicitImports)) forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Text
"")
      forall a. Semigroup a => a -> a -> a
<> forall a. Ord a => [a] -> [a]
sort (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map Import -> Text
prettyPrintImport' [Import]
explicitImports)
  where
    isImplicitImport :: Import -> Bool
    isImplicitImport :: Import -> Bool
isImplicitImport Import
i = case Import
i of
      Import ModuleName
_ ImportDeclarationType
P.Implicit Maybe ModuleName
Nothing -> Bool
True
      Import ModuleName
_ (P.Hiding [DeclarationRef]
_) Maybe ModuleName
Nothing -> Bool
True
      Import
_ -> Bool
False


-- | Writes a list of lines to @Just filepath@ and responds with a @TextResult@,
-- or returns the lines as a @MultilineTextResult@ if @Nothing@ was given as the
-- first argument.
answerRequest :: (MonadIO m) => Maybe FilePath -> [Text] -> m Success
answerRequest :: forall (m :: * -> *).
MonadIO m =>
Maybe String -> [Text] -> m Success
answerRequest Maybe String
outfp [Text]
rs  =
  case Maybe String
outfp of
    Maybe String
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Text] -> Success
MultilineTextResult [Text]
rs)
    Just String
outfp' -> do
      forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> Text -> IO ()
writeUTF8FileT String
outfp' ([Text] -> Text
T.unlines [Text]
rs))
      forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Success
TextResult (Text
"Written to " forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
outfp'))

-- | Test and ghci helper
parseImport :: Text -> Maybe Import
parseImport :: Text -> Maybe Import
parseImport Text
t =
  case forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a.
String
-> ImportDecl a
-> (SourceAnn, ModuleName, ImportDeclarationType, Maybe ModuleName)
CST.convertImportDecl String
"<purs-ide>" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd)
        forall a b. (a -> b) -> a -> b
$ forall a.
Parser a
-> [LexResult]
-> Either (NonEmpty ParserError) ([ParserWarning], a)
CST.runTokenParser Parser (ImportDecl ())
CST.parseImportDeclP
        forall a b. (a -> b) -> a -> b
$ Text -> [LexResult]
CST.lex Text
t of
    Right (SourceAnn
_, ModuleName
mn, ImportDeclarationType
idt, Maybe ModuleName
mmn) ->
      forall a. a -> Maybe a
Just (ModuleName -> ImportDeclarationType -> Maybe ModuleName -> Import
Import ModuleName
mn ImportDeclarationType
idt Maybe ModuleName
mmn)
    Either
  (NonEmpty ParserError)
  (SourceAnn, ModuleName, ImportDeclarationType, Maybe ModuleName)
_ -> forall a. Maybe a
Nothing

joinSections :: ([Text], [Text], [Text]) -> [Text]
joinSections :: ([Text], [Text], [Text]) -> [Text]
joinSections ([Text]
pre, [Text]
decls, [Text]
post) = [Text]
pre [Text] -> [Text] -> [Text]
`joinLine` ([Text]
decls [Text] -> [Text] -> [Text]
`joinLine` [Text]
post)
  where
  isBlank :: Text -> Bool
isBlank = (Char -> Bool) -> Text -> Bool
T.all (forall a. Eq a => a -> a -> Bool
== Char
' ')
  joinLine :: [Text] -> [Text] -> [Text]
joinLine [Text]
as [Text]
bs
    | Just Text
ln1 <- forall a. [a] -> Maybe a
lastMay [Text]
as
    , Just Text
ln2 <- forall (f :: * -> *) a. Foldable f => f a -> Maybe a
head [Text]
bs
    , Bool -> Bool
not (Text -> Bool
isBlank Text
ln1) Bool -> Bool -> Bool
&& Bool -> Bool
not (Text -> Bool
isBlank Text
ln2) =
        [Text]
as forall a. [a] -> [a] -> [a]
++ [Text
""] forall a. [a] -> [a] -> [a]
++ [Text]
bs
    | Bool
otherwise =
        [Text]
as forall a. [a] -> [a] -> [a]
++ [Text]
bs