Skip to content

Commit 220e6ae

Browse files
kritzcreekkritzcreek
authored
[psc-ide] Restructure testing to avoid running the server (purescript#2599)
* rename IdeDeclTypeSynonym * wip * get rid of integration tests for SourceFile * merge fixes * lensSatisfies is actually anyOf * ctors for operators * ports Rebuild Spec to new test suite * ports Import integration tests to new testing api * remove Integration module && don't start a psc-ide-server for tests * add synchronous versions of load and rebuild for tests * revert Synonym name change * unify Sync rebuild and load design * remove unused dependencies
1 parent a1a37e6 commit 220e6ae

File tree

19 files changed

+376
-500
lines changed

19 files changed

+376
-500
lines changed

‎purescript.cabal‎

Lines changed: 3 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -496,7 +496,6 @@ executable psc-ide-server
496496
aeson >= 0.8 && < 1.0,
497497
bytestring -any,
498498
purescript -any,
499-
base-compat >=0.6.0,
500499
directory -any,
501500
filepath -any,
502501
monad-logger -any,
@@ -506,8 +505,7 @@ executable psc-ide-server
506505
protolude >= 0.1.6,
507506
stm -any,
508507
text -any,
509-
transformers -any,
510-
transformers-compat -any
508+
transformers -any
511509
ghc-options: -Wall -O2 -threaded
512510
hs-source-dirs: psc-ide-server
513511

@@ -543,6 +541,7 @@ test-suite tests
543541
hspec-discover -any,
544542
HUnit -any,
545543
lens -any,
544+
monad-logger -any,
546545
mtl -any,
547546
optparse-applicative -any,
548547
parsec -any,
@@ -567,14 +566,12 @@ test-suite tests
567566
TestPsci
568567
TestPscIde
569568
PscIdeSpec
569+
Language.PureScript.Ide.Test
570570
Language.PureScript.Ide.FilterSpec
571571
Language.PureScript.Ide.ImportsSpec
572-
Language.PureScript.Ide.Imports.IntegrationSpec
573-
Language.PureScript.Ide.Integration
574572
Language.PureScript.Ide.MatcherSpec
575573
Language.PureScript.Ide.RebuildSpec
576574
Language.PureScript.Ide.ReexportsSpec
577-
Language.PureScript.Ide.SourceFile.IntegrationSpec
578575
Language.PureScript.Ide.SourceFileSpec
579576
Language.PureScript.Ide.StateSpec
580577
buildable: True

‎src/Language/PureScript/Ide.hs‎

Lines changed: 34 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -47,9 +47,13 @@ handleCommand :: (Ide m, MonadLogger m, MonadError PscIdeError m) =>
4747
Command -> m Success
4848
handleCommand c = case c of
4949
Load [] ->
50-
findAvailableExterns >>= loadModules
50+
findAvailableExterns >>= loadModulesAsync
5151
Load modules ->
52-
loadModules modules
52+
loadModulesAsync modules
53+
LoadSync [] ->
54+
findAvailableExterns >>= loadModulesSync
55+
LoadSync modules ->
56+
loadModulesSync modules
5357
Type search filters currentModule ->
5458
findType search filters currentModule
5559
Complete filters matcher currentModule ->
@@ -78,7 +82,9 @@ handleCommand c = case c of
7882
Left question ->
7983
pure (CompletionResult (map (completionFromMatch . map withEmptyAnn) question))
8084
Rebuild file ->
81-
rebuildFile file
85+
rebuildFileAsync file
86+
RebuildSync file ->
87+
rebuildFileSync file
8288
Cwd ->
8389
TextResult . toS <$> liftIO getCurrentDirectory
8490
Reset ->
@@ -162,6 +168,31 @@ findAllSourceFiles = do
162168
-- server state. Then proceeds to parse all the specified sourcefiles and
163169
-- inserts their ASTs into the state. Finally kicks off an async worker, which
164170
-- populates Stage 2 and 3 of the state.
171+
loadModulesAsync
172+
:: (Ide m, MonadError PscIdeError m, MonadLogger m)
173+
=> [P.ModuleName]
174+
-> m Success
175+
loadModulesAsync moduleNames = do
176+
tr <- loadModules moduleNames
177+
178+
-- Finally we kick off the worker with @async@ and return the number of
179+
-- successfully parsed modules.
180+
env <- ask
181+
let ll = confLogLevel (ideConfiguration env)
182+
-- populateStage2 and 3 return Unit for now, so it's fine to discard this
183+
-- result. We might want to block on this in a benchmarking situation.
184+
_ <- liftIO (async (runLogger ll (runReaderT (populateStage2 *> populateStage3) env)))
185+
pure tr
186+
187+
loadModulesSync
188+
:: (Ide m, MonadError PscIdeError m, MonadLogger m)
189+
=> [P.ModuleName]
190+
-> m Success
191+
loadModulesSync moduleNames = do
192+
tr <- loadModules moduleNames
193+
populateStage2 *> populateStage3
194+
pure tr
195+
165196
loadModules
166197
:: (Ide m, MonadError PscIdeError m, MonadLogger m)
167198
=> [P.ModuleName]
@@ -182,12 +213,5 @@ loadModules moduleNames = do
182213
$(logWarn) ("Failed to parse: " <> show failures)
183214
traverse_ insertModule allModules
184215

185-
-- Finally we kick off the worker with @async@ and return the number of
186-
-- successfully parsed modules.
187-
env <- ask
188-
let ll = confLogLevel (ideConfiguration env)
189-
-- populateStage2 and 3 return Unit for now, so it's fine to discard this
190-
-- result. We might want to block on this in a benchmarking situation.
191-
_ <- liftIO (async (runLogger ll (runReaderT (populateStage2 *> populateStage3) env)))
192216
pure (TextResult ("Loaded " <> show (length efiles) <> " modules and "
193217
<> show (length allModules) <> " source files."))

‎src/Language/PureScript/Ide/Command.hs‎

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -25,6 +25,7 @@ import Language.PureScript.Ide.Types
2525

2626
data Command
2727
= Load [P.ModuleName]
28+
| LoadSync [P.ModuleName] -- used in tests
2829
| Type
2930
{ typeSearch :: Text
3031
, typeFilters :: [Filter]
@@ -54,13 +55,15 @@ data Command
5455
| Import FilePath (Maybe FilePath) [Filter] ImportCommand
5556
| List { listType :: ListType }
5657
| Rebuild FilePath -- ^ Rebuild the specified file using the loaded externs
58+
| RebuildSync FilePath -- ^ Rebuild the specified file using the loaded externs
5759
| Cwd
5860
| Reset
5961
| Quit
6062

6163
commandName :: Command -> Text
6264
commandName c = case c of
6365
Load{} -> "Load"
66+
LoadSync{} -> "LoadSync"
6467
Type{} -> "Type"
6568
Complete{} -> "Complete"
6669
Pursuit{} -> "Pursuit"
@@ -69,6 +72,7 @@ commandName c = case c of
6972
Import{} -> "Import"
7073
List{} -> "List"
7174
Rebuild{} -> "Rebuild"
75+
RebuildSync{} -> "RebuildSync"
7276
Cwd{} -> "Cwd"
7377
Reset{} -> "Reset"
7478
Quit{} -> "Quit"

‎src/Language/PureScript/Ide/Error.hs‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -29,6 +29,7 @@ data PscIdeError
2929
| ModuleFileNotFound ModuleIdent
3030
| ParseError P.ParseError Text
3131
| RebuildError [JSONError]
32+
deriving (Show, Eq)
3233

3334
instance ToJSON PscIdeError where
3435
toJSON (RebuildError errs) = object

‎src/Language/PureScript/Ide/Externs.hs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -90,7 +90,7 @@ convertDecl :: P.ExternsDeclaration -> Maybe IdeDeclaration
9090
convertDecl P.EDType{..} = Just $ IdeDeclType $
9191
IdeType edTypeName edTypeKind
9292
convertDecl P.EDTypeSynonym{..} = Just $ IdeDeclTypeSynonym
93-
(IdeSynonym edTypeSynonymName edTypeSynonymType)
93+
(IdeTypeSynonym edTypeSynonymName edTypeSynonymType)
9494
convertDecl P.EDDataConstructor{..} = Just $ IdeDeclDataConstructor $
9595
IdeDataConstructor edDataCtorName edDataCtorTypeCtor edDataCtorType
9696
convertDecl P.EDValue{..} = Just $ IdeDeclValue $

‎src/Language/PureScript/Ide/Rebuild.hs‎

Lines changed: 31 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -2,7 +2,9 @@
22
{-# LANGUAGE TemplateHaskell #-}
33

44
module Language.PureScript.Ide.Rebuild
5-
( rebuildFile
5+
( rebuildFileSync
6+
, rebuildFileAsync
7+
, rebuildFile
68
) where
79

810
import Protolude
@@ -38,8 +40,11 @@ import System.IO.UTF8 (readUTF8FileT)
3840
rebuildFile
3941
:: (Ide m, MonadLogger m, MonadError PscIdeError m)
4042
=> FilePath
43+
-- ^ The file to rebuild
44+
-> (ReaderT IdeEnvironment (LoggingT IO) () -> m ())
45+
-- ^ A runner for the second build with open exports
4146
-> m Success
42-
rebuildFile path = do
47+
rebuildFile path runOpenBuild = do
4348

4449
input <- liftIO (readUTF8FileT path)
4550

@@ -71,11 +76,32 @@ rebuildFile path = do
7176
case result of
7277
Left errors -> throwError (RebuildError (toJSONErrors False P.Error errors))
7378
Right _ -> do
74-
env <- ask
75-
let ll = confLogLevel (ideConfiguration env)
76-
_ <- liftIO (async (runLogger ll (runReaderT (rebuildModuleOpen makeEnv externs m) env)))
79+
runOpenBuild (rebuildModuleOpen makeEnv externs m)
7780
pure (RebuildSuccess (toJSONErrors False P.Warning warnings))
7881

82+
rebuildFileAsync
83+
:: forall m. (Ide m, MonadLogger m, MonadError PscIdeError m)
84+
=> FilePath -> m Success
85+
rebuildFileAsync fp = rebuildFile fp asyncRun
86+
where
87+
asyncRun :: ReaderT IdeEnvironment (LoggingT IO) () -> m ()
88+
asyncRun action = do
89+
env <- ask
90+
let ll = confLogLevel (ideConfiguration env)
91+
void (liftIO (async (runLogger ll (runReaderT action env))))
92+
93+
rebuildFileSync
94+
:: forall m. (Ide m, MonadLogger m, MonadError PscIdeError m)
95+
=> FilePath -> m Success
96+
rebuildFileSync fp = rebuildFile fp syncRun
97+
where
98+
syncRun :: ReaderT IdeEnvironment (LoggingT IO) () -> m ()
99+
syncRun action = do
100+
env <- ask
101+
let ll = confLogLevel (ideConfiguration env)
102+
void (liftIO (runLogger ll (runReaderT action env)))
103+
104+
79105
-- | Rebuilds a module but opens up its export list first and stores the result
80106
-- inside the rebuild cache
81107
rebuildModuleOpen

‎src/Language/PureScript/Ide/Reexports.hs‎

Lines changed: 8 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -24,6 +24,7 @@ module Language.PureScript.Ide.Reexports
2424

2525
import Protolude
2626

27+
import Control.Lens hiding ((&))
2728
import qualified Data.Map as Map
2829
import qualified Language.PureScript as P
2930
import Language.PureScript.Ide.Types
@@ -89,7 +90,7 @@ resolveRef
8990
-> Either P.DeclarationRef [IdeDeclarationAnn]
9091
resolveRef decls ref = case ref of
9192
P.TypeRef tn mdtors ->
92-
case findRef (lensSatisfies (_IdeDeclType . ideTypeName) (== tn)) of
93+
case findRef (anyOf (_IdeDeclType . ideTypeName) (== tn)) of
9394
Nothing -> Left ref
9495
Just d -> Right $ d : case mdtors of
9596
Nothing ->
@@ -99,23 +100,23 @@ resolveRef decls ref = case ref of
99100
findDtors tn
100101
Just dtors -> mapMaybe lookupDtor dtors
101102
P.ValueRef i ->
102-
findWrapped (lensSatisfies (_IdeDeclValue . ideValueIdent) (== i))
103+
findWrapped (anyOf (_IdeDeclValue . ideValueIdent) (== i))
103104
P.ValueOpRef name ->
104-
findWrapped (lensSatisfies (_IdeDeclValueOperator . ideValueOpName) (== name))
105+
findWrapped (anyOf (_IdeDeclValueOperator . ideValueOpName) (== name))
105106
P.TypeOpRef name ->
106-
findWrapped (lensSatisfies (_IdeDeclTypeOperator . ideTypeOpName) (== name))
107+
findWrapped (anyOf (_IdeDeclTypeOperator . ideTypeOpName) (== name))
107108
P.TypeClassRef name ->
108-
findWrapped (lensSatisfies (_IdeDeclTypeClass . ideTCName) (== name))
109+
findWrapped (anyOf (_IdeDeclTypeClass . ideTCName) (== name))
109110
_ ->
110111
Left ref
111112
where
112113
findWrapped = maybe (Left ref) (Right . pure) . findRef
113114
findRef f = find (f . discardAnn) decls
114115

115116
lookupDtor name =
116-
findRef (lensSatisfies (_IdeDeclDataConstructor . ideDtorName) (== name))
117+
findRef (anyOf (_IdeDeclDataConstructor . ideDtorName) (== name))
117118

118-
findDtors tn = filter (lensSatisfies
119+
findDtors tn = filter (anyOf
119120
(idaDeclaration
120121
. _IdeDeclDataConstructor
121122
. ideDtorTypeName) (== tn)) decls

‎src/Language/PureScript/Ide/State.hs‎

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -250,7 +250,7 @@ resolveInstances externs declarations =
250250
go (ideInstance, classModule, className) acc' =
251251
let
252252
matchTC =
253-
lensSatisfies (idaDeclaration . _IdeDeclTypeClass . ideTCName) (== className)
253+
anyOf (idaDeclaration . _IdeDeclTypeClass . ideTCName) (== className)
254254
updateDeclaration =
255255
mapIf matchTC (idaDeclaration
256256
. _IdeDeclTypeClass
@@ -283,22 +283,22 @@ resolveOperatorsForModule modules = map (idaDeclaration %~ resolveOperator)
283283
| (P.Qualified (Just mn) (Left ident)) <- op ^. ideValueOpAlias =
284284
let t = getDeclarations mn
285285
& mapMaybe (preview _IdeDeclValue)
286-
& filter (lensSatisfies ideValueIdent (== ident))
286+
& filter (anyOf ideValueIdent (== ident))
287287
& map (view ideValueType)
288288
& listToMaybe
289289
in IdeDeclValueOperator (op & ideValueOpType .~ t)
290290
| (P.Qualified (Just mn) (Right dtor)) <- op ^. ideValueOpAlias =
291291
let t = getDeclarations mn
292292
& mapMaybe (preview _IdeDeclDataConstructor)
293-
& filter (lensSatisfies ideDtorName (== dtor))
293+
& filter (anyOf ideDtorName (== dtor))
294294
& map (view ideDtorType)
295295
& listToMaybe
296296
in IdeDeclValueOperator (op & ideValueOpType .~ t)
297297
resolveOperator (IdeDeclTypeOperator op)
298298
| P.Qualified (Just mn) properName <- op ^. ideTypeOpAlias =
299299
let k = getDeclarations mn
300300
& mapMaybe (preview _IdeDeclType)
301-
& filter (lensSatisfies ideTypeName (== properName))
301+
& filter (anyOf ideTypeName (== properName))
302302
& map (view ideTypeKind)
303303
& listToMaybe
304304
in IdeDeclTypeOperator (op & ideTypeOpKind .~ k)

‎src/Language/PureScript/Ide/Types.hs‎

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -32,7 +32,7 @@ type ModuleMap a = Map P.ModuleName a
3232
data IdeDeclaration
3333
= IdeDeclValue IdeValue
3434
| IdeDeclType IdeType
35-
| IdeDeclTypeSynonym IdeSynonym
35+
| IdeDeclTypeSynonym IdeTypeSynonym
3636
| IdeDeclDataConstructor IdeDataConstructor
3737
| IdeDeclTypeClass IdeTypeClass
3838
| IdeDeclValueOperator IdeValueOperator
@@ -50,7 +50,7 @@ data IdeType = IdeType
5050
, _ideTypeKind :: P.Kind
5151
} deriving (Show, Eq, Ord)
5252

53-
data IdeSynonym = IdeSynonym
53+
data IdeTypeSynonym = IdeTypeSynonym
5454
{ _ideSynonymName :: P.ProperName 'P.TypeName
5555
, _ideSynonymType :: P.Type
5656
} deriving (Show, Eq, Ord)
@@ -92,7 +92,7 @@ data IdeTypeOperator = IdeTypeOperator
9292
makePrisms ''IdeDeclaration
9393
makeLenses ''IdeValue
9494
makeLenses ''IdeType
95-
makeLenses ''IdeSynonym
95+
makeLenses ''IdeTypeSynonym
9696
makeLenses ''IdeDataConstructor
9797
makeLenses ''IdeTypeClass
9898
makeLenses ''IdeInstance

‎src/Language/PureScript/Ide/Util.hs‎

Lines changed: 1 addition & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -27,14 +27,13 @@ module Language.PureScript.Ide.Util
2727
, prettyTypeT
2828
, properNameT
2929
, identT
30-
, lensSatisfies
3130
, module Language.PureScript.Ide.Logging
3231
) where
3332

3433
import Protolude hiding (decodeUtf8,
3534
encodeUtf8)
3635

37-
import Control.Lens ((^.), (^?), Iso', iso, Getting, (<&>))
36+
import Control.Lens hiding ((&), op)
3837
import Data.Aeson
3938
import qualified Data.Text as T
4039
import qualified Data.Text.Lazy as TL
@@ -131,6 +130,3 @@ prettyTypeT =
131130
. T.lines
132131
. T.pack
133132
. P.prettyPrintTypeWithUnicode
134-
135-
lensSatisfies :: forall a s. Getting (First a) s a -> (a -> Bool) -> s -> Bool
136-
lensSatisfies getter predicate value = value ^? getter <&> predicate & fromMaybe False

0 commit comments

Comments
 (0)