module Language.PureScript.Ide.Imports.Actions
( addImplicitImport
, addQualifiedImport
, addImportForIdentifier
, answerRequest
, addImplicitImport'
, addQualifiedImport'
, addExplicitImport'
)
where
import Protolude hiding (moduleName)
import Control.Lens ((^.), has)
import Data.List (nubBy)
import Data.Map qualified as Map
import Data.Text qualified as T
import Language.PureScript qualified as P
import Language.PureScript.Constants.Prim qualified as C
import Language.PureScript.Ide.Completion (getExactMatches)
import Language.PureScript.Ide.Error (IdeError(..))
import Language.PureScript.Ide.Filter (Filter)
import Language.PureScript.Ide.Imports (Import(..), parseImportsFromFile', prettyPrintImportSection)
import Language.PureScript.Ide.State (getAllModules)
import Language.PureScript.Ide.Prim (idePrimDeclarations)
import Language.PureScript.Ide.Types (Ide, IdeDeclaration(..), IdeType(..), Match(..), Success(..), _IdeDeclModule, ideDtorName, ideDtorTypeName, ideTCName, ideTypeName, ideTypeOpName, ideValueOpName)
import Language.PureScript.Ide.Util (discardAnn, identifierFromIdeDeclaration)
import System.IO.UTF8 (writeUTF8FileT)
addImplicitImport
:: (MonadIO m, MonadError IdeError m)
=> FilePath
-> P.ModuleName
-> m [Text]
addImplicitImport :: forall (m :: * -> *).
(MonadIO m, MonadError IdeError m) =>
FilePath -> ModuleName -> m [Text]
addImplicitImport FilePath
fp ModuleName
mn = do
(ModuleName
_, [Text]
pre, [Import]
imports, [Text]
post) <- forall (m :: * -> *).
(MonadIO m, MonadError IdeError m) =>
FilePath -> m (ModuleName, [Text], [Import], [Text])
parseImportsFromFile' FilePath
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)
addQualifiedImport
:: (MonadIO m, MonadError IdeError m)
=> FilePath
-> P.ModuleName
-> P.ModuleName
-> m [Text]
addQualifiedImport :: forall (m :: * -> *).
(MonadIO m, MonadError IdeError m) =>
FilePath -> ModuleName -> ModuleName -> m [Text]
addQualifiedImport FilePath
fp ModuleName
mn ModuleName
qualifier = do
(ModuleName
_, [Text]
pre, [Import]
imports, [Text]
post) <- forall (m :: * -> *).
(MonadIO m, MonadError IdeError m) =>
FilePath -> m (ModuleName, [Text], [Import], [Text])
parseImportsFromFile' FilePath
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)
addExplicitImport :: (MonadIO m, MonadError IdeError m) =>
FilePath -> IdeDeclaration -> P.ModuleName -> Maybe P.ModuleName -> m [Text]
addExplicitImport :: forall (m :: * -> *).
(MonadIO m, MonadError IdeError m) =>
FilePath
-> IdeDeclaration -> ModuleName -> Maybe ModuleName -> m [Text]
addExplicitImport FilePath
fp IdeDeclaration
decl ModuleName
moduleName Maybe ModuleName
qualifier = do
(ModuleName
mn, [Text]
pre, [Import]
imports, [Text]
post) <- forall (m :: * -> *).
(MonadIO m, MonadError IdeError m) =>
FilePath -> m (ModuleName, [Text], [Import], [Text])
parseImportsFromFile' FilePath
fp
let newImportSection :: [Import]
newImportSection =
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.M_Prim Bool -> Bool -> Bool
&&
Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\case
Import ModuleName
C.M_Prim (P.Explicit [DeclarationRef]
_) Maybe ModuleName
Nothing -> Bool
True
Import
_ -> Bool
False) [Import]
imports)
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))
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
addImportForIdentifier
:: (Ide m, MonadError IdeError m)
=> FilePath
-> Text
-> Maybe P.ModuleName
-> [Filter]
-> m (Either [Match IdeDeclaration] [Text])
addImportForIdentifier :: forall (m :: * -> *).
(Ide m, MonadError IdeError m) =>
FilePath
-> Text
-> Maybe ModuleName
-> [Filter]
-> m (Either [Match IdeDeclaration] [Text])
addImportForIdentifier FilePath
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?")
[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) =>
FilePath
-> IdeDeclaration -> ModuleName -> Maybe ModuleName -> m [Text]
addExplicitImport FilePath
fp IdeDeclaration
decl ModuleName
m Maybe ModuleName
qual
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
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
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) =>
FilePath
-> IdeDeclaration -> ModuleName -> Maybe ModuleName -> m [Text]
addExplicitImport FilePath
fp IdeDeclaration
decl ModuleName
m1 Maybe ModuleName
qual
Maybe IdeDeclaration
Nothing ->
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text -> IdeError
GeneralError Text
"Undecidable between type and dataconstructor")
[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
answerRequest :: (MonadIO m) => Maybe FilePath -> [Text] -> m Success
answerRequest :: forall (m :: * -> *).
MonadIO m =>
Maybe FilePath -> [Text] -> m Success
answerRequest Maybe FilePath
outfp [Text]
rs =
case Maybe FilePath
outfp of
Maybe FilePath
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Text] -> Success
MultilineTextResult [Text]
rs)
Just FilePath
outfp' -> do
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> Text -> IO ()
writeUTF8FileT FilePath
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
<> FilePath -> Text
T.pack FilePath
outfp'))
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
ideSpan :: P.SourceSpan
ideSpan :: SourceSpan
ideSpan = FilePath -> SourceSpan
P.internalModuleSourceSpan FilePath
"<psc-ide>"
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