Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
14 changes: 5 additions & 9 deletions src/Language/PureScript/Ide/Usage.hs
Original file line number Diff line number Diff line change
Expand Up @@ -136,27 +136,23 @@ applySearch module_ search =
(extr, _, _, _, _) = P.everythingWithScope mempty goExpr goBinder mempty mempty

goExpr scope expr = case expr of
P.PositionedValue sp _ (P.Var i)
P.Var sp i
| Just ideValue <- preview _IdeDeclValue (P.disqualify search)
, P.isQualified search || not (_ideValueIdent ideValue `Set.member` scope) ->
[sp | map P.runIdent i == map identifierFromIdeDeclaration search]

P.PositionedValue sp _ (P.Constructor name)
P.Constructor sp name
| Just ideDtor <- traverse (preview _IdeDeclDataConstructor) search ->
[sp | name == map _ideDtorName ideDtor]
P.PositionedValue sp _ (P.Op opName)
P.Op sp opName
| Just ideOp <- traverse (preview _IdeDeclValueOperator) search ->
[sp | opName == map _ideValueOpName ideOp]
_ -> []

goBinder _ binder = case binder of
P.PositionedBinder sp _ (P.ConstructorBinder ctorName _)
P.ConstructorBinder sp ctorName _
| Just ideDtor <- traverse (preview _IdeDeclDataConstructor) search ->
[sp | ctorName == map _ideDtorName ideDtor]
P.PositionedBinder sp _ (P.OpBinder opName)
| Just op <- traverse (preview _IdeDeclValueOperator) search ->
[sp | opName == map _ideValueOpName op]
P.PositionedBinder sp _ (P.BinaryNoParensBinder (P.OpBinder opName) _ _)
P.OpBinder sp opName
| Just op <- traverse (preview _IdeDeclValueOperator) search ->
[sp | opName == map _ideValueOpName op]
_ -> []
Expand Down
30 changes: 15 additions & 15 deletions src/Language/PureScript/Sugar/TypeClasses/Deriving.hs
Original file line number Diff line number Diff line change
Expand Up @@ -445,13 +445,13 @@ deriveEq ss mn syns ds tyConNm = do
mkEqFunction _ = internalError "mkEqFunction: expected DataDeclaration"

preludeConj :: Expr -> Expr -> Expr
preludeConj = App . App (Var nullSourceSpan (Qualified (Just (ModuleName [ProperName "Data", ProperName "HeytingAlgebra"])) (Ident C.conj)))
preludeConj = App . App (Var ss (Qualified (Just (ModuleName [ProperName "Data", ProperName "HeytingAlgebra"])) (Ident C.conj)))

preludeEq :: Expr -> Expr -> Expr
preludeEq = App . App (Var nullSourceSpan (Qualified (Just dataEq) (Ident C.eq)))
preludeEq = App . App (Var ss (Qualified (Just dataEq) (Ident C.eq)))

preludeEq1 :: Expr -> Expr -> Expr
preludeEq1 = App . App (Var (Qualified (Just dataEq) (Ident C.eq1)))
preludeEq1 = App . App (Var ss (Qualified (Just dataEq) (Ident C.eq1)))

addCatch :: [CaseAlternative] -> [CaseAlternative]
addCatch xs
Expand All @@ -465,10 +465,10 @@ deriveEq ss mn syns ds tyConNm = do
identsL <- replicateM (length tys) (freshIdent "l")
identsR <- replicateM (length tys) (freshIdent "r")
tys' <- mapM (replaceAllTypeSynonymsM syns) tys
let tests = zipWith3 toEqTest (map (Var nullSourceSpan . Qualified Nothing) identsL) (map (Var nullSourceSpan . Qualified Nothing) identsR) tys'
let tests = zipWith3 toEqTest (map (Var ss . Qualified Nothing) identsL) (map (Var ss . Qualified Nothing) identsR) tys'
return $ CaseAlternative [caseBinder identsL, caseBinder identsR] (unguarded (conjAll tests))
where
caseBinder idents = ConstructorBinder nullSourceSpan (Qualified (Just mn) ctorName) (map (VarBinder nullSourceSpan) idents)
caseBinder idents = ConstructorBinder ss (Qualified (Just mn) ctorName) (map (VarBinder ss) idents)

conjAll :: [Expr] -> Expr
conjAll [] = Literal (BooleanLiteral True)
Expand All @@ -489,7 +489,7 @@ deriveEq1 ss =
[ ValueDecl (ss, []) (Ident C.eq1) Public [] (unguarded preludeEq)]
where
preludeEq :: Expr
preludeEq = Var (Qualified (Just dataEq) (Ident C.eq))
preludeEq = Var ss (Qualified (Just dataEq) (Ident C.eq))

deriveOrd
:: forall m
Expand Down Expand Up @@ -528,29 +528,29 @@ deriveOrd ss mn syns ds tyConNm = do
orderingName = Qualified (Just (ModuleName [ProperName "Data", ProperName "Ordering"])) . ProperName

orderingCtor :: Text -> Expr
orderingCtor = Constructor nullSourceSpan . orderingName
orderingCtor = Constructor ss . orderingName

orderingBinder :: Text -> Binder
orderingBinder name = ConstructorBinder nullSourceSpan (orderingName name) []
orderingBinder name = ConstructorBinder ss (orderingName name) []

ordCompare :: Expr -> Expr -> Expr
ordCompare = App . App (Var nullSourceSpan (Qualified (Just dataOrd) (Ident C.compare)))
ordCompare = App . App (Var ss (Qualified (Just dataOrd) (Ident C.compare)))

ordCompare1 :: Expr -> Expr -> Expr
ordCompare1 = App . App (Var (Qualified (Just dataOrd) (Ident C.compare1)))
ordCompare1 = App . App (Var ss (Qualified (Just dataOrd) (Ident C.compare1)))

mkCtorClauses :: ((ProperName 'ConstructorName, [Type]), Bool) -> m [CaseAlternative]
mkCtorClauses ((ctorName, tys), isLast) = do
identsL <- replicateM (length tys) (freshIdent "l")
identsR <- replicateM (length tys) (freshIdent "r")
tys' <- mapM (replaceAllTypeSynonymsM syns) tys
let tests = zipWith3 toOrdering (map (Var nullSourceSpan . Qualified Nothing) identsL) (map (Var nullSourceSpan . Qualified Nothing) identsR) tys'
extras | not isLast = [ CaseAlternative [ ConstructorBinder nullSourceSpan (Qualified (Just mn) ctorName) (replicate (length tys) NullBinder)
let tests = zipWith3 toOrdering (map (Var ss . Qualified Nothing) identsL) (map (Var ss . Qualified Nothing) identsR) tys'
extras | not isLast = [ CaseAlternative [ ConstructorBinder ss (Qualified (Just mn) ctorName) (replicate (length tys) NullBinder)
, NullBinder
]
(unguarded (orderingCtor "LT"))
, CaseAlternative [ NullBinder
, ConstructorBinder nullSourceSpan (Qualified (Just mn) ctorName) (replicate (length tys) NullBinder)
, ConstructorBinder ss (Qualified (Just mn) ctorName) (replicate (length tys) NullBinder)
]
(unguarded (orderingCtor "GT"))
]
Expand All @@ -562,7 +562,7 @@ deriveOrd ss mn syns ds tyConNm = do
: extras

where
caseBinder idents = ConstructorBinder nullSourceSpan (Qualified (Just mn) ctorName) (map (VarBinder nullSourceSpan) idents)
caseBinder idents = ConstructorBinder ss (Qualified (Just mn) ctorName) (map (VarBinder ss) idents)

appendAll :: [Expr] -> Expr
appendAll [] = orderingCtor "EQ"
Expand Down Expand Up @@ -590,7 +590,7 @@ deriveOrd1 ss =
[ ValueDecl (ss, []) (Ident C.compare1) Public [] (unguarded dataOrdCompare)]
where
dataOrdCompare :: Expr
dataOrdCompare = Var (Qualified (Just dataOrd) (Ident C.compare))
dataOrdCompare = Var ss (Qualified (Just dataOrd) (Ident C.compare))

deriveNewtype
:: forall m
Expand Down
13 changes: 6 additions & 7 deletions tests/Language/PureScript/Ide/UsageSpec.hs
Original file line number Diff line number Diff line change
Expand Up @@ -30,14 +30,13 @@ shouldBeUsage usage' (fp, range) =
do
fp `shouldBe` P.spanName usage'

(startLine, startColumn)
(P.sourcePosLine (P.spanStart usage'), P.sourcePosColumn (P.spanStart usage'))
`shouldBe`
( P.sourcePosLine (P.spanStart usage')
, P.sourcePosColumn (P.spanStart usage'))
(endLine, endColumn)
(startLine, startColumn)

(P.sourcePosLine (P.spanEnd usage'), P.sourcePosColumn (P.spanEnd usage'))
`shouldBe`
( P.sourcePosLine (P.spanEnd usage')
, P.sourcePosColumn (P.spanEnd usage'))
(endLine, endColumn)

spec :: Spec
spec = describe "Finding Usages" $ do
Expand All @@ -58,7 +57,7 @@ spec = describe "Finding Usages" $ do
Test.runIde [ load ["FindUsage", "FindUsage.Definition", "FindUsage.Reexport"]
, usage (Test.mn "FindUsage.Definition") "$%" IdeNSValue
]
usage1 `shouldBeUsage` ("src" </> "FindUsage.purs", "9:3-9:9")
usage1 `shouldBeUsage` ("src" </> "FindUsage.purs", "9:5-9:7")
it "finds a reexported usage" $ do
([_, Right (UsagesResult [usage1])], _) <- Test.inProject $
Test.runIde [ load ["FindUsage", "FindUsage.Definition", "FindUsage.Reexport"]
Expand Down