module Language.PureScript.Ide.Imports
( addImplicitImport
, addQualifiedImport
, addImportForIdentifier
, answerRequest
, parseImportsFromFile
, 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)
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)
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)
data ImportParse = ImportParse
{ ImportParse -> ModuleName
ipModuleName :: P.ModuleName
, ImportParse -> SourcePos
ipStart :: P.SourcePos
, ImportParse -> SourcePos
ipEnd :: P.SourcePos
, ImportParse -> [Import]
ipImports :: [Import]
}
parseModuleHeader :: Text -> Either (NE.NonEmpty CST.ParserError) ImportParse
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
, 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
addImplicitImport
:: (MonadIO m, MonadError IdeError m)
=> FilePath
-> P.ModuleName
-> 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)
addQualifiedImport
:: (MonadIO m, MonadError IdeError m)
=> FilePath
-> P.ModuleName
-> P.ModuleName
-> 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)
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 =
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)
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
ideSpan :: P.SourceSpan
ideSpan :: SourceSpan
ideSpan = String -> SourceSpan
P.internalModuleSourceSpan String
"<psc-ide>"
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
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) =>
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?")
[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
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) =>
String
-> IdeDeclaration -> ModuleName -> Maybe ModuleName -> m [Text]
addExplicitImport String
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
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)
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
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'))
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