7174a75 · rowtype-yoga/purescript-native

LICENSE+270−10

@@ -46,6 +46,7 @@ PureScript uses the following Haskell library packages. Their license files foll

4646 bytestring-builder

4747 case-insensitive

4848 cereal

49+ clock

4950 conduit

5051 conduit-extra

5152 connection

@@ -56,8 +57,10 @@ PureScript uses the following Haskell library packages. Their license files foll

5657 deepseq

5758 directory

5859 dlist

60+ easy-file

5961 edit-distance

6062 exceptions

63+ fail

6164 fast-logger

6265 filepath

6366 fsnotify

@@ -82,6 +85,7 @@ PureScript uses the following Haskell library packages. Their license files foll

8285 network

8386 network-uri

8487 old-locale

88+ old-time

8589 optparse-applicative

8690 parallel

8791 parsec

@@ -91,6 +95,7 @@ PureScript uses the following Haskell library packages. Their license files foll

9195 pipes-http

9296 primitive

9397 process

98+ protolude

9499 random

95100 regex-base

96101 regex-tdfa

@@ -105,6 +110,7 @@ PureScript uses the following Haskell library packages. Their license files foll

105110 stm

106111 stm-chans

107112 streaming-commons

113+ string-conv

108114 syb

109115 tagged

110116 template-haskell

@@ -117,6 +123,7 @@ PureScript uses the following Haskell library packages. Their license files foll

117123 transformers-compat

118124 unix

119125 unix-compat

126+ unix-time

120127 unordered-containers

121128 utf8-string

122129 vector

@@ -955,6 +962,41 @@ cereal LICENSE file:

955962 ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE

956963 POSSIBILITY OF SUCH DAMAGE.

957964

965+clock LICENSE file:

966+

969+

971+

972+ Redistribution and use in source and binary forms, with or without

973+ modification, are permitted provided that the following conditions are

974+ met:

975+

976+ * Redistributions of source code must retain the above copyright

977+ notice, this list of conditions and the following disclaimer.

978+

979+ * Redistributions in binary form must reproduce the above

980+ copyright notice, this list of conditions and the following

981+ disclaimer in the documentation and/or other materials provided

982+ with the distribution.

983+

984+ * The names of contributors may not be used to endorse or promote

985+ products derived from this software without specific prior

986+ written permission.

987+

988+ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS

989+ "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT

990+ LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR

991+ A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT

992+ OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,

993+ SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT

994+ LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,

995+ DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY

996+ THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT

997+ (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE

998+ OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

999+

9581000conduit LICENSE file:

9591001

@@ -1142,16 +1184,16 @@ data-default-class LICENSE file:

11421184 may be used to endorse or promote products derived from this software

11431185 without specific prior written permission.

11441186

1145− THIS SOFTWARE IS PROVIDED BY LUKAS MAI AND CONTRIBUTORS "AS IS" AND ANY

1146− EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED

1187+ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND

1188+ ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED

11471189 WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE

1148− DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR ANY

1149− DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES

1150− (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;

1151− LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON

1152− ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT

1153− (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS

1154− SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

1190+ DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE

1191+ FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL

1192+ DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR

1193+ SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER

1194+ CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,

1195+ OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE

1196+ OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

11551197

11561198deepseq LICENSE file:

11571199

@@ -1295,6 +1337,38 @@ dlist LICENSE file:

12951337 (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE

12961338 OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

12971339

1340+easy-file LICENSE file:

1341+

1344+

1345+ Redistribution and use in source and binary forms, with or without

1346+ modification, are permitted provided that the following conditions

1347+ are met:

1348+

1349+ * Redistributions of source code must retain the above copyright

1350+ notice, this list of conditions and the following disclaimer.

1351+ * Redistributions in binary form must reproduce the above copyright

1352+ notice, this list of conditions and the following disclaimer in

1353+ the documentation and/or other materials provided with the

1354+ distribution.

1355+ * Neither the name of the copyright holders nor the names of its

1356+ contributors may be used to endorse or promote products derived

1357+ from this software without specific prior written permission.

1358+

1359+ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS

1360+ "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT

1361+ LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS

1362+ FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE

1363+ COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,

1364+ INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,

1365+ BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;

1366+ LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER

1367+ CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT

1368+ LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN

1369+ ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE

1370+ POSSIBILITY OF SUCH DAMAGE.

1371+

12981372edit-distance LICENSE file:

12991373

@@ -1354,6 +1428,39 @@ exceptions LICENSE file:

13541428 ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE

13551429 POSSIBILITY OF SUCH DAMAGE.

13561430

1431+fail LICENSE file:

1432+

1434+

1436+

1437+ Redistribution and use in source and binary forms, with or without

1438+ modification, are permitted provided that the following conditions are met:

1439+

1440+ * Redistributions of source code must retain the above copyright

1441+ notice, this list of conditions and the following disclaimer.

1442+

1443+ * Redistributions in binary form must reproduce the above

1444+ copyright notice, this list of conditions and the following

1445+ disclaimer in the documentation and/or other materials provided

1446+ with the distribution.

1447+

1448+ * Neither the name of Herbert Valerio Riedel nor the names of other

1449+ contributors may be used to endorse or promote products derived

1450+ from this software without specific prior written permission.

1451+

1452+ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS

1453+ "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT

1454+ LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR

1455+ A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT

1456+ OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,

1457+ SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT

1458+ LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,

1459+ DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY

1460+ THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT

1461+ (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE

1462+ OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

1463+

13571464fast-logger LICENSE file:

13581465

@@ -2122,6 +2229,72 @@ old-locale LICENSE file:

21222229

21232230 -----------------------------------------------------------------------------

21242231

2232+old-time LICENSE file:

2233+

2234+ This library (libraries/base) is derived from code from two

2235+ sources:

2236+

2237+ * Code from the GHC project which is largely (c) The University of

2238+ Glasgow, and distributable under a BSD-style license (see below),

2239+

2240+ * Code from the Haskell 98 Report which is (c) Simon Peyton Jones

2241+ and freely redistributable (but see the full license for

2242+ restrictions).

2243+

2244+ The full text of these licenses is reproduced below. Both of the

2245+ licenses are BSD-style or compatible.

2246+

2247+ -----------------------------------------------------------------------------

2248+

2249+ The Glasgow Haskell Compiler License

2250+

2253+

2254+ Redistribution and use in source and binary forms, with or without

2255+ modification, are permitted provided that the following conditions are met:

2256+

2257+ - Redistributions of source code must retain the above copyright notice,

2258+ this list of conditions and the following disclaimer.

2259+

2260+ - Redistributions in binary form must reproduce the above copyright notice,

2261+ this list of conditions and the following disclaimer in the documentation

2262+ and/or other materials provided with the distribution.

2263+

2264+ - Neither name of the University nor the names of its contributors may be

2265+ used to endorse or promote products derived from this software without

2266+ specific prior written permission.

2267+

2268+ THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF

2269+ GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,

2270+ INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND

2271+ FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE

2272+ UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE

2273+ FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL

2274+ DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR

2275+ SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER

2276+ CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT

2277+ LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY

2278+ OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH

2279+ DAMAGE.

2280+

2281+ -----------------------------------------------------------------------------

2282+

2283+ Code derived from the document "Report on the Programming Language

2284+ Haskell 98", is distributed under the following license:

2285+

2287+

2288+ The authors intend this Report to belong to the entire Haskell

2289+ community, and so we grant permission to copy and distribute it for

2290+ any purpose, provided that it is reproduced in its entirety,

2291+ including this Notice. Modified versions of this Report may also be

2292+ copied and distributed for any purpose, provided that the modified

2293+ version is clearly presented as such, and that it does not claim to

2294+ be a definition of the Haskell 98 Language.

2295+

2296+ -----------------------------------------------------------------------------

2297+

21252298optparse-applicative LICENSE file:

21262299

@@ -2276,7 +2449,7 @@ pem LICENSE file:

22762449

22772450pipes LICENSE file:

22782451

22812454

22822455 Redistribution and use in source and binary forms, with or without modification,

@@ -2427,6 +2600,28 @@ process LICENSE file:

24272600

24282601 -----------------------------------------------------------------------------

24292602

2603+protolude LICENSE file:

2604+

2606+

2607+ Permission is hereby granted, free of charge, to any person obtaining a copy

2608+ of this software and associated documentation files (the "Software"), to

2609+ deal in the Software without restriction, including without limitation the

2610+ rights to use, copy, modify, merge, publish, distribute, sublicense, and/or

2611+ sell copies of the Software, and to permit persons to whom the Software is

2612+ furnished to do so, subject to the following conditions:

2613+

2614+ The above copyright notice and this permission notice shall be included in

2615+ all copies or substantial portions of the Software.

2616+

2617+ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR

2618+ IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,

2619+ FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE

2620+ AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER

2621+ LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING

2622+ FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS

2623+ IN THE SOFTWARE.

2624+

24302625random LICENSE file:

24312626

24322627 This library (libraries/base) is derived from code from two

@@ -2873,6 +3068,39 @@ streaming-commons LICENSE file:

28733068 OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE

28743069 SOFTWARE.

28753070

3071+string-conv LICENSE file:

3072+

3074+

3076+

3077+ Redistribution and use in source and binary forms, with or without

3078+ modification, are permitted provided that the following conditions are met:

3079+

3080+ * Redistributions of source code must retain the above copyright

3081+ notice, this list of conditions and the following disclaimer.

3082+

3083+ * Redistributions in binary form must reproduce the above

3084+ copyright notice, this list of conditions and the following

3085+ disclaimer in the documentation and/or other materials provided

3086+ with the distribution.

3087+

3088+ * Neither the name of Ozgun Ataman nor the names of other

3089+ contributors may be used to endorse or promote products derived

3090+ from this software without specific prior written permission.

3091+

3092+ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS

3093+ "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT

3094+ LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR

3095+ A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT

3096+ OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,

3097+ SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT

3098+ LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,

3099+ DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY

3100+ THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT

3101+ (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE

3102+ OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

3103+

28763104syb LICENSE file:

28773105

28783106 This library (libraries/syb) is derived from code from several

@@ -3289,6 +3517,38 @@ unix-compat LICENSE file:

32893517 (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE

32903518 OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

32913519

3520+unix-time LICENSE file:

3521+

3524+

3525+ Redistribution and use in source and binary forms, with or without

3526+ modification, are permitted provided that the following conditions

3527+ are met:

3528+

3529+ * Redistributions of source code must retain the above copyright

3530+ notice, this list of conditions and the following disclaimer.

3531+ * Redistributions in binary form must reproduce the above copyright

3532+ notice, this list of conditions and the following disclaimer in

3533+ the documentation and/or other materials provided with the

3534+ distribution.

3535+ * Neither the name of the copyright holders nor the names of its

3536+ contributors may be used to endorse or promote products derived

3537+ from this software without specific prior written permission.

3538+

3539+ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS

3540+ "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT

3541+ LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS

3542+ FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE

3543+ COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,

3544+ INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,

3545+ BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;

3546+ LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER

3547+ CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT

3548+ LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN

3549+ ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE

3550+ POSSIBILITY OF SUCH DAMAGE.

3551+

32923552unordered-containers LICENSE file:

32933553

psc-ide-server/Main.hs+29−38

@@ -17,21 +17,14 @@

1717{-# LANGUAGE OverloadedStrings #-}

1818{-# LANGUAGE PackageImports #-}

1919{-# LANGUAGE TemplateHaskell #-}

20+{-# LANGUAGE NoImplicitPrelude #-}

2021

2122module Main where

2223

23−import Prelude ()

24−import Prelude.Compat

24+import Protolude

2525

26−import Control.Concurrent (forkFinally)

2726import Control.Concurrent.STM

28−import Control.Exception (bracketOnError, catchJust)

29−import Control.Monad

30−import Control.Monad.Error.Class

3127import "monad-logger" Control.Monad.Logger

32−import Control.Monad.Reader

33−import Control.Monad.Trans.Except

34−import qualified Data.Text as T

3528import qualified Data.Text.IO as T

3629import Data.Version (showVersion)

3730import Language.PureScript.Ide

@@ -43,19 +36,16 @@ import Network hiding (socketPort, accept)

4336import Network.BSD (getProtocolNumber)

4437import Network.Socket hiding (PortNumber, Type,

4538 sClose)

46−import Options.Applicative

39+import Options.Applicative hiding ((<>))

4740import System.Directory

4841import System.FilePath

49−import System.IO

42+import System.IO hiding (putStrLn, print)

5043import System.IO.Error (isEOFError)

5144

5245import qualified Paths_purescript as Paths

5346

54−-- "Borrowed" from the Idris Compiler

55−-- Copied from upstream impl of listenOn

56−-- bound to localhost interface instead of iNADDR_ANY

57−listenOnLocalhost :: PortID -> IO Socket

58−listenOnLocalhost (PortNumber port) = do

47+listenOnLocalhost :: PortNumber -> IO Socket

48+listenOnLocalhost port = do

5949 proto <- getProtocolNumber "tcp"

6050 localhost <- inet_addr "127.0.0.1"

6151 bracketOnError

@@ -66,59 +56,60 @@ listenOnLocalhost (PortNumber port) = do

6656 bindSocket sock (SockAddrInet port localhost)

6757 listen sock maxListenQueue

6858 pure sock)

69−listenOnLocalhost _ = error "Wrong Porttype"

7059

7160data Options = Options

7261 { optionsDirectory :: Maybe FilePath

62+ , optionsGlobs :: [FilePath]

7363 , optionsOutputPath :: FilePath

74− , optionsPort :: PortID

64+ , optionsPort :: PortNumber

7565 , optionsNoWatch :: Bool

7666 , optionsDebug :: Bool

7767 }

7868

7969main :: IO ()

8070main = do

81− Options dir outputPath port noWatch debug <- execParser opts

71+ Options dir globs outputPath port noWatch debug <- execParser opts

8272 maybe (pure ()) setCurrentDirectory dir

8373 serverState <- newTVarIO emptyPscIdeState

74+ ideState <- newTVarIO emptyIdeState

8475 cwd <- getCurrentDirectory

8576 let fullOutputPath = cwd </> outputPath

8677

87− doesDirectoryExist fullOutputPath

88− >>= flip unless

89− (do putStrLn ("Your output directory didn't exist. I'll create it at: " <> fullOutputPath)

90− createDirectory fullOutputPath

91− putStrLn "This usually means you didn't compile your project yet."

92− putStrLn "psc-ide needs you to compile your project (for example by running pulp build)")

78+ unlessM (doesDirectoryExist fullOutputPath) $ do

79+ putStrLn ("Your output directory didn't exist. I'll create it at: " <> fullOutputPath)

80+ createDirectory fullOutputPath

81+ putText "This usually means you didn't compile your project yet."

82+ putText "psc-ide needs you to compile your project (for example by running pulp build)"

9383

9484 unless noWatch $

95− void (forkFinally (watcher serverState fullOutputPath) print)

85+ void (forkFinally (watcher ideState fullOutputPath) print)

9686

97− let conf = Configuration {confDebug = debug, confOutputPath = outputPath}

98− env = PscIdeEnvironment {envStateVar = serverState, envConfiguration = conf}

87+ let conf = Configuration {confDebug = debug, confOutputPath = outputPath, confGlobs = globs}

88+ env = IdeEnvironment {envStateVar = serverState, ideStateVar = ideState, ideConfiguration = conf}

9989 startServer port env

10090 where

10191 parser =

10292 Options

103− <$> optional (strOption (long "directory" <> short 'd'))

104− <*> strOption (long "output-directory" <> value "output/")

105− <*> (PortNumber . fromIntegral <$>

106− option auto (long "port" <> short 'p' <> value (4242 :: Integer)))

93+ <$> optional (strOption (long "directory" `mappend` short 'd'))

94+ <*> many (argument str (metavar "Source GLOBS..."))

95+ <*> strOption (long "output-directory" `mappend` value "output/")

96+ <*> (fromIntegral <$>

97+ option auto (long "port" `mappend` short 'p' `mappend` value (4242 :: Integer)))

10798 <*> switch (long "no-watch")

10899 <*> switch (long "debug")

109100 opts = info (version <*> helper <*> parser) mempty

110101 version = abortOption

111102 (InfoMsg (showVersion Paths.version))

112− (long "version" <> help "Show the version number")

103+ (long "version" `mappend` help "Show the version number")

113104

114−startServer :: PortID -> PscIdeEnvironment -> IO ()

105+startServer :: PortNumber -> IdeEnvironment -> IO ()

115106startServer port env = withSocketsDo $ do

116107 sock <- listenOnLocalhost port

117108 runLogger (runReaderT (forever (loop sock)) env)

118109 where

119− runLogger = runStdoutLoggingT . filterLogger (\_ _ -> confDebug (envConfiguration env))

110+ runLogger = runStdoutLoggingT . filterLogger (\_ _ -> confDebug (ideConfiguration env))

120111

121− loop :: (PscIde m, MonadLogger m) => Socket -> m ()

112+ loop :: (Ide m, MonadLogger m) => Socket -> m ()

122113 loop sock = do

123114 accepted <- runExceptT $ acceptCommand sock

124115 case accepted of

@@ -141,8 +132,8 @@ startServer port env = withSocketsDo $ do

141132 liftIO (hClose h)

142133

143134

144−acceptCommand :: (MonadIO m, MonadLogger m, MonadError T.Text m)

145− => Socket -> m (T.Text, Handle)

135+acceptCommand :: (MonadIO m, MonadLogger m, MonadError Text m)

136+ => Socket -> m (Text, Handle)

146137acceptCommand sock = do

147138 h <- acceptConnection

148139 $(logDebug) "Accepted a connection"

psc-ide-server/PROTOCOL.md+3−7

@@ -14,24 +14,20 @@ to detect all the compiled modules in your project and load them.

1414

1515**Params:**

1616 - `modules :: (optional) [ModuleName]`: A list of modules to load.

17− psc-ide-server will try to parse all the declarations in these modules

18− - `dependencies :: (optional) [ModuleName]`: A list of modules to load

19− including their dependencies. In contrast to the `module` field, all the

20− imports in these Modules will also be loaded.

17+ psc-ide-server will try to parse all the declarations in these modules

2118

2219```json

2320{

2421 "command": "load",

2522 "params": (optional) {

26− "modules": (optional)["Module.Name1", "Module.Name2"],

27− "dependencies": (optional)["Module.Name3"]

23+ "modules": (optional)["Module.Name1", "Module.Name2"]

2824 }

2925}

3026```

3127

3228**Result:**

3329

34−The Load Command returns a string.

30+The Load Command returns a string with a summary about the loading process.

3531

3632### Type

3733The `type` command looks up the type for a given identifier.

psc-ide-server/README.md+4−1

@@ -10,7 +10,10 @@ A tool which provides editor support for the PureScript programming language.

1010* Vim integration is available here: https://github.com/FrigoEU/psc-ide-vim.

1111

1212## Running the Server

13−Start the server by running the `psc-ide-server` executable.

13+

14+Start the server by running the `psc-ide-server [SOURCEGLOBS]` executable, where

15+`SOURCEGLOBS` are (optional) globs that match your PureScript sourcefiles.

16+

1417It supports the following options:

1518

1619- `-p / --port` specify a port. Defaults to 4242

purescript.cabal+15−11

@@ -106,6 +106,7 @@ library

106106 boxes >= 0.1.4 && < 0.2.0,

107107 bytestring -any,

108108 containers -any,

109+ clock -any,

109110 directory >= 1.2,

110111 dlist -any,

111112 edit-distance -any,

@@ -125,6 +126,7 @@ library

125126 pipes >= 4.0.0 && < 4.3.0,

126127 pipes-http -any,

127128 process >= 1.2.0 && < 1.5,

129+ protolude >= 0.1.5,

128130 regex-tdfa -any,

129131 safe >= 0.3.9 && < 0.4,

130132 semigroups >= 0.16.2 && < 0.19,

@@ -251,22 +253,23 @@ library

251253 Language.PureScript.Publish.BoxesHelpers

252254

253255 Language.PureScript.Ide

256+ Language.PureScript.Ide.CaseSplit

254257 Language.PureScript.Ide.Command

258+ Language.PureScript.Ide.Completion

259+ Language.PureScript.Ide.Conversions

255260 Language.PureScript.Ide.Externs

256261 Language.PureScript.Ide.Error

257− Language.PureScript.Ide.Pursuit

258− Language.PureScript.Ide.Completion

259− Language.PureScript.Ide.Matcher

262+ Language.PureScript.Ide.Imports

260263 Language.PureScript.Ide.Filter

261− Language.PureScript.Ide.Types

262− Language.PureScript.Ide.State

263− Language.PureScript.Ide.CaseSplit

264− Language.PureScript.Ide.SourceFile

265− Language.PureScript.Ide.Watcher

264+ Language.PureScript.Ide.Matcher

265+ Language.PureScript.Ide.Pursuit

266+ Language.PureScript.Ide.Rebuild

266267 Language.PureScript.Ide.Reexports

267− Language.PureScript.Ide.Imports

268+ Language.PureScript.Ide.SourceFile

269+ Language.PureScript.Ide.State

270+ Language.PureScript.Ide.Types

268271 Language.PureScript.Ide.Util

269− Language.PureScript.Ide.Rebuild

272+ Language.PureScript.Ide.Watcher

270273

271274 Language.PureScript.Interactive

272275 Language.PureScript.Interactive.Types

@@ -433,6 +436,7 @@ executable psc-ide-server

433436 mtl -any,

434437 network -any,

435438 optparse-applicative >= 0.12.1,

439+ protolude >= 0.1.5,

436440 stm -any,

437441 text -any,

438442 transformers -any,

@@ -473,6 +477,7 @@ test-suite tests

473477 optparse-applicative -any,

474478 parsec -any,

475479 process -any,

480+ protolude >= 0.1.5,

476481 silently -any,

477482 stm -any,

478483 text -any,

@@ -498,6 +503,5 @@ test-suite tests

498503 Language.PureScript.Ide.MatcherSpec

499504 Language.PureScript.Ide.RebuildSpec

500505 Language.PureScript.Ide.ReexportsSpec

501− Language.PureScript.IdeSpec

502506 buildable: True

503507 hs-source-dirs: tests

src/Language/PureScript/Ide.hs+138−177

@@ -18,24 +18,11 @@

1818

1919module Language.PureScript.Ide

2020 ( handleCommand

21− -- for tests

22− , printModules

2321 ) where

2422

25−import Prelude ()

26−import Prelude.Compat

23+import Protolude

2724

28−import Control.Monad (unless)

29−import Control.Monad.Error.Class

30−import Control.Monad.IO.Class

3125import "monad-logger" Control.Monad.Logger

32−import Control.Monad.Reader.Class

33−import Data.Foldable

34−import qualified Data.Map.Lazy as M

35−import Data.Maybe (catMaybes, mapMaybe)

36−import Data.Monoid

37−import Data.Text (Text)

38−import qualified Data.Text as T

3926import qualified Language.PureScript as P

4027import qualified Language.PureScript.Ide.CaseSplit as CS

4128import Language.PureScript.Ide.Command

@@ -47,199 +34,173 @@ import Language.PureScript.Ide.Imports hiding (Import)

4734import Language.PureScript.Ide.Matcher

4835import Language.PureScript.Ide.Pursuit

4936import Language.PureScript.Ide.Rebuild

50−import Language.PureScript.Ide.Reexports

5137import Language.PureScript.Ide.SourceFile

5238import Language.PureScript.Ide.State

5339import Language.PureScript.Ide.Types

5440import Language.PureScript.Ide.Util

5541import System.Directory

56−import System.Exit

5742import System.FilePath

43+import System.FilePath.Glob

5844

59−handleCommand :: (PscIde m, MonadLogger m, MonadError PscIdeError m) =>

45+handleCommand :: (Ide m, MonadLogger m, MonadError PscIdeError m) =>

6046 Command -> m Success

61−handleCommand (Load [] []) = loadAllModules

62−handleCommand (Load modules deps) =

63− loadModulesAndDeps modules deps

64−handleCommand (Type search filters currentModule) =

65− findType search filters currentModule

66−handleCommand (Complete filters matcher currentModule) =

67− findCompletions filters matcher currentModule

68−handleCommand (Pursuit query Package) =

69− findPursuitPackages query

70−handleCommand (Pursuit query Identifier) =

71− findPursuitCompletions query

72−handleCommand (List LoadedModules) =

73− printModules

74−handleCommand (List AvailableModules) =

75− listAvailableModules

76−handleCommand (List (Imports fp)) =

77− importsForFile fp

78−handleCommand (CaseSplit l b e wca t) =

79− caseSplit l b e wca t

80−handleCommand (AddClause l wca) =

81− pure $ addClause l wca

82−handleCommand (Import fp outfp _ (AddImplicitImport mn)) = do

83− rs <- addImplicitImport fp mn

84− answerRequest outfp rs

85−handleCommand (Import fp outfp filters (AddImportForIdentifier ident)) = do

86− rs <- addImportForIdentifier fp ident filters

87− case rs of

88− Right rs' -> answerRequest outfp rs'

89− Left question -> pure $ CompletionResult (mapMaybe completionFromMatch question)

90−handleCommand (Rebuild file) =

91− rebuildFile file

92−handleCommand Cwd =

93− TextResult . T.pack <$> liftIO getCurrentDirectory

94−handleCommand Reset = resetPscIdeState *> pure (TextResult "State has been reset.")

95−handleCommand Quit = liftIO exitSuccess

96−

97−findCompletions :: (PscIde m) =>

47+handleCommand c = case c of

48+ Load [] ->

49+ findAvailableExterns >>= loadModules

50+ Load modules ->

51+ loadModules modules

52+ Type search filters currentModule ->

53+ findType search filters currentModule

54+ Complete filters matcher currentModule ->

55+ findCompletions filters matcher currentModule

56+ Pursuit query Package ->

57+ findPursuitPackages query

58+ Pursuit query Identifier ->

59+ findPursuitCompletions query

60+ List LoadedModules ->

61+ printModules

62+ List AvailableModules ->

63+ listAvailableModules

64+ List (Imports fp) ->

65+ ImportList <$> getImportsForFile fp

66+ CaseSplit l b e wca t ->

67+ caseSplit l b e wca t

68+ AddClause l wca ->

69+ addClause l wca

70+ Import fp outfp _ (AddImplicitImport mn) -> do

71+ rs <- addImplicitImport fp mn

72+ answerRequest outfp rs

73+ Import fp outfp filters (AddImportForIdentifier ident) -> do

74+ rs <- addImportForIdentifier fp ident filters

75+ case rs of

76+ Right rs' -> answerRequest outfp rs'

77+ Left question ->

78+ pure (CompletionResult (map completionFromMatch question))

79+ Rebuild file ->

80+ rebuildFile file

81+ Cwd ->

82+ TextResult . toS <$> liftIO getCurrentDirectory

83+ Reset ->

84+ resetIdeState $> TextResult "State has been reset."

85+ Quit ->

86+ liftIO exitSuccess

87+

88+findCompletions :: Ide m =>

9889 [Filter] -> Matcher -> Maybe P.ModuleName -> m Success

9990findCompletions filters matcher currentModule = do

100− modules <- getAllModulesWithReexportsAndCache currentModule

101− pure . CompletionResult . mapMaybe completionFromMatch . getCompletions filters matcher $ modules

91+ modules <- getAllModules2 currentModule

92+ pure . CompletionResult . map completionFromMatch . getCompletions filters matcher $ modules

10293

103−findType :: (PscIde m) =>

104− DeclIdent -> [Filter] -> Maybe P.ModuleName -> m Success

94+findType :: Ide m =>

95+ Text -> [Filter] -> Maybe P.ModuleName -> m Success

10596findType search filters currentModule = do

106− modules <- getAllModulesWithReexportsAndCache currentModule

107− pure . CompletionResult . mapMaybe completionFromMatch . getExactMatches search filters $ modules

97+ modules <- getAllModules2 currentModule

98+ pure . CompletionResult . map completionFromMatch . getExactMatches search filters $ modules

10899

109−findPursuitCompletions :: (MonadIO m) =>

100+findPursuitCompletions :: MonadIO m =>

110101 PursuitQuery -> m Success

111102findPursuitCompletions (PursuitQuery q) =

112103 PursuitResult <$> liftIO (searchPursuitForDeclarations q)

113104

114−findPursuitPackages :: (MonadIO m) =>

105+findPursuitPackages :: MonadIO m =>

115106 PursuitQuery -> m Success

116107findPursuitPackages (PursuitQuery q) =

117108 PursuitResult <$> liftIO (findPackagesForModuleIdent q)

118109

119−loadExtern :: (PscIde m, MonadLogger m, MonadError PscIdeError m) =>

120− FilePath -> m ()

121−loadExtern fp = do

122− m <- readExternFile fp

123− insertModule m

110+printModules :: Ide m => m Success

111+printModules = ModuleList . map runModuleNameT <$> getLoadedModulenames

124112

125−printModules :: (PscIde m) => m Success

126−printModules = printModules' . pscIdeStateModules <$> getPscIdeState

127−

128−printModules' :: M.Map ModuleIdent [ExternDecl] -> Success

129−printModules' = ModuleList . M.keys

113+outputDirectory :: Ide m => m FilePath

114+outputDirectory = do

115+ outputPath <- confOutputPath . ideConfiguration <$> ask

116+ cwd <- liftIO getCurrentDirectory

117+ pure (cwd </> outputPath)

130118

131−listAvailableModules :: PscIde m => m Success

119+listAvailableModules :: Ide m => m Success

132120listAvailableModules = do

133− outputPath <- confOutputPath . envConfiguration <$> ask

121+ oDir <- outputDirectory

134122 liftIO $ do

135− cwd <- getCurrentDirectory

136− dirs <- getDirectoryContents (cwd </> outputPath)

137− return (ModuleList (listAvailableModules' dirs))

138−

139−listAvailableModules' :: [FilePath] -> [Text]

140−listAvailableModules' dirs =

141− let cleanedModules = filter (`notElem` [".", ".."]) dirs

142− in map T.pack cleanedModules

123+ contents <- getDirectoryContents oDir

124+ let cleaned = filter (`notElem` [".", ".."]) contents

125+ return (ModuleList (map toS cleaned))

143126

144−caseSplit :: (PscIde m, MonadError PscIdeError m) =>

127+caseSplit :: (Ide m, MonadError PscIdeError m) =>

145128 Text -> Int -> Int -> CS.WildcardAnnotations -> Text -> m Success

146129caseSplit l b e csa t = do

147130 patterns <- CS.makePattern l b e csa <$> CS.caseSplit t

148131 pure (MultilineTextResult patterns)

149132

150−addClause :: Text -> CS.WildcardAnnotations -> Success

151−addClause t wca = MultilineTextResult (CS.addClause t wca)

152−

153−importsForFile :: (MonadIO m, MonadError PscIdeError m) =>

154− FilePath -> m Success

155−importsForFile fp = do

156− imports <- getImportsForFile fp

157− pure (ImportList imports)

158−

159−-- | The first argument is a set of modules to load. The second argument

160−-- denotes modules for which to load dependencies

161−loadModulesAndDeps :: (PscIde m, MonadLogger m, MonadError PscIdeError m) =>

162− [ModuleIdent] -> [ModuleIdent] -> m Success

163−loadModulesAndDeps mods deps = do

164− r1 <- mapM loadModule (mods ++ deps)

165− r2 <- mapM loadModuleDependencies deps

166− let moduleResults = T.concat r1

167− let dependencyResults = T.concat r2

168− pure (TextResult (moduleResults <> ", " <> dependencyResults))

169−

170−loadModuleDependencies ::(PscIde m, MonadLogger m, MonadError PscIdeError m) =>

171− ModuleIdent -> m Text

172−loadModuleDependencies moduleName = do

173− m <- getModule moduleName

174− case getDependenciesForModule <$> m of

175− Just deps -> do

176− mapM_ loadModule deps

177− -- We need to load the modules, that get reexported from the dependencies

178− depModules <- catMaybes <$> mapM getModule deps

179− -- What to do with errors here? This basically means a reexported dependency

180− -- doesn't exist in the output/ folder

181− traverse_ loadReexports depModules

182− pure ("Dependencies for " <> moduleName <> " loaded.")

183− Nothing -> throwError (ModuleNotFound moduleName)

184−

185−loadReexports :: (PscIde m, MonadLogger m, MonadError PscIdeError m) =>

186− Module -> m [ModuleIdent]

187−loadReexports m = case getReexports m of

188− [] -> pure []

189− exportDeps -> do

190− -- I'm fine with this crashing on a failed pattern match.

191− -- If this ever fails I'll need to look at GADTs

192− let reexports = map (\(Export mn) -> mn) exportDeps

193− $(logDebug) ("Loading reexports for module: " <> fst m <>

194− " reexports: " <> T.intercalate ", " reexports)

195− traverse_ loadModule reexports

196− exportDepsModules <- catMaybes <$> traverse getModule reexports

197− exportDepDeps <- traverse loadReexports exportDepsModules

198− return $ concat exportDepDeps

199−

200−getDependenciesForModule :: Module -> [ModuleIdent]

201−getDependenciesForModule (_, decls) = mapMaybe getDependencyName decls

202− where getDependencyName (Dependency dependencyName _ _) = Just dependencyName

203− getDependencyName _ = Nothing

204−

205−loadModule :: (PscIde m, MonadLogger m, MonadError PscIdeError m) =>

206− ModuleIdent -> m Text

207−loadModule "Prim" = pure "Prim won't be loaded"

208−loadModule mn = do

209− path <- filePathFromModule mn

210− loadExtern path

211− $(logDebug) ("Loaded extern file at: " <> T.pack path)

212− pure ("Loaded extern file at: " <> T.pack path)

213−

214−loadAllModules :: (PscIde m, MonadLogger m, MonadError PscIdeError m) => m Success

215−loadAllModules = do

216− outputPath <- confOutputPath . envConfiguration <$> ask

217− cwd <- liftIO getCurrentDirectory

218− let outputDirectory = cwd </> outputPath

219− liftIO (doesDirectoryExist outputDirectory)

220− >>= flip unless (throwError (GeneralError "Couldn't locate your output directory"))

221− liftIO (getDirectoryContents outputDirectory)

222− >>= liftIO . traverse (getExternsPath outputDirectory)

223− >>= traverse_ loadExtern . catMaybes

224− pure (TextResult "All modules loaded.")

133+addClause

134+ :: (MonadError PscIdeError m)

135+ => Text

136+ -> CS.WildcardAnnotations

137+ -> m Success

138+addClause t wca = MultilineTextResult <$> CS.addClause t wca

139+

140+-- | Finds all the externs.json files inside the output folder and returns the

141+-- corresponding Modulenames

142+findAvailableExterns :: (Ide m, MonadError PscIdeError m) => m [P.ModuleName]

143+findAvailableExterns = do

144+ oDir <- outputDirectory

145+ unlessM (liftIO (doesDirectoryExist oDir))

146+ (throwError (GeneralError "Couldn't locate your output directory."))

147+ liftIO $ do

148+ directories <- getDirectoryContents oDir

149+ moduleNames <- filterM (checkExternsPath oDir) directories

150+ pure (P.moduleNameFromString <$> moduleNames)

225151 where

226− getExternsPath :: FilePath -> FilePath -> IO (Maybe FilePath)

227− getExternsPath outputDirectory d

228− | d `elem` [".", ".."] = pure Nothing

152+ -- | Takes the output directory and a filepath like "Monad.Control.Eff" and

153+ -- looks up, whether that folder contains an externs.json

154+ checkExternsPath :: FilePath -> FilePath -> IO Bool

155+ checkExternsPath oDir d

156+ | d `elem` [".", ".."] = pure False

229157 | otherwise = do

230− let file = outputDirectory </> d </> "externs.json"

231− ex <- doesFileExist file

232− if ex

233− then pure (Just file)

234− else pure Nothing

235−

236−filePathFromModule :: (PscIde m, MonadError PscIdeError m) =>

237− ModuleIdent -> m FilePath

238−filePathFromModule moduleName = do

239− outputPath <- confOutputPath . envConfiguration <$> ask

240− cwd <- liftIO getCurrentDirectory

241− let path = cwd </> outputPath </> T.unpack moduleName </> "externs.json"

242− ex <- liftIO $ doesFileExist path

243− if ex

244− then pure path

245− else throwError (ModuleFileNotFound moduleName)

158+ let file = oDir </> d </> "externs.json"

159+ doesFileExist file

160+

161+-- | Finds all matches for the globs specified at the commandline

162+findAllSourceFiles :: Ide m => m [FilePath]

163+findAllSourceFiles = do

164+ globs <- confGlobs . ideConfiguration <$> ask

165+ liftIO (concatMapM glob globs)

166+

167+-- | Looks up the ExternsFiles for the given Modulenames and loads them into the

168+-- server state. Then proceeds to parse all the specified sourcefiles and

169+-- inserts their ASTs into the state. Finally kicks off an async worker, which

170+-- populates Stage 2 and 3 of the state.

171+loadModules

172+ :: (Ide m, MonadError PscIdeError m, MonadLogger m)

173+ => [P.ModuleName]

174+ -> m Success

175+loadModules moduleNames = do

176+ -- We resolve all the modulenames to externs files and load these into memory.

177+ oDir <- outputDirectory

178+ let efPaths =

179+ map (\mn -> oDir </> P.runModuleName mn </> "externs.json") moduleNames

180+ efiles <- traverse readExternFile efPaths

181+ traverse_ insertExterns efiles

182+

183+ -- We parse all source files, log eventual parse failures if the debug flag

184+ -- was set and insert the succesful parses into the state.

185+ (failures, allModules) <-

186+ partitionEithers <$> (traverse parseModule =<< findAllSourceFiles)

187+ unless (null failures) $

188+ $(logDebug) ("Failed to parse: " <> show failures)

189+ traverse_ insertModule allModules

190+

191+ -- Because we still need the "old" module format to resolve reexports in the

192+ -- worker thread, we insert it into the state aswell.

193+ -- TODO Get rid of this once ModuleOld is gone

194+ traverse_ insertModuleOld efiles

195+

196+ -- Finally we kick off the worker with @async@ and return the number of

197+ -- successfully parsed modules.

198+ env <- ask

199+ let runLogger =

200+ runStdoutLoggingT

201+ . filterLogger (\_ _ -> confDebug (ideConfiguration env))

202+ -- populateStage2 returns Unit for now, so it's fine to discard this result.

203+ -- We might want to block on this in a benchmarking situation.

204+ _ <- liftIO (async (runLogger (runReaderT populateStage2 env)))

205+ pure (TextResult ("Loaded " <> show (length efiles) <> " modules and "

206+ <> show (length allModules) <> " source files."))

src/Language/PureScript/Ide/CaseSplit.hs+25−28

@@ -23,14 +23,8 @@ module Language.PureScript.Ide.CaseSplit

2323 , caseSplit

2424 ) where

2525

26−import Prelude ()

27−import Prelude.Compat hiding (lex)

28−

29−import Control.Arrow (second)

30−import Control.Monad.Error.Class

31−import Data.List (find)

32−import Data.Monoid

33−import Data.Text (Text)

26+import Protolude hiding (Constructor)

27+

3428import qualified Data.Text as T

3529import qualified Language.PureScript as P

3630

@@ -42,6 +36,7 @@ import Language.PureScript.Ide.Types

4236import Language.PureScript.Ide.Util

4337

4438import Text.Parsec as Parsec

39+import qualified Text.PrettyPrint.Boxes as Box

4540

4641type Constructor = (P.ProperName 'P.ConstructorName, [P.Type])

4742

@@ -53,17 +48,17 @@ explicitAnnotations = WildcardAnnotations True

5348noAnnotations :: WildcardAnnotations

5449noAnnotations = WildcardAnnotations False

5550

56−caseSplit :: (PscIde m, MonadError PscIdeError m) =>

51+caseSplit :: (Ide m, MonadError PscIdeError m) =>

5752 Text -> m [Constructor]

5853caseSplit q = do

59− type' <- parseType' (T.unpack q)

54+ type' <- parseType' q

6055 (tc, args) <- splitTypeConstructor type'

6156 (EDType _ _ (P.DataType typeVars ctors)) <- findTypeDeclaration tc

6257 let applyTypeVars = P.everywhereOnTypes (P.replaceAllTypeVars (zip (map fst typeVars) args))

6358 let appliedCtors = map (second (map applyTypeVars)) ctors

6459 pure appliedCtors

6560

66−findTypeDeclaration :: (PscIde m, MonadError PscIdeError m) =>

61+findTypeDeclaration :: (Ide m, MonadError PscIdeError m) =>

6762 P.ProperName 'P.TypeName -> m ExternsDeclaration

6863findTypeDeclaration q = do

6964 efs <- getExternFiles

@@ -113,39 +108,41 @@ makePattern t x y wsa = makePattern' (T.take x t) (T.drop y t)

113108 where

114109 makePattern' lhs rhs = map (\ctor -> lhs <> prettyCtor wsa ctor <> rhs)

115110

116−addClause :: Text -> WildcardAnnotations -> [Text]

117−addClause s wca =

118− let (fName, fType) = parseTypeDeclaration' (T.unpack s)

119− (args, _) = splitFunctionType fType

111+addClause :: (MonadError PscIdeError m) => Text -> WildcardAnnotations -> m [Text]

112+addClause s wca = do

113+ (fName, fType) <- parseTypeDeclaration' s

114+ let args = splitFunctionType fType

120115 template = runIdentT fName <> " " <>

121116 T.unwords (map (prettyPrintWildcard wca) args) <>

122117 " = ?" <> (T.strip . runIdentT $ fName)

123− in [s, template]

118+ pure [s, template]

124119

125120parseType' :: (MonadError PscIdeError m) =>

126− String -> m P.Type

121+ Text -> m P.Type

127122parseType' s =

128− case P.lex "<psc-ide>" s >>= P.runTokenParser "<psc-ide>" (P.parseType <* Parsec.eof) of

123+ case P.lex "<psc-ide>" (toS s) >>= P.runTokenParser "<psc-ide>" (P.parseType <* Parsec.eof) of

129124 Right type' -> pure type'

130125 Left err ->

131126 throwError (GeneralError ("Parsing the splittype failed with:"

132− ++ show err))

127+ <> show err))

133128

134−parseTypeDeclaration' :: String -> (P.Ident, P.Type)

129+parseTypeDeclaration' :: (MonadError PscIdeError m) => Text -> m (P.Ident, P.Type)

135130parseTypeDeclaration' s =

136131 let x = do

137− ts <- P.lex "" s

132+ ts <- P.lex "" (toS s)

138133 P.runTokenParser "" (P.parseDeclaration <* Parsec.eof) ts

139134 in

140135 case unwrapPositioned <$> x of

141− Right (P.TypeDeclaration i t) -> (i, t)

142− y -> error (show y)

143−

144−splitFunctionType :: P.Type -> ([P.Type], P.Type)

145−splitFunctionType t = (arguments, returns)

136+ Right (P.TypeDeclaration i t) -> pure (i, t)

137+ Right _ -> throwError (GeneralError "Found a non-type-declaration")

138+ Left err ->

139+ throwError (GeneralError ("Parsing the type signature failed with: "

140+ <> toS (Box.render (P.prettyPrintParseError err))))

141+

142+splitFunctionType :: P.Type -> [P.Type]

143+splitFunctionType t = fromMaybe [] arguments

146144 where

147− returns = last splitted

148− arguments = init splitted

145+ arguments = initMay splitted

149146 splitted = splitType' t

150147 splitType' (P.ForAll _ t' _) = splitType' t'

151148 splitType' (P.ConstrainedType _ t') = splitType' t'

src/Language/PureScript/Ide/Command.hs+10−17

@@ -16,25 +16,20 @@

1616

1717module Language.PureScript.Ide.Command where

1818

19−import Prelude ()

20−import Prelude.Compat

19+import Protolude

2120

22−import Control.Monad

2321import Data.Aeson

24−import Data.Text (Text)

2522import qualified Language.PureScript as P

2623import Language.PureScript.Ide.CaseSplit

2724import Language.PureScript.Ide.Filter

2825import Language.PureScript.Ide.Matcher

2926import Language.PureScript.Ide.Types

27+import System.FilePath

3028

3129data Command

32− = Load

33− { loadModules :: [ModuleIdent]

34− , loadDependencies :: [ModuleIdent]

35− }

30+ = Load [P.ModuleName]

3631 | Type

37− { typeSearch :: DeclIdent

32+ { typeSearch :: Text

3833 , typeFilters :: [Filter]

3934 , typeCurrentModule :: Maybe P.ModuleName

4035 }

@@ -68,12 +63,12 @@ data Command

6863

6964data ImportCommand

7065 = AddImplicitImport P.ModuleName

71− | AddImportForIdentifier DeclIdent

66+ | AddImportForIdentifier Text

7267 deriving (Show, Eq)

7368

7469instance FromJSON ImportCommand where

7570 parseJSON = withObject "ImportCommand" $ \o -> do

76− (command :: String) <- o .: "importCommand"

71+ (command :: Text) <- o .: "importCommand"

7772 case command of

7873 "addImplicitImport" ->

7974 AddImplicitImport <$> (P.moduleNameFromString <$> o .: "module")

@@ -85,7 +80,7 @@ data ListType = LoadedModules | Imports FilePath | AvailableModules

8580

8681instance FromJSON ListType where

8782 parseJSON = withObject "ListType" $ \o -> do

88− (listType' :: String) <- o .: "type"

83+ (listType' :: Text) <- o .: "type"

8984 case listType' of

9085 "import" -> Imports <$> o .: "file"

9186 "loadedModules" -> pure LoadedModules

@@ -94,7 +89,7 @@ instance FromJSON ListType where

9489

9590instance FromJSON Command where

9691 parseJSON = withObject "command" $ \o -> do

97− (command :: String) <- o .: "command"

92+ (command :: Text) <- o .: "command"

9893 case command of

9994 "list" -> List <$> o .:? "params" .!= LoadedModules

10095 "cwd" -> pure Cwd

@@ -103,11 +98,9 @@ instance FromJSON Command where

10398 "load" -> do

10499 params' <- o .:? "params"

105100 case params' of

106− Nothing -> pure (Load [] [])

101+ Nothing -> pure (Load [])

107102 Just params ->

108− Load

109− <$> params .:? "modules" .!= []

110− <*> params .:? "dependencies" .!= []

103+ Load <$> (map P.moduleNameFromString <$> params .:? "modules" .!= [])

111104 "type" -> do

112105 params <- o .: "params"

113106 Type

src/Language/PureScript/Ide/Completion.hs+8−13

@@ -1,12 +1,11 @@

11{-# LANGUAGE OverloadedStrings #-}

22module Language.PureScript.Ide.Completion

3− (getCompletions, getExactMatches)

4− where

3+ ( getCompletions

4+ , getExactMatches

5+ ) where

56

6−import Prelude ()

7−import Prelude.Compat

7+import Protolude

88

9−import Data.Maybe (mapMaybe)

109import Language.PureScript.Ide.Filter

1110import Language.PureScript.Ide.Matcher

1211import Language.PureScript.Ide.Types

@@ -15,18 +14,14 @@ import Language.PureScript.Ide.Types

1514-- and sorts the found Completions according to the Matching Score

1615getCompletions :: [Filter] -> Matcher -> [Module] -> [Match]

1716getCompletions filters matcher modules =

18− runMatcher matcher $ completionsFromModules (applyFilters filters modules)

17+ runMatcher matcher (completionsFromModules (applyFilters filters modules))

1918

20−getExactMatches :: DeclIdent -> [Filter] -> [Module] -> [Match]

19+getExactMatches :: Text -> [Filter] -> [Module] -> [Match]

2120getExactMatches search filters modules =

22− completionsFromModules $

23− applyFilters (equalityFilter search : filters) modules

21+ completionsFromModules (applyFilters (equalityFilter search : filters) modules)

2422

2523completionsFromModules :: [Module] -> [Match]

2624completionsFromModules = foldMap completionFromModule

2725 where

2826 completionFromModule :: Module -> [Match]

29− completionFromModule (moduleIdent, decls) = mapMaybe (matchFromDecl moduleIdent) decls

30−

31−matchFromDecl :: ModuleIdent -> ExternDecl -> Maybe Match

32−matchFromDecl mi = Just . Match mi

27+ completionFromModule (moduleName, decls) = map (Match moduleName) decls

src/Language/PureScript/Ide/Conversions.hsnew file+35

@@ -0,0 +1,35 @@

1+-----------------------------------------------------------------------------

2+--

3+-- Module : Language.PureScript.Ide.Conversions

4+-- Description : Conversions to Text for PureScript types

5+-- Copyright : Christoph Hegemann 2016

6+-- License : MIT (http://opensource.org/licenses/MIT)

7+--

8+-- Maintainer : Christoph Hegemann <christoph.hegemann1337@gmail.com>

9+-- Stability : experimental

10+--

11+-- |

12+-- Conversions to Text for PureScript types

13+-----------------------------------------------------------------------------

14+

15+module Language.PureScript.Ide.Conversions where

16+

17+import Protolude

18+import Data.Text (unwords, lines, strip)

19+import qualified Language.PureScript as P

20+

21+runProperNameT :: P.ProperName a -> Text

22+runProperNameT = toS . P.runProperName

23+

24+runIdentT :: P.Ident -> Text

25+runIdentT = toS . P.runIdent

26+

27+runOpNameT :: P.OpName a -> Text

28+runOpNameT = toS . P.runOpName

29+

30+runModuleNameT :: P.ModuleName -> Text

31+runModuleNameT = toS . P.runModuleName

32+

33+prettyTypeT :: P.Type -> Text

34+prettyTypeT = unwords . map strip . lines . toS . P.prettyPrintType

35+

src/Language/PureScript/Ide/Error.hs+9−12

@@ -14,25 +14,22 @@

1414

1515{-# LANGUAGE OverloadedStrings #-}

1616module Language.PureScript.Ide.Error

17− (ErrorMsg, PscIdeError(..), textError)

18− where

17+ ( PscIdeError(..)

18+ , textError

19+ ) where

1920

20−import Prelude.Compat

21+import Protolude

2122import Data.Aeson

22−import Data.Monoid

23−import Data.Text (Text, pack)

2423import Language.PureScript.Errors.JSON

2524import Language.PureScript.Ide.Types (ModuleIdent)

2625import qualified Text.Parsec.Error as P

2726

28−type ErrorMsg = String

29−

3027data PscIdeError

31− = GeneralError ErrorMsg

28+ = GeneralError Text

3229 | NotFound Text

3330 | ModuleNotFound ModuleIdent

3431 | ModuleFileNotFound ModuleIdent

35− | ParseError P.ParseError ErrorMsg

32+ | ParseError P.ParseError Text

3633 | RebuildError [JSONError]

3734

3835instance ToJSON PscIdeError where

@@ -46,7 +43,7 @@ instance ToJSON PscIdeError where

4643 ]

4744

4845textError :: PscIdeError -> Text

49−textError (GeneralError msg) = pack msg

46+textError (GeneralError msg) = msg

5047textError (NotFound ident) = "Symbol '" <> ident <> "' not found."

5148textError (ModuleNotFound ident) = "Module '" <> ident <> "' not found."

5249textError (ModuleFileNotFound ident) = "Extern file for module " <> ident <>" could not be found"

@@ -54,5 +51,5 @@ textError (ParseError parseError msg) = let escape = show

5451 -- escape newlines and other special

5552 -- chars so we can send the error

5653 -- over the socket as a single line

57− in pack $ msg <> ": " <> show (escape parseError)

58−textError (RebuildError err) = pack (show err)

54+ in msg <> ": " <> escape parseError

55+textError (RebuildError err) = show err

src/Language/PureScript/Ide/Externs.hs+32−26

@@ -12,29 +12,24 @@

1212-- Handles externs files for psc-ide

1313-----------------------------------------------------------------------------

1414

15−{-# LANGUAGE OverloadedStrings #-}

15+{-# LANGUAGE OverloadedStrings #-}

16+{-# LANGUAGE RecordWildCards #-}

17+{-# LANGUAGE FlexibleContexts #-}

1618

1719module Language.PureScript.Ide.Externs

1820 ( ExternDecl(..),

1921 ModuleIdent,

20− DeclIdent,

2122 readExternFile,

2223 convertExterns,

24+ convertModule,

2325 unwrapPositioned,

2426 unwrapPositionedRef

2527 ) where

2628

27−import Prelude ()

28−import Prelude.Compat

29+import Protolude

2930

30−import Control.Monad.Error.Class

31−import Control.Monad.IO.Class

3231import Data.Aeson (decodeStrict)

3332import Data.List (nub)

34−import Data.Maybe (mapMaybe)

35−import Data.Monoid

36−import Data.Text (Text)

37−import qualified Data.Text as T

3833import qualified Data.ByteString as BS

3934import Language.PureScript.Ide.Error (PscIdeError (..))

4035import Language.PureScript.Ide.Types

@@ -42,24 +37,20 @@ import Language.PureScript.Ide.Util

4237

4338import qualified Language.PureScript as P

4439

40+import System.FilePath

41+

4542readExternFile :: (MonadIO m, MonadError PscIdeError m) =>

4643 FilePath -> m P.ExternsFile

4744readExternFile fp = do

4845 parseResult <- liftIO (decodeStrict <$> BS.readFile fp)

4946 case parseResult of

50− Nothing -> throwError . GeneralError $ "Parsing the extern at: " ++ fp ++ " failed"

47+ Nothing -> throwError . GeneralError $ "Parsing the extern at: " <> toS fp <> " failed"

5148 Just externs -> pure externs

5249

53−moduleNameToText :: P.ModuleName -> Text

54−moduleNameToText = T.pack . P.runModuleName

55−

56−identToText :: P.Ident -> Text

57−identToText = T.pack . P.runIdent

58−

59−convertExterns :: P.ExternsFile -> Module

60−convertExterns ef = (moduleName, exportDecls ++ importDecls ++ decls ++ operatorDecls ++ tyOperatorDecls)

50+convertExterns :: P.ExternsFile -> ModuleOld

51+convertExterns ef = (runModuleNameT moduleName, exportDecls ++ importDecls ++ decls ++ operatorDecls ++ tyOperatorDecls)

6152 where

62− moduleName = moduleNameToText (P.efModuleName ef)

53+ moduleName = P.efModuleName ef

6354 importDecls = convertImport <$> P.efImports ef

6455 exportDecls = mapMaybe (convertExport . unwrapPositionedRef) (P.efExports ef)

6556 operatorDecls = convertOperator <$> P.efFixities ef

@@ -82,12 +73,12 @@ isTypeClassDeclaration _ = False

8273

8374convertImport :: P.ExternsImport -> ExternDecl

8475convertImport ei = Dependency

85− (moduleNameToText (P.eiModule ei))

76+ (runModuleNameT (P.eiModule ei))

8677 []

87− (moduleNameToText <$> P.eiImportedAs ei)

78+ (runModuleNameT <$> P.eiImportedAs ei)

8879

8980convertExport :: P.DeclarationRef -> Maybe ExternDecl

90−convertExport (P.ModuleRef mn) = Just (Export (moduleNameToText mn))

81+convertExport (P.ModuleRef mn) = Just (Export (runModuleNameT mn))

9182convertExport _ = Nothing

9283

9384convertDecl :: P.ExternsDeclaration -> Maybe ExternDecl

@@ -97,7 +88,7 @@ convertDecl P.EDTypeSynonym{..} = Just $

9788convertDecl P.EDDataConstructor{..} = Just $

9889 DataConstructor (runProperNameT edDataCtorName) edDataCtorTypeCtor edDataCtorType

9990convertDecl P.EDValue{..} = Just $

100− ValueDeclaration (identToText edValueName) edValueType

91+ ValueDeclaration (runIdentT edValueName) edValueType

10192convertDecl P.EDClass{..} = Just $ TypeClassDeclaration edClassName

10293convertDecl P.EDInstance{} = Nothing

10394

@@ -105,7 +96,7 @@ convertOperator :: P.ExternsFixity -> ExternDecl

10596convertOperator P.ExternsFixity{..} =

10697 ValueOperator

10798 efOperator

108− (T.pack (P.showQualified (either P.runIdent P.runProperName) efAlias))

99+ (toS (P.showQualified (either P.runIdent P.runProperName) efAlias))

109100 efPrecedence

110101 efAssociativity

111102

@@ -113,7 +104,7 @@ convertTypeOperator :: P.ExternsTypeFixity -> ExternDecl

113104convertTypeOperator P.ExternsTypeFixity{..} =

114105 TypeOperator

115106 efTypeOperator

116− (T.pack (P.showQualified P.runProperName efTypeAlias))

107+ (toS (P.showQualified P.runProperName efTypeAlias))

117108 efTypePrecedence

118109 efTypeAssociativity

119110

@@ -124,3 +115,18 @@ unwrapPositioned x = x

124115unwrapPositionedRef :: P.DeclarationRef -> P.DeclarationRef

125116unwrapPositionedRef (P.PositionedDeclarationRef _ _ x) = x

126117unwrapPositionedRef x = x

118+

119+convertModule :: ModuleOld -> Module

120+convertModule (mn, decls) = (P.moduleNameFromString (toS mn), mapMaybe convertDeclaration decls)

121+ where convertDeclaration :: ExternDecl -> Maybe IdeDeclaration

122+ convertDeclaration d = case d of

123+ ValueDeclaration i t -> Just (IdeValue i t)

124+ TypeDeclaration i k -> Just (IdeType i k)

125+ TypeSynonymDeclaration i t -> Just (IdeTypeSynonym i t)

126+ DataConstructor i tn t -> Just (IdeDataConstructor i tn t)

127+ TypeClassDeclaration i -> Just (IdeTypeClass i)

128+ ValueOperator n i p a -> Just (IdeValueOperator n i p a)

129+ TypeOperator n i p a -> Just (IdeTypeOperator n i p a)

130+ Dependency{} -> Nothing

131+ ModuleDecl _ _ -> Nothing

132+ Export _ -> Nothing

src/Language/PureScript/Ide/Filter.hs+13−46

@@ -20,22 +20,17 @@ module Language.PureScript.Ide.Filter

2020 , moduleFilter

2121 , prefixFilter

2222 , equalityFilter

23− , dependencyFilter

2423 , runFilter

2524 , applyFilters

2625 ) where

2726

28−import Prelude ()

29−import Prelude.Compat

27+import Protolude hiding (isPrefixOf)

3028

31−import Control.Monad

3229import Data.Aeson

33−import Data.Foldable

34−import Data.Maybe (listToMaybe, mapMaybe)

35−import Data.Monoid

36−import Data.Text (Text, isPrefixOf)

30+import Data.Text (isPrefixOf)

3731import Language.PureScript.Ide.Types

3832import Language.PureScript.Ide.Util

33+import qualified Language.PureScript as P

3934

4035newtype Filter = Filter (Endo [Module]) deriving(Monoid)

4136

@@ -43,53 +38,29 @@ mkFilter :: ([Module] -> [Module]) -> Filter

4338mkFilter = Filter . Endo

4439

4540-- | Only keeps the given Modules

46−moduleFilter :: [ModuleIdent] -> Filter

41+moduleFilter :: [P.ModuleName] -> Filter

4742moduleFilter =

4843 mkFilter . moduleFilter'

4944

50−moduleFilter' :: [ModuleIdent] -> [Module] -> [Module]

45+moduleFilter' :: [P.ModuleName] -> [Module] -> [Module]

5146moduleFilter' moduleIdents = filter (flip elem moduleIdents . fst)

5247

53−-- | Only keeps the given Modules and all of their dependencies

54−dependencyFilter :: [ModuleIdent] -> Filter

55−dependencyFilter = mkFilter . dependencyFilter'

56−

57−dependencyFilter' :: [ModuleIdent] -> [Module] -> [Module]

58−dependencyFilter' moduleIdents mods =

59− moduleFilter' (concatMap (getDepForModule mods) moduleIdents) mods

60− where

61− getDepForModule :: [Module] -> ModuleIdent -> [ModuleIdent]

62− getDepForModule ms moduleIdent =

63− moduleIdent : maybe [] extractDeps (findModule moduleIdent ms)

64−

65− findModule :: ModuleIdent -> [Module] -> Maybe Module

66− findModule i ms = listToMaybe $ filter go ms

67− where go (mn, _) = i == mn

68−

69− extractDeps :: Module -> [ModuleIdent]

70− extractDeps = mapMaybe extractDep . snd

71− where extractDep (Dependency n _ _) = Just n

72− extractDep _ = Nothing

73−

7448-- | Only keeps Identifiers that start with the given prefix

7549prefixFilter :: Text -> Filter

76−prefixFilter "" = mkFilter id

50+prefixFilter "" = mkFilter identity

7751prefixFilter t = mkFilter $ identFilter prefix t

7852 where

79− prefix :: ExternDecl -> Text -> Bool

80− prefix Export{} _ = False

81− prefix Dependency{} _ = False

82− prefix ed search = search `isPrefixOf` identifierFromExternDecl ed

83−

53+ prefix :: IdeDeclaration -> Text -> Bool

54+ prefix ed search = search `isPrefixOf` identifierFromIdeDeclaration ed

8455

8556-- | Only keeps Identifiers that are equal to the search string

8657equalityFilter :: Text -> Filter

8758equalityFilter = mkFilter . identFilter equality

8859 where

89− equality :: ExternDecl -> Text -> Bool

90− equality ed search = identifierFromExternDecl ed == search

60+ equality :: IdeDeclaration -> Text -> Bool

61+ equality ed search = identifierFromIdeDeclaration ed == search

9162

92−identFilter :: (ExternDecl -> Text -> Bool ) -> Text -> [Module] -> [Module]

63+identFilter :: (IdeDeclaration -> Text -> Bool) -> Text -> [Module] -> [Module]

9364identFilter predicate search =

9465 filter (not . null . snd) . fmap filterModuleDecls

9566 where

@@ -105,7 +76,7 @@ applyFilters = runFilter . fold

10576

10677instance FromJSON Filter where

10778 parseJSON = withObject "filter" $ \o -> do

108− (filter' :: String) <- o .: "filter"

79+ (filter' :: Text) <- o .: "filter"

10980 case filter' of

11081 "exact" -> do

11182 params <- o .: "params"

@@ -117,10 +88,6 @@ instance FromJSON Filter where

11788 return $ prefixFilter search

11889 "modules" -> do

11990 params <- o .: "params"

120− modules <- params .: "modules"

91+ modules <- map P.moduleNameFromString <$> params .: "modules"

12192 return $ moduleFilter modules

122− "dependencies" -> do

123− params <- o .: "params"

124− deps <- params .: "modules"

125− return $ dependencyFilter deps

12693 _ -> mzero

src/Language/PureScript/Ide/Imports.hs+30−37

@@ -29,17 +29,9 @@ module Language.PureScript.Ide.Imports

2929 )

3030 where

3131

32−import Prelude.Compat

33−import Control.Applicative ((<|>))

34−import Control.Monad.Error.Class

35−import Control.Monad.IO.Class

36−import Data.Bifunctor (first, second)

37−import Data.Function (on)

38−import qualified Data.List as List

39−import Data.Maybe (isNothing)

40−import Data.Monoid ((<>))

41−import Data.Text (Text)

32+import Protolude

4233import qualified Data.Text as T

34+import Data.List (nubBy, findIndex)

4335import qualified Data.Text.IO as TIO

4436import qualified Language.PureScript as P

4537import Language.PureScript.Ide.Completion

@@ -50,6 +42,7 @@ import Language.PureScript.Ide.Filter

5042import Language.PureScript.Ide.State

5143import Language.PureScript.Ide.Types

5244import Language.PureScript.Ide.Util

45+import System.FilePath

5346

5447data Import = Import P.ModuleName P.ImportDeclarationType (Maybe P.ModuleName)

5548 deriving (Eq, Show)

@@ -85,7 +78,7 @@ parseImportsFromFile fp = do

8578 Right res -> pure res

8679 Left err -> throwError (GeneralError err)

8780

88−parseImportsWithModuleName :: [Text] -> Either String (P.ModuleName, [Import])

81+parseImportsWithModuleName :: [Text] -> Either Text (P.ModuleName, [Import])

8982parseImportsWithModuleName ls = do

9083 (P.Module _ _ mn decls _) <- moduleParse ls

9184 pure (mn, concatMap mkImport (unwrapPositioned <$> decls))

@@ -95,13 +88,13 @@ parseImportsWithModuleName ls = do

9588 mkImport (P.ImportDeclaration mn it qual) = [Import mn it qual]

9689 mkImport _ = []

9790

98−sliceImportSection :: [Text] -> Either String (P.ModuleName, [Text], [Import], [Text])

91+sliceImportSection :: [Text] -> Either Text (P.ModuleName, [Text], [Import], [Text])

9992sliceImportSection ts =

10093 case foldl step (ModuleHeader 0) (zip [0..] ts) of

10194 Res start end ->

10295 let

10396 (moduleHeader, (importSection, remainingFile)) =

104− List.splitAt (succ (end - start)) `second` List.splitAt start ts

97+ splitAt (succ (end - start)) `second` splitAt start ts

10598 in

10699 (\(mn, is) -> (mn, moduleHeader, is, remainingFile)) <$>

107100 parseImportsWithModuleName (moduleHeader <> importSection)

@@ -109,7 +102,7 @@ sliceImportSection ts =

109102 -- If we don't find any imports, we insert a newline after the module

110103 -- declaration and begin a new importsection

111104 ModuleHeader ix ->

112− let (moduleHeader, remainingFile) = List.splitAt (succ ix) ts

105+ let (moduleHeader, remainingFile) = splitAt (succ ix) ts

113106 in

114107 (\(mn, is) -> (mn, moduleHeader ++ [""], is, remainingFile)) <$>

115108 parseImportsWithModuleName moduleHeader

@@ -151,7 +144,7 @@ step (ImportSection start lastImportLine) (ix, l)

151144 | otherwise = Res start lastImportLine

152145step (Res start end) _ = Res start end

153146

154−moduleParse :: [Text] -> Either String P.Module

147+moduleParse :: [Text] -> Either Text P.Module

155148moduleParse t = first show $ do

156149 tokens <- (P.lex "" . T.unpack . T.unlines) t

157150 P.runTokenParser "<psc-ide>" P.parseModule tokens

@@ -181,7 +174,7 @@ addImplicitImport' imports mn =

181174-- @import Prelude (bind)@ in the file File.purs returns @["import Prelude

182175-- (bind, unit)"]@

183176addExplicitImport :: (MonadIO m, MonadError PscIdeError m) =>

184− FilePath -> ExternDecl -> P.ModuleName -> m [Text]

177+ FilePath -> IdeDeclaration -> P.ModuleName -> m [Text]

185178addExplicitImport fp decl moduleName = do

186179 (mn, pre, imports, post) <- parseImportsFromFile fp

187180 let newImportSection =

@@ -192,7 +185,7 @@ addExplicitImport fp decl moduleName = do

192185 else addExplicitImport' decl moduleName imports

193186 pure (pre ++ prettyPrintImportSection newImportSection ++ post)

194187

195−addExplicitImport' :: ExternDecl -> P.ModuleName -> [Import] -> [Import]

188+addExplicitImport' :: IdeDeclaration -> P.ModuleName -> [Import] -> [Import]

196189addExplicitImport' decl moduleName imports =

197190 let

198191 isImplicitlyImported =

@@ -207,37 +200,37 @@ addExplicitImport' decl moduleName imports =

207200 then imports

208201 else updateAtFirstOrPrepend matches (insertDeclIntoImport decl) freshImport imports

209202 where

210− refFromDeclaration (TypeClassDeclaration n) =

203+ refFromDeclaration (IdeTypeClass n) =

211204 P.TypeClassRef n

212− refFromDeclaration (DataConstructor n tn _) =

205+ refFromDeclaration (IdeDataConstructor n tn _) =

213206 P.TypeRef tn (Just [P.ProperName (T.unpack n)])

214− refFromDeclaration (TypeDeclaration n _) =

207+ refFromDeclaration (IdeType n _) =

215208 P.TypeRef n (Just [])

216− refFromDeclaration (ValueOperator op _ _ _) =

209+ refFromDeclaration (IdeValueOperator op _ _ _) =

217210 P.ValueOpRef op

218− refFromDeclaration (TypeOperator op _ _ _) =

211+ refFromDeclaration (IdeTypeOperator op _ _ _) =

219212 P.TypeOpRef op

220213 refFromDeclaration d =

221− P.ValueRef $ P.Ident $ T.unpack (identifierFromExternDecl d)

214+ P.ValueRef $ P.Ident $ T.unpack (identifierFromIdeDeclaration d)

222215

223216 -- | Adds a declaration to an import:

224217 -- TypeDeclaration "Maybe" + Data.Maybe (maybe) -> Data.Maybe(Maybe, maybe)

225− insertDeclIntoImport :: ExternDecl -> Import -> Import

218+ insertDeclIntoImport :: IdeDeclaration -> Import -> Import

226219 insertDeclIntoImport decl' (Import mn (P.Explicit refs) Nothing) =

227220 Import mn (P.Explicit (insertDeclIntoRefs decl' refs)) Nothing

228221 insertDeclIntoImport _ is = is

229222

230− insertDeclIntoRefs :: ExternDecl -> [P.DeclarationRef] -> [P.DeclarationRef]

231− insertDeclIntoRefs (DataConstructor dtor tn _) refs =

223+ insertDeclIntoRefs :: IdeDeclaration -> [P.DeclarationRef] -> [P.DeclarationRef]

224+ insertDeclIntoRefs (IdeDataConstructor dtor tn _) refs =

232225 let

233226 dtor' = P.ProperName (T.unpack dtor)

234227 in

235228 updateAtFirstOrPrepend (matchType tn) (insertDtor dtor') (P.TypeRef tn (Just [dtor'])) refs

236− insertDeclIntoRefs dr refs = List.nubBy ((==) `on` P.prettyPrintRef) (refFromDeclaration dr : refs)

229+ insertDeclIntoRefs dr refs = nubBy ((==) `on` P.prettyPrintRef) (refFromDeclaration dr : refs)

237230

238231 insertDtor dtor (P.TypeRef tn' dtors) =

239232 case dtors of

240− Just dtors' -> P.TypeRef tn' (Just (List.nub (dtor : dtors')))

233+ Just dtors' -> P.TypeRef tn' (Just (ordNub (dtor : dtors')))

241234 -- This means the import was opened. We don't add anything in this case

242235 -- import Data.Maybe (Maybe(..)) -> import Data.Maybe (Maybe(Just))

243236 Nothing -> P.TypeRef tn' Nothing

@@ -249,10 +242,10 @@ addExplicitImport' decl moduleName imports =

249242

250243updateAtFirstOrPrepend :: (a -> Bool) -> (a -> a) -> a -> [a] -> [a]

251244updateAtFirstOrPrepend p t d l =

252− case List.findIndex p l of

245+ case findIndex p l of

253246 Nothing -> d : l

254247 Just ix ->

255− let (x, a : y) = List.splitAt ix l

248+ let (x, a : y) = splitAt ix l

256249 in x ++ [t a] ++ y

257250

258251-- | Looks up the given identifier in the currently loaded modules.

@@ -263,14 +256,14 @@ updateAtFirstOrPrepend p t d l =

263256--

264257-- * If more than one possible imports are found, reports the possibilities as a

265258-- list of completions.

266−addImportForIdentifier :: (PscIde m, MonadError PscIdeError m)

259+addImportForIdentifier :: (Ide m, MonadError PscIdeError m)

267260 => FilePath -- ^ The Sourcefile to read from

268261 -> Text -- ^ The identifier to import

269262 -> [Filter] -- ^ Filters to apply before searching for

270263 -- the identifier

271264 -> m (Either [Match] [Text])

272265addImportForIdentifier fp ident filters = do

273− modules <- getAllModulesWithReexports

266+ modules <- getAllModules2 Nothing

274267 case getExactMatches ident filters modules of

275268 [] ->

276269 throwError (NotFound "Couldn't find the given identifier. \

@@ -279,7 +272,7 @@ addImportForIdentifier fp ident filters = do

279272 -- Only one match was found for the given identifier, so we can insert it

280273 -- right away

281274 [Match m decl] ->

282− Right <$> addExplicitImport fp decl (P.moduleNameFromString (T.unpack m))

275+ Right <$> addExplicitImport fp decl m

283276

284277 -- This case comes up for newtypes and dataconstructors. Because values and

285278 -- types don't share a namespace we can get multiple matches from the same

@@ -296,7 +289,7 @@ addImportForIdentifier fp ident filters = do

296289 -- dataconstructor as that will give us an unnecessary import warning at

297290 -- worst

298291 Just decl ->

299− Right <$> addExplicitImport fp decl (P.moduleNameFromString (T.unpack m1))

292+ Right <$> addExplicitImport fp decl m1

300293 -- Here we need the user to specify whether he wanted a dataconstructor

301294 -- or a type

302295 Nothing ->

@@ -307,9 +300,9 @@ addImportForIdentifier fp ident filters = do

307300 xs ->

308301 pure $ Left xs

309302 where

310− decideRedundantCase dtor@(DataConstructor _ t _) (TypeDeclaration t' _) =

303+ decideRedundantCase dtor@(IdeDataConstructor _ t _) (IdeType t' _) =

311304 if t == t' then Just dtor else Nothing

312− decideRedundantCase TypeDeclaration{} ts@TypeSynonymDeclaration{} =

305+ decideRedundantCase IdeType{} ts@IdeTypeSynonym{} =

313306 Just ts

314307 decideRedundantCase _ _ = Nothing

315308

@@ -321,7 +314,7 @@ prettyPrintImport' (Import mn idt qual) =

321314 T.pack $ "import " ++ P.prettyPrintImport mn idt qual

322315

323316prettyPrintImportSection :: [Import] -> [Text]

324−prettyPrintImportSection imports = map prettyPrintImport' (List.sort imports)

317+prettyPrintImportSection imports = map prettyPrintImport' (sort imports)

325318

326319-- | Writes a list of lines to @Just filepath@ and responds with a @TextResult@,

327320-- or returns the lines as a @MultilineTextResult@ if @Nothing@ was given as the

src/Language/PureScript/Ide/Matcher.hs+7−14

@@ -21,16 +21,9 @@ module Language.PureScript.Ide.Matcher

2121 , runMatcher

2222 ) where

2323

24−import Prelude ()

25−import Prelude.Compat

24+import Protolude

2625

27−import Control.Monad

2826import Data.Aeson

29−import Data.Function (on)

30−import Data.List (sortBy)

31−import Data.Maybe (mapMaybe)

32−import Data.Monoid

33−import Data.Text (Text)

3427import qualified Data.Text as T

3528import qualified Data.Text.Encoding as TE

3629import Language.PureScript.Ide.Types

@@ -41,11 +34,11 @@ import Text.Regex.TDFA ((=~))

4134

4235type ScoredMatch = (Match, Double)

4336

44−newtype Matcher = Matcher (Endo [Match]) deriving(Monoid)

37+newtype Matcher = Matcher (Endo [Match]) deriving (Monoid)

4538

4639instance FromJSON Matcher where

4740 parseJSON = withObject "matcher" $ \o -> do

48− (matcher :: Maybe String) <- o .:? "matcher"

41+ (matcher :: Maybe Text) <- o .:? "matcher"

4942 case matcher of

5043 Just "flex" -> do

5144 params <- o .: "params"

@@ -105,11 +98,11 @@ flexRate p c = do

10598-- By string =~ pattern we'll get the start of the match and the length of

10699-- the matchas a (start, length) tuple if there's a match.

107100-- If match fails then it would be (-1,0)

108−flexScore :: Text -> DeclIdent -> Maybe Double

101+flexScore :: Text -> Text -> Maybe Double

109102flexScore pat str =

110103 case T.uncons pat of

111104 Nothing -> Nothing

112− Just (first, p) ->

105+ Just (first', p) ->

113106 case TE.encodeUtf8 str =~ TE.encodeUtf8 pat' :: (Int, Int) of

114107 (-1,0) -> Nothing

115108 (start,len) -> Just $ calcScore start (start + len)

@@ -120,11 +113,11 @@ flexScore pat str =

120113 -- escape prepends a backslash to "regexy" characters to prevent the

121114 -- matcher from crashing when trying to build the regex

122115 escape :: Char -> Text

123− escape c = if c `elem` ("[\\^$.|?*+(){}" :: String)

116+ escape c = if c `elem` T.unpack "[\\^$.|?*+(){}"

124117 then T.pack ['\\', c]

125118 else T.singleton c

126119 -- This just interleaves the search pattern with .*

127120 -- abcd[*] -> a.*b.*c.*d.*[*]

128− pat' = escape first <> foldMap (<> ".*") escapedPattern

121+ pat' = escape first' <> foldMap (<> ".*") escapedPattern

129122 calcScore start end =

130123 100.0 / fromIntegral ((1 + start) * (end - start + 1))

src/Language/PureScript/Ide/Pursuit.hs+5−11

@@ -16,18 +16,12 @@

1616

1717module Language.PureScript.Ide.Pursuit where

1818

19−import Prelude ()

20−import Prelude.Compat

19+import Protolude

2120

2221import qualified Control.Exception as E

2322import Data.Aeson

24−import Data.ByteString (ByteString)

2523import Data.ByteString.Lazy (fromStrict)

26−import Data.Foldable (toList)

27−import Data.Maybe (mapMaybe)

28−import Data.Monoid ((<>))

2924import Data.String

30−import Data.Text (Text)

3125import qualified Data.Text as T

3226import Language.PureScript.Ide.Types

3327import Network.HTTP.Types.Header (hAccept)

@@ -41,12 +35,12 @@ queryPursuit q = do

4135 let qClean = T.dropWhileEnd (== '.') q

4236 req' <- parseUrl "http://pursuit.purescript.org/search"

4337 let req = req'

44− { queryString=("q=" <> (fromString . T.unpack) qClean)

38+ { queryString= "q=" <> (fromString . T.unpack) qClean

4539 , requestHeaders=[(hAccept, "application/json")]

4640 }

4741 m <- newManager tlsManagerSettings

4842 withHTTP req m $ \resp ->

49− P.fold (<>) "" id $ responseBody resp

43+ P.fold (<>) "" identity (responseBody resp)

5044

5145

5246handler :: HttpException -> IO [a]

@@ -59,7 +53,7 @@ searchPursuitForDeclarations query =

5953 let results' = decode (fromStrict r) :: Maybe Array

6054 case results' of

6155 Nothing -> pure []

62− Just results -> pure (mapMaybe isDeclarationResponse (map fromJSON (toList results)))) `E.catch`

56+ Just results -> pure (mapMaybe (isDeclarationResponse . fromJSON) (toList results))) `E.catch`

6357 handler

6458 where

6559 isDeclarationResponse (Success a@DeclarationResponse{}) = Just a

@@ -71,7 +65,7 @@ findPackagesForModuleIdent query =

7165 let results' = decode (fromStrict r) :: Maybe Array

7266 case results' of

7367 Nothing -> pure []

74− Just results -> pure (mapMaybe isModuleResponse (map fromJSON (toList results)))) `E.catch`

68+ Just results -> pure (mapMaybe (isModuleResponse . fromJSON) (toList results))) `E.catch`

7569 handler

7670 where

7771 isModuleResponse (Success a@ModuleResponse{}) = Just a

src/Language/PureScript/Ide/Rebuild.hs+16−18

@@ -8,14 +8,12 @@ module Language.PureScript.Ide.Rebuild

88 ( rebuildFile

99 ) where

1010

11−import Control.Monad.Error.Class

12−import Control.Monad.IO.Class

11+import Protolude

12+

1313import "monad-logger" Control.Monad.Logger

14−import Control.Monad.Reader

15−import Control.Monad.Trans.Except

14+import qualified Data.List as List

1615import qualified Data.Map.Lazy as M

17−import Data.Maybe (fromJust, mapMaybe)

18−import Data.Monoid ((<>))

16+import Data.Maybe (fromJust)

1917import qualified Data.Set as S

2018import qualified Language.PureScript as P

2119import Language.PureScript.Errors.JSON

@@ -23,8 +21,8 @@ import Language.PureScript.Ide.Error

2321import Language.PureScript.Ide.State

2422import Language.PureScript.Ide.Types

2523import Language.PureScript.Ide.Util

26−import Prelude.Compat

2724import System.IO.UTF8 (readUTF8File)

25+import System.FilePath

2826

2927-- | Given a filepath performs the following steps:

3028--

@@ -42,14 +40,14 @@ import System.IO.UTF8 (readUTF8File)

4240-- warnings, and if rebuilding fails, returns a @RebuildError@ with the

4341-- generated errors.

4442rebuildFile

45− :: (PscIde m, MonadLogger m, MonadError PscIdeError m)

43+ :: (Ide m, MonadLogger m, MonadError PscIdeError m)

4644 => FilePath

4745 -> m Success

4846rebuildFile path = do

4947

5048 input <- liftIO (readUTF8File path)

5149

52− m <- case snd <$> P.parseModuleFromFile id (path, input) of

50+ m <- case snd <$> P.parseModuleFromFile identity (path, input) of

5351 Left parseError -> throwError

5452 . RebuildError

5553 . toJSONErrors False P.Error

@@ -60,7 +58,7 @@ rebuildFile path = do

6058 -- correctly to the 'Environment'.

6159 externs <- sortExterns m =<< getExternFiles

6260

63− outputDirectory <- confOutputPath . envConfiguration <$> ask

61+ outputDirectory <- confOutputPath . ideConfiguration <$> ask

6462

6563 -- For rebuilding, we want to 'RebuildAlways', but for inferring foreign

6664 -- modules using their file paths, we need to specify the path in the 'Map'.

@@ -82,7 +80,7 @@ rebuildFile path = do

8280-- | Rebuilds a module but opens up its export list first and stores the result

8381-- inside the rebuild cache

8482rebuildModuleOpen

85− :: (PscIde m, MonadLogger m, MonadError PscIdeError m)

83+ :: (Ide m, MonadLogger m, MonadError PscIdeError m)

8684 => MakeActionsEnv

8785 -> [P.ExternsFile]

8886 -> P.Module

@@ -100,14 +98,14 @@ rebuildModuleOpen makeEnv externs m = do

10098 Right result -> do

10199 $(logDebug)

102100 ("Setting Rebuild cache: " <> runModuleNameT (P.efModuleName result))

103− setCachedRebuild result

101+ cacheRebuild result

104102

105103-- | Parameters we can access while building our @MakeActions@

106104data MakeActionsEnv =

107105 MakeActionsEnv

108106 { maeOutputDirectory :: FilePath

109− , maeFilePathMap :: M.Map P.ModuleName (Either P.RebuildPolicy FilePath)

110− , maeForeignPathMap :: M.Map P.ModuleName FilePath

107+ , maeFilePathMap :: Map P.ModuleName (Either P.RebuildPolicy FilePath)

108+ , maeForeignPathMap :: Map P.ModuleName FilePath

111109 , maePrefixComment :: Bool

112110 }

113111

@@ -135,9 +133,9 @@ shushCodegen ma MakeActionsEnv{..} =

135133-- module. Throws an error if there is a cyclic dependency within the

136134-- ExternsFiles

137135sortExterns

138− :: (PscIde m, MonadError PscIdeError m)

136+ :: (Ide m, MonadError PscIdeError m)

139137 => P.Module

140− -> M.Map P.ModuleName P.ExternsFile

138+ -> Map P.ModuleName P.ExternsFile

141139 -> m [P.ExternsFile]

142140sortExterns m ex = do

143141 sorted' <- runExceptT

@@ -149,11 +147,11 @@ sortExterns m ex = do

149147 case sorted' of

150148 Left _ -> throwError (GeneralError "There was a cycle in the dependencies")

151149 Right (sorted, graph) -> do

152− let deps = fromJust (lookup (P.getModuleName m) graph)

150+ let deps = fromJust (List.lookup (P.getModuleName m) graph)

153151 pure $ mapMaybe getExtern (deps `inOrderOf` map P.getModuleName sorted)

154152 where

155153 mkShallowModule P.ExternsFile{..} =

156− P.Module undefined [] efModuleName (map mkImport efImports) Nothing

154+ P.Module (P.internalModuleSourceSpan "<rebuild>") [] efModuleName (map mkImport efImports) Nothing

157155 mkImport (P.ExternsImport mn it iq) =

158156 P.ImportDeclaration mn it iq

159157 getExtern mn = M.lookup mn ex

src/Language/PureScript/Ide/Reexports.hs+23−15

@@ -15,19 +15,24 @@

1515

1616{-# LANGUAGE OverloadedStrings #-}

1717

18−module Language.PureScript.Ide.Reexports where

18+module Language.PureScript.Ide.Reexports

19+ ( resolveReexports2

20+ -- for tests

21+ , getReexports

22+ , replaceReexport

23+ , replaceReexports

24+ ) where

1925

2026

21−import Prelude ()

22−import Prelude.Compat

27+import Protolude

2328

2429import Data.List (union)

25−import Data.Map (Map)

2630import qualified Data.Map as Map

27−import Data.Maybe

2831import Language.PureScript.Ide.Types

32+import Language.PureScript.Ide.Externs

33+import qualified Language.PureScript as P

2934

30−getReexports :: Module -> [ExternDecl]

35+getReexports :: ModuleOld -> [ExternDecl]

3136getReexports (mn, decls)= concatMap getExport decls

3237 where getExport d

3338 | (Export mn') <- d

@@ -48,32 +53,32 @@ replaceExportWithAliases decls ident =

4853 , alias == ident = True

4954 | otherwise = False

5055

51−replaceReexport :: ExternDecl -> Module -> Module -> Module

56+replaceReexport :: ExternDecl -> ModuleOld -> ModuleOld -> ModuleOld

5257replaceReexport e@(Export _) (m, decls) (_, newDecls) =

5358 (m, filter (/= e) decls `union` newDecls)

54−replaceReexport _ _ _ = error "Should only get Exports here."

59+replaceReexport _ _ _ = P.internalError "Should only get Exports here"

5560

56−emptyModule :: Module

61+emptyModule :: ModuleOld

5762emptyModule = ("Empty", [])

5863

5964isExport :: ExternDecl -> Bool

6065isExport (Export _) = True

6166isExport _ = False

6267

63−removeExportDecls :: Module -> Module

68+removeExportDecls :: ModuleOld -> ModuleOld

6469removeExportDecls = fmap (filter (not . isExport))

6570

66−replaceReexports :: Module -> Map ModuleIdent [ExternDecl] -> Module

71+replaceReexports :: ModuleOld -> Map ModuleIdent [ExternDecl] -> ModuleOld

6772replaceReexports m db = result

6873 where

6974 reexports = getReexports m

7075 result = foldl go (removeExportDecls m) reexports

7176

72− go :: Module -> ExternDecl -> Module

77+ go :: ModuleOld -> ExternDecl -> ModuleOld

7378 go m' re@(Export name) = replaceReexport re m' (getModule name)

74− go _ _ = error "partiality! woohoo"

79+ go _ _ = P.internalError "Should only get Exports here"

7580

76− getModule :: ModuleIdent -> Module

81+ getModule :: ModuleIdent -> ModuleOld

7782 getModule name = clean res

7883 where

7984 res = fromMaybe emptyModule $ (name , ) <$> Map.lookup name db

@@ -81,9 +86,12 @@ replaceReexports m db = result

8186 -- infinite loops

8287 clean (mn, decls) = (mn,) (filter (/= Export mn) decls)

8388

84−resolveReexports :: Map ModuleIdent [ExternDecl] -> Module -> Module

89+resolveReexports :: Map ModuleIdent [ExternDecl] -> ModuleOld -> ModuleOld

8590resolveReexports modules m =

8691 let replaced = replaceReexports m modules

8792 in if null (getReexports replaced)

8893 then replaced

8994 else resolveReexports modules replaced

95+

96+resolveReexports2 :: Map Text [ExternDecl] -> ModuleOld -> Module

97+resolveReexports2 decls = convertModule . resolveReexports decls

src/Language/PureScript/Ide/SourceFile.hs+52−74

@@ -14,107 +14,85 @@

1414

1515{-# LANGUAGE OverloadedStrings #-}

1616

17−module Language.PureScript.Ide.SourceFile where

17+module Language.PureScript.Ide.SourceFile

18+ ( parseModule

19+ , getImportsForFile

20+ -- SOON...

21+ , getDeclPosition

22+ ) where

1823

19−import Prelude

24+import Protolude

2025

21−import Control.Monad.Error.Class

22−import Control.Monad.IO.Class

23−import Control.Monad.Trans.Except

24−import Data.Maybe (mapMaybe)

25−import Data.Monoid

26−import qualified Data.Text as T

27−import qualified Language.PureScript.AST.Declarations as D

28−import qualified Language.PureScript.AST.SourcePos as SP

26+import qualified Language.PureScript as P

2927import Language.PureScript.Ide.Error

28+import Language.PureScript.Ide.Util

3029import Language.PureScript.Ide.Externs (unwrapPositioned,

3130 unwrapPositionedRef)

3231import Language.PureScript.Ide.Types

33−import qualified Language.PureScript.Names as N

34−import qualified Language.PureScript.Parser as P

35−import System.Directory

32+import System.FilePath

3633import System.IO.UTF8 (readUTF8File)

3734

38−parseModuleFromFile :: (MonadIO m, MonadError PscIdeError m) =>

39− FilePath -> m D.Module

40−parseModuleFromFile fp = do

41− exists <- liftIO (doesFileExist fp)

42− if exists

43− then do

44− content <- liftIO (readUTF8File fp)

45− let m = do tokens <- P.lex fp content

46− P.runTokenParser "" P.parseModule tokens

47− either (throwError . (`ParseError` "File could not be parsed.")) pure m

48− else throwError (NotFound "File does not exist.")

35+parseModule

36+ :: (MonadIO m)

37+ => FilePath

38+ -> m (Either FilePath (FilePath, P.Module) )

39+parseModule path = do

40+ contents <- liftIO (readUTF8File path)

41+ case P.parseModuleFromFile identity (path, contents) of

42+ Left _ -> pure (Left path)

43+ Right m -> pure (Right m)

4944

50−-- data Module = Module SourceSpan [Comment] ModuleName [Declaration] (Maybe [DeclarationRef])

51−

52−getDeclarations :: D.Module -> [D.Declaration]

53−getDeclarations (D.Module _ _ _ declarations _) = declarations

54−

55−getImports :: D.Module -> [D.Declaration]

56−getImports (D.Module _ _ _ declarations _) =

45+getImports :: P.Module -> [(P.ModuleName, P.ImportDeclarationType, Maybe P.ModuleName)]

46+getImports (P.Module _ _ _ declarations _) =

5747 mapMaybe isImport declarations

5848 where

59− isImport (D.PositionedDeclaration _ _ (i@D.ImportDeclaration{})) = Just i

49+ isImport (P.PositionedDeclaration _ _ (P.ImportDeclaration a b c)) = Just (a, b, c)

6050 isImport _ = Nothing

6151

6252getImportsForFile :: (MonadIO m, MonadError PscIdeError m) =>

6353 FilePath -> m [ModuleImport]

6454getImportsForFile fp = do

65− module' <- parseModuleFromFile fp

66− let imports = getImports module'

67− pure (mkModuleImport . unwrapPositionedImport <$> imports)

68− where

69− mkModuleImport (D.ImportDeclaration mn importType' qualifier) =

70− ModuleImport

71− (T.pack (N.runModuleName mn))

72− importType'

73− (T.pack . N.runModuleName <$> qualifier)

74− mkModuleImport _ = error "Shouldn't have gotten anything but Imports here"

75− unwrapPositionedImport (D.ImportDeclaration mn importType' qualifier) =

76− D.ImportDeclaration mn (unwrapImportType importType') qualifier

77− unwrapPositionedImport x = x

78− unwrapImportType (D.Explicit decls) = D.Explicit (map unwrapPositionedRef decls)

79− unwrapImportType (D.Hiding decls) = D.Hiding (map unwrapPositionedRef decls)

80− unwrapImportType D.Implicit = D.Implicit

81−

82−getPositionedImports :: D.Module -> [D.Declaration]

83−getPositionedImports (D.Module _ _ _ declarations _) =

84− mapMaybe isImport declarations

85− where

86− isImport i@(D.PositionedDeclaration _ _ D.ImportDeclaration{}) = Just i

87− isImport _ = Nothing

55+ moduleE <- parseModule fp

56+ case moduleE of

57+ Left _ -> throwError (GeneralError "Failed to parse sourcefile.")

58+ Right (_, module') ->

59+ pure (mkModuleImport . unwrapPositionedImport <$> getImports module')

60+ where

61+ mkModuleImport (mn, importType', qualifier) =

62+ ModuleImport

63+ (runModuleNameT mn)

64+ importType'

65+ (runModuleNameT <$> qualifier)

66+ unwrapPositionedImport (mn, it, q) = (mn, unwrapImportType it, q)

67+ unwrapImportType (P.Explicit decls) = P.Explicit (map unwrapPositionedRef decls)

68+ unwrapImportType (P.Hiding decls) = P.Hiding (map unwrapPositionedRef decls)

69+ unwrapImportType P.Implicit = P.Implicit

8870

89−getDeclPosition :: D.Module -> String -> Maybe SP.SourceSpan

71+getDeclPosition :: P.Module -> Text -> Maybe P.SourceSpan

9072getDeclPosition m ident = getFirst (foldMap (match ident) decls)

9173 where

9274 decls = getDeclarations m

93− match q (D.PositionedDeclaration ss _ decl) = First (if go q decl

75+ match q (P.PositionedDeclaration ss _ decl) = First (if go q decl

9476 then Just ss

9577 else Nothing)

9678 match _ _ = First Nothing

9779

98− go q (D.DataDeclaration _ name _ constructors) =

80+ go q (P.DataDeclaration _ name _ constructors) =

9981 properEqual name q || any (\(x,_) -> properEqual x q) constructors

100− go q (D.DataBindingGroupDeclaration decls') = any (go q) decls'

101− go q (D.TypeSynonymDeclaration name _ _) = properEqual name q

102− go q (D.TypeDeclaration ident' _) = identEqual ident' q

103− go q (D.ValueDeclaration ident' _ _ _) = identEqual ident' q

104− go q (D.ExternDeclaration ident' _) = identEqual ident' q

105− go q (D.ExternDataDeclaration name _) = properEqual name q

106− go q (D.TypeClassDeclaration name _ _ members) =

82+ go q (P.DataBindingGroupDeclaration decls') = any (go q) decls'

83+ go q (P.TypeSynonymDeclaration name _ _) = properEqual name q

84+ go q (P.TypeDeclaration ident' _) = identEqual ident' q

85+ go q (P.ValueDeclaration ident' _ _ _) = identEqual ident' q

86+ go q (P.ExternDeclaration ident' _) = identEqual ident' q

87+ go q (P.ExternDataDeclaration name _) = properEqual name q

88+ go q (P.TypeClassDeclaration name _ _ members) =

10789 properEqual name q || any (go q . unwrapPositioned) members

108− go q (D.TypeInstanceDeclaration ident' _ _ _ _) =

90+ go q (P.TypeInstanceDeclaration ident' _ _ _ _) =

10991 identEqual ident' q

11092 go _ _ = False

11193

112− properEqual x q = N.runProperName x == q

113− identEqual x q = N.runIdent x == q

94+ properEqual x q = runProperNameT x == q

95+ identEqual x q = runIdentT x == q

11496

115−goToDefinition :: String -> FilePath -> IO (Maybe SP.SourceSpan)

116−goToDefinition q fp = do

117− m <- runExceptT (parseModuleFromFile fp)

118− case m of

119− Right module' -> pure (getDeclPosition module' q)

120− Left _ -> pure Nothing

97+ getDeclarations :: P.Module -> [P.Declaration]

98+ getDeclarations (P.Module _ _ _ declarations _) = declarations

src/Language/PureScript/Ide/State.hs+156−88

@@ -17,127 +17,195 @@

1717{-# LANGUAGE TemplateHaskell #-}

1818

1919module Language.PureScript.Ide.State

20− ( getPscIdeState

20+ ( getLoadedModulenames

2121 , getExternFiles

22− , getModule

23− , getModuleWithReexports

24− , getAllModulesWithReexports

25− , getAllModulesWithReexportsAndCache

22+ , insertModuleOld

23+ , resetIdeState

24+ , cacheRebuild

25+ , insertExterns

2626 , insertModule

2727 , insertModuleSTM

28− , getCachedRebuild

29− , resetPscIdeState

30− , setCachedRebuild

28+ , insertExternsSTM

29+ , getAllModules2

30+ , getStage1

31+ , setStage1

32+ , getStage2

33+ , setStage2

34+ , populateStage2

35+ , populateStage2STM

3136 ) where

3237

33−import Prelude ()

34−import Prelude.Compat

38+import Protolude

39+import qualified Prelude

3540

3641import Control.Concurrent.STM

37−import Control.Monad.IO.Class

3842import "monad-logger" Control.Monad.Logger

39−import Control.Monad.Reader.Class

4043import qualified Data.Map.Lazy as M

41−import Data.Maybe (mapMaybe)

42−import Data.Monoid

4344import Language.PureScript.Externs

4445import Language.PureScript.Ide.Externs

4546import Language.PureScript.Ide.Reexports

4647import Language.PureScript.Ide.Types

4748import Language.PureScript.Ide.Util

4849import qualified Language.PureScript as P

50+import System.Clock

51+import System.FilePath

4952

50−-- | Resets the PscIdeState to emptyPscIdeState

51−resetPscIdeState :: PscIde m => m ()

52−resetPscIdeState = do

53+-- | Resets all State inside psc-ide

54+resetIdeState :: Ide m => m ()

55+resetIdeState = do

5356 stateVar <- envStateVar <$> ask

54− liftIO $ atomically (writeTVar stateVar emptyPscIdeState)

57+ ideVar <- ideStateVar <$> ask

58+ liftIO . atomically $ do

59+ writeTVar stateVar emptyPscIdeState

60+ writeTVar ideVar emptyIdeState

61+ setStage2STM ideVar emptyStage2

5562

56−-- | Gets the entire PscIdeState

57−getPscIdeState :: PscIde m => m PscIdeState

58−getPscIdeState = do

59− stateVar <- envStateVar <$> ask

60− liftIO (readTVarIO stateVar)

63+-- | Gets the loaded Modulenames

64+getLoadedModulenames :: Ide m => m [P.ModuleName]

65+getLoadedModulenames = M.keys <$> getExternFiles

6166

6267-- | Gets all loaded ExternFiles

63−getExternFiles :: (PscIde m) => m (M.Map P.ModuleName ExternsFile)

64−getExternFiles = do

65− stateVar <- envStateVar <$> ask

66− liftIO (pscIdeStateExternsFiles <$> readTVarIO stateVar)

67−

68−-- | Gets all loaded Modules and resolves Reexports

69−getAllModulesWithReexports :: (PscIde m) => m [Module]

70−getAllModulesWithReexports = getAllModulesWithReexports' <$> getPscIdeState

71−

72−-- | Pure version of @getAllModulesWithReexports@

73−getAllModulesWithReexports' :: PscIdeState -> [Module]

74−getAllModulesWithReexports' state =

75− mapMaybe (getModuleWithReexports' state) (M.keys (pscIdeStateModules state))

76−

77−-- | Checks if the given ModuleName matches the last rebuild cache and if it

78−-- does, runs @getAllModulesWithReexports@ with the cached module replacing the

79−-- loaded module

80−getAllModulesWithReexportsAndCache

81− :: (PscIde m)

82− => Maybe P.ModuleName

83− -> m [Module]

84−getAllModulesWithReexportsAndCache Nothing = getAllModulesWithReexports

85−getAllModulesWithReexportsAndCache (Just mn) = do

86− state <- getPscIdeState

87− cachedRebuild <- getCachedRebuild

88− case cachedRebuild of

89− Just (cachedIdent, ef) | cachedIdent == mn ->

90− pure (getAllModulesWithReexports' (insertModule' ef state))

91− _ -> getAllModulesWithReexports

92−

93−-- | Looks up a single Module inside the loaded Modules

94−getModule :: (PscIde m) => ModuleIdent -> m (Maybe Module)

95−getModule m = getModule' <$> getPscIdeState <*> pure m

96−

97−-- | Pure version of @getModule@

98−getModule' :: PscIdeState -> ModuleIdent -> Maybe Module

99−getModule' ps mi = (mi,) <$> M.lookup mi (pscIdeStateModules ps)

100−

101−-- | Looks up a single Module and resolves its Reexports

102−getModuleWithReexports :: PscIde m => ModuleIdent -> m (Maybe Module)

103−getModuleWithReexports i = getModuleWithReexports' <$> getPscIdeState <*> pure i

104−

105−-- | Pure version of @getModuleWithReexports@

106−getModuleWithReexports' :: PscIdeState -> ModuleIdent -> Maybe Module

107−getModuleWithReexports' ps mi =

108− resolveReexports (pscIdeStateModules ps) <$> getModule' ps mi

68+getExternFiles :: Ide m => m (M.Map P.ModuleName ExternsFile)

69+getExternFiles = s1Externs <$> getStage1

10970

11071-- | Inserts an @ExternsFile@ into the PscIdeState. Also converts the

11172-- ExternsFile into psc-ide's internal Declaration format

112−insertModule :: (PscIde m, MonadLogger m) =>

113− ExternsFile -> m ()

114−insertModule externsFile = do

73+-- TODO: should be removed when the "old" Declaration format gets removed

74+insertModuleOld :: Ide m => ExternsFile -> m ()

75+insertModuleOld externsFile = do

11576 stateVar <- envStateVar <$> ask

116− let moduleName = efModuleName externsFile

117− $(logDebug) $ "Inserting Module: " <> runModuleNameT moduleName

118− liftIO . atomically $ insertModuleSTM stateVar externsFile

77+ liftIO . atomically $ insertModuleOldSTM stateVar externsFile

11978

120−-- | STM version of insertModule

121−insertModuleSTM :: TVar PscIdeState -> ExternsFile -> STM ()

122−insertModuleSTM st ef = modifyTVar st (insertModule' ef)

79+-- | STM version of insertModuleOld

80+insertModuleOldSTM :: TVar PscIdeState -> ExternsFile -> STM ()

81+insertModuleOldSTM st ef = modifyTVar st (insertModule' ef)

12382

124−-- | Pure version of insertModule

83+-- | Pure version of insertModuleOld

12584insertModule' :: ExternsFile -> PscIdeState -> PscIdeState

12685insertModule' ef state =

12786 state

128− { pscIdeStateExternsFiles =

129− M.insert (efModuleName ef) ef (pscIdeStateExternsFiles state)

130− , pscIdeStateModules = let (mn, decls) = convertExterns ef

87+ { pscIdeStateModules = let (mn, decls) = convertExterns ef

13188 in M.insert mn decls (pscIdeStateModules state)

13289 }

13390

91+-- | Insert a Module into Stage1 of the State

92+insertModule :: Ide m => (FilePath, P.Module) -> m ()

93+insertModule module' = do

94+ stateVar <- ideStateVar <$> ask

95+ liftIO . atomically $ insertModuleSTM stateVar module'

96+

97+-- | STM version of insertModule

98+insertModuleSTM :: TVar IdeState -> (FilePath, P.Module) -> STM ()

99+insertModuleSTM ref (fp, module') =

100+ modifyTVar ref $ \x ->

101+ x { ideStage1 = (ideStage1 x) {

102+ s1Modules = M.insert

103+ (P.getModuleName module')

104+ (module', fp)

105+ (s1Modules (ideStage1 x))}}

106+

107+-- | Retrieves Stage1 from the State.

108+-- This includes loaded Externfiles

109+-- (TODO: as soon as we actually parse the modules) aswell as the parsed modules

110+getStage1 :: Ide m => m Stage1

111+getStage1 = do

112+ st <- ideStateVar <$> ask

113+ fmap ideStage1 . liftIO . readTVarIO $ st

114+

115+-- | STM version of getStage1

116+getStage1STM :: TVar IdeState -> STM Stage1

117+getStage1STM ref = ideStage1 <$> readTVar ref

118+

119+-- | Sets Stage1 inside the compiler

120+setStage1 :: Ide m => Stage1 -> m ()

121+setStage1 s1 = do

122+ st <- ideStateVar <$> ask

123+ liftIO . atomically . modifyTVar st $ \x ->

124+ x {ideStage1 = s1}

125+ pure ()

126+

127+-- TODO: Soon to be Stage3

128+-- | Retrieves Stage2 from the State.

129+-- This includes the denormalized Declarations and cached rebuilds

130+getStage2 :: Ide m => m Stage2

131+getStage2 = do

132+ st <- ideStateVar <$> ask

133+ fmap ideStage2 . liftIO . readTVarIO $ st

134+

135+-- | Sets Stage2 inside the compiler

136+setStage2 :: Ide m => Stage2 -> m ()

137+setStage2 s2 = do

138+ st <- ideStateVar <$> ask

139+ liftIO . atomically $ setStage2STM st s2

140+

141+-- | STM version of setStage2

142+setStage2STM :: TVar IdeState -> Stage2 -> STM ()

143+setStage2STM ref s2 = do

144+ modifyTVar ref $ \x ->

145+ x {ideStage2 = s2}

146+ pure ()

147+

148+-- | Checks if the given ModuleName matches the last rebuild cache and if it

149+-- does returns all loaded definitions + the definitions inside the rebuild

150+-- cache

151+getAllModules2 :: Ide m => Maybe P.ModuleName -> m [(P.ModuleName, [IdeDeclaration])]

152+getAllModules2 mmoduleName = do

153+ declarations <- s2Declarations <$> getStage2

154+ rebuild <- cachedRebuild

155+ case mmoduleName of

156+ Nothing -> pure (M.toList declarations)

157+ Just moduleName ->

158+ case rebuild of

159+ Just (cachedModulename, ef)

160+ | cachedModulename == moduleName ->

161+ pure . M.toList $

162+ M.insert moduleName (snd . convertModule . convertExterns $ ef) declarations

163+ _ -> pure (M.toList declarations)

164+

165+-- | Adds an ExternsFile into psc-ide's State Stage1. This does not populate the

166+-- following Stages, which needs to be done after all the necessary Exterms have

167+-- been loaded.

168+insertExterns :: Ide m => ExternsFile -> m ()

169+insertExterns ef = do

170+ st <- ideStateVar <$> ask

171+ liftIO (atomically (insertExternsSTM st ef))

172+

173+-- | STM version of insertExterns

174+insertExternsSTM :: TVar IdeState -> ExternsFile -> STM ()

175+insertExternsSTM ref ef =

176+ modifyTVar ref $ \x ->

177+ x { ideStage1 = (ideStage1 x) {

178+ s1Externs = M.insert (efModuleName ef) ef (s1Externs (ideStage1 x))}}

179+

134180-- | Sets rebuild cache to the given ExternsFile

135−setCachedRebuild :: PscIde m => ExternsFile -> m ()

136−setCachedRebuild ef = do

137− st <- envStateVar <$> ask

181+cacheRebuild :: Ide m => ExternsFile -> m ()

182+cacheRebuild ef = do

183+ st <- ideStateVar <$> ask

138184 liftIO . atomically . modifyTVar st $ \x ->

139− x { pscIdeStateCachedRebuild = Just (efModuleName ef, ef) }

185+ x { ideStage2 = (ideStage2 x) {

186+ s2CachedRebuild = Just (efModuleName ef, ef)}}

140187

141188-- | Retrieves the rebuild cache

142−getCachedRebuild :: PscIde m => m (Maybe (P.ModuleName, ExternsFile))

143−getCachedRebuild = pscIdeStateCachedRebuild <$> getPscIdeState

189+cachedRebuild :: Ide m => m (Maybe (P.ModuleName, ExternsFile))

190+cachedRebuild = s2CachedRebuild <$> getStage2

191+

192+-- | Resolves reexports and populates Stage2 with data to be used in queries.

193+populateStage2 :: (Ide m, MonadLogger m) => m ()

194+populateStage2 = do

195+ st <- ideStateVar <$> ask

196+ duration <- liftIO $ do

197+ start <- getTime Monotonic

198+ atomically (populateStage2STM st)

199+ end <- getTime Monotonic

200+ pure (Prelude.show (diffTimeSpec start end))

201+ $(logDebug) $ "Finished populating Stage2 in " <> toS duration

202+

203+-- | STM version of populateStage2

204+populateStage2STM :: TVar IdeState -> STM ()

205+populateStage2STM ref = do

206+ externs <- s1Externs <$> getStage1STM ref

207+ -- Build the "old" ExternDecl format

208+ let modules = M.mapKeys runModuleNameT (M.map (snd . convertExterns) externs)

209+ -- Convert ExternDecl into IdeDeclaration

210+ declarations = resolveReexports2 modules <$> M.toList modules

211+ setStage2STM ref (Stage2 (M.fromList declarations) Nothing)

src/Language/PureScript/Ide/Types.hs+69−43

@@ -12,32 +12,23 @@

1212-- Type definitions for psc-ide

1313-----------------------------------------------------------------------------

1414

15−{-# LANGUAGE OverloadedStrings #-}

15+{-# LANGUAGE OverloadedStrings #-}

1616

1717module Language.PureScript.Ide.Types where

1818

19−import Prelude ()

20−import Prelude.Compat

19+import Protolude

2120

2221import Control.Concurrent.STM

23−import Control.Monad

24−import Control.Monad.Reader.Class

25−import Control.Monad.Trans

2622import Data.Aeson

2723import Data.Map.Lazy as M

28−import Data.Maybe (maybeToList)

29−import Data.Text (Text (), pack, unpack)

30−import qualified Language.PureScript.AST.Declarations as D

31−import Language.PureScript.Externs

3224import qualified Language.PureScript.Errors.JSON as P

33−import qualified Language.PureScript.Names as N

3425import qualified Language.PureScript as P

35−

36−import Text.Parsec

26+import Language.PureScript.Ide.Conversions

27+import System.FilePath

28+import Text.Parsec as Parsec

3729import Text.Parsec.Text

3830

3931type Ident = Text

40−type DeclIdent = Text

4132type ModuleIdent = Text

4233

4334data ExternDecl

@@ -53,10 +44,10 @@ data ExternDecl

5344 -- | A module declaration

5445 | ModuleDecl

5546 ModuleIdent -- The modules name

56− [DeclIdent] -- The exported identifiers

47+ [Ident] -- The exported identifiers

5748 -- | A data/newtype declaration

5849 | DataConstructor

59− DeclIdent -- The type name

50+ Ident -- The type name

6051 (P.ProperName 'P.TypeName)

6152 P.Type -- The "type"

6253 -- | An exported module

@@ -66,37 +57,72 @@ data ExternDecl

6657 | Export ModuleIdent -- The exported Modules name

6758 deriving (Show,Eq,Ord)

6859

69−type Module = (ModuleIdent, [ExternDecl])

60+data IdeDeclaration

61+ = IdeValue Ident P.Type

62+ | IdeType (P.ProperName 'P.TypeName) P.Kind

63+ | IdeTypeSynonym (P.ProperName 'P.TypeName) P.Type

64+ | IdeDataConstructor Ident (P.ProperName 'P.TypeName) P.Type

65+ | IdeTypeClass (P.ProperName 'P.ClassName)

66+ | IdeValueOperator (P.OpName 'P.ValueOpName) Ident P.Precedence P.Associativity

67+ | IdeTypeOperator (P.OpName 'P.TypeOpName) Ident P.Precedence P.Associativity

68+ deriving (Show, Eq, Ord)

69+

70+type Module = (P.ModuleName, [IdeDeclaration])

71+type ModuleOld = (Text, [ExternDecl])

7072

7173data Configuration =

7274 Configuration

7375 { confOutputPath :: FilePath

7476 , confDebug :: Bool

77+ , confGlobs :: [FilePath]

7578 }

7679

77−data PscIdeEnvironment =

78− PscIdeEnvironment

80+data IdeEnvironment =

81+ IdeEnvironment

7982 { envStateVar :: TVar PscIdeState

80− , envConfiguration :: Configuration

83+ , ideStateVar :: TVar IdeState

84+ , ideConfiguration :: Configuration

8185 }

8286

83−type PscIde m = (MonadIO m, MonadReader PscIdeEnvironment m)

87+type Ide m = (MonadIO m, MonadReader IdeEnvironment m)

8488

8589data PscIdeState =

8690 PscIdeState

8791 { pscIdeStateModules :: M.Map Text [ExternDecl]

88− , pscIdeStateExternsFiles :: M.Map P.ModuleName ExternsFile

89− , pscIdeStateCachedRebuild :: Maybe (P.ModuleName, ExternsFile)

9092 } deriving Show

9193

9294emptyPscIdeState :: PscIdeState

93−emptyPscIdeState = PscIdeState M.empty M.empty Nothing

95+emptyPscIdeState = PscIdeState M.empty

96+

97+data IdeState = IdeState

98+ { ideStage1 :: Stage1

99+ , ideStage2 :: Stage2

100+ }

101+

102+emptyIdeState :: IdeState

103+emptyIdeState = IdeState emptyStage1 emptyStage2

104+

105+emptyStage1 :: Stage1

106+emptyStage1 = Stage1 M.empty M.empty

107+

108+emptyStage2 :: Stage2

109+emptyStage2 = Stage2 M.empty Nothing

110+

111+data Stage1 = Stage1

112+ { s1Externs :: M.Map P.ModuleName P.ExternsFile

113+ , s1Modules :: M.Map P.ModuleName (P.Module, FilePath)

114+ }

115+

116+data Stage2 = Stage2

117+ { s2Declarations :: M.Map P.ModuleName [IdeDeclaration]

118+ , s2CachedRebuild :: Maybe (P.ModuleName, P.ExternsFile)

119+ }

94120

95−data Match = Match ModuleIdent ExternDecl

96− deriving (Show, Eq)

121+data Match = Match P.ModuleName IdeDeclaration

122+ deriving (Show, Eq)

97123

98124newtype Completion =

99− Completion (ModuleIdent, DeclIdent, Text)

125+ Completion (ModuleIdent, Ident, Text)

100126 deriving (Show,Eq)

101127

102128instance ToJSON Completion where

@@ -106,7 +132,7 @@ instance ToJSON Completion where

106132data ModuleImport =

107133 ModuleImport

108134 { importModuleName :: ModuleIdent

109− , importType :: D.ImportDeclarationType

135+ , importType :: P.ImportDeclarationType

110136 , importQualifier :: Maybe Text

111137 } deriving(Show)

112138

@@ -116,25 +142,25 @@ instance Eq ModuleImport where

116142 && importQualifier mi1 == importQualifier mi2

117143

118144instance ToJSON ModuleImport where

119− toJSON (ModuleImport mn D.Implicit qualifier) =

145+ toJSON (ModuleImport mn P.Implicit qualifier) =

120146 object $ [ "module" .= mn

121147 , "importType" .= ("implicit" :: Text)

122148 ] ++ fmap (\x -> "qualifier" .= x) (maybeToList qualifier)

123− toJSON (ModuleImport mn (D.Explicit refs) _) =

149+ toJSON (ModuleImport mn (P.Explicit refs) _) =

124150 object [ "module" .= mn

125151 , "importType" .= ("explicit" :: Text)

126152 , "identifiers" .= (identifierFromDeclarationRef <$> refs)

127153 ]

128− toJSON (ModuleImport mn (D.Hiding refs) _) =

154+ toJSON (ModuleImport mn (P.Hiding refs) _) =

129155 object [ "module" .= mn

130156 , "importType" .= ("hiding" :: Text)

131157 , "identifiers" .= (identifierFromDeclarationRef <$> refs)

132158 ]

133159

134−identifierFromDeclarationRef :: D.DeclarationRef -> String

135−identifierFromDeclarationRef (D.TypeRef name _) = N.runProperName name

136−identifierFromDeclarationRef (D.ValueRef ident) = N.runIdent ident

137−identifierFromDeclarationRef (D.TypeClassRef name) = N.runProperName name

160+identifierFromDeclarationRef :: P.DeclarationRef -> Text

161+identifierFromDeclarationRef (P.TypeRef name _) = runProperNameT name

162+identifierFromDeclarationRef (P.ValueRef ident) = runIdentT ident

163+identifierFromDeclarationRef (P.TypeClassRef name) = runProperNameT name

138164identifierFromDeclarationRef _ = ""

139165

140166data Success =

@@ -182,14 +208,14 @@ data PursuitResponse =

182208 ModuleResponse ModuleIdent Text

183209 -- | A Pursuit Response for a declaration. Consist of the declarations type,

184210 -- module, name and package

185− | DeclarationResponse Text ModuleIdent DeclIdent Text

211+ | DeclarationResponse Text ModuleIdent Ident Text

186212 deriving (Show,Eq)

187213

188214instance FromJSON PursuitResponse where

189215 parseJSON (Object o) = do

190216 package <- o .: "package"

191217 info <- o .: "info"

192− (type' :: String) <- info .: "type"

218+ (type' :: Text) <- info .: "type"

193219 case type' of

194220 "module" -> do

195221 name <- info .: "module"

@@ -204,26 +230,26 @@ instance FromJSON PursuitResponse where

204230

205231typeParse :: Text -> Either Text (Text, Text)

206232typeParse t = case parse parseType "" t of

207− Right (x,y) -> Right (pack x, pack y)

208− Left err -> Left (pack (show err))

233+ Right (x,y) -> Right (x, y)

234+ Left err -> Left (show err)

209235 where

210− parseType :: Parser (String, String)

236+ parseType :: Parser (Text, Text)

211237 parseType = do

212238 name <- identifier

213239 _ <- string "::"

214240 spaces

215241 type' <- many1 anyChar

216− pure (unpack name, type')

242+ pure (name, toS type')

217243

218244 identifier :: Parser Text

219245 identifier = do

220246 spaces

221247 ident <-

222248 -- necessary for being able to parse the following ((++), concat)

223− between (char '(') (char ')') (many1 (noneOf ", )")) <|>

249+ between (char '(') (char ')') (many1 (noneOf ", )")) Parsec.<|>

224250 many1 (noneOf ", )")

225251 spaces

226− pure (pack ident)

252+ pure (toS ident)

227253

228254instance ToJSON PursuitResponse where

229255 toJSON (ModuleResponse name package) =

src/Language/PureScript/Ide/Util.hs+34−48

@@ -9,75 +9,61 @@

99-- Stability : experimental

1010--

1111-- |

12−-- Generally useful functions and conversions

12+-- Generally useful functions

1313-----------------------------------------------------------------------------

1414

1515{-# LANGUAGE OverloadedStrings #-}

1616

17−module Language.PureScript.Ide.Util where

17+module Language.PureScript.Ide.Util

18+ ( identifierFromIdeDeclaration

19+ , identifierFromMatch

20+ , completionFromMatch

21+ , encodeT

22+ , decodeT

23+ , module Language.PureScript.Ide.Conversions

24+ ) where

1825

19−import Prelude.Compat

26+import Protolude

2027import Data.Aeson

21−import Data.Text (Text)

2228import qualified Data.Text as T

23−import Data.Text.Lazy (fromStrict, toStrict)

2429import Data.Text.Lazy.Encoding (decodeUtf8, encodeUtf8)

2530import qualified Language.PureScript as P

2631import Language.PureScript.Ide.Types

32+import Language.PureScript.Ide.Conversions

2733

28−runProperNameT :: P.ProperName a -> Text

29−runProperNameT = T.pack . P.runProperName

30−

31−runIdentT :: P.Ident -> Text

32−runIdentT = T.pack . P.runIdent

33−

34−runOpNameT :: P.OpName a -> Text

35−runOpNameT = T.pack . P.runOpName

36−

37−runModuleNameT :: P.ModuleName -> Text

38−runModuleNameT = T.pack . P.runModuleName

39−

40−prettyTypeT :: P.Type -> Text

41−prettyTypeT = T.unwords . fmap T.strip . T.lines . T.pack . P.prettyPrintType

42−

43−identifierFromExternDecl :: ExternDecl -> Text

44−identifierFromExternDecl (ValueDeclaration name _) = name

45−identifierFromExternDecl (TypeDeclaration name _) = runProperNameT name

46−identifierFromExternDecl (TypeSynonymDeclaration name _) = runProperNameT name

47−identifierFromExternDecl (DataConstructor name _ _) = name

48−identifierFromExternDecl (TypeClassDeclaration name) = runProperNameT name

49−identifierFromExternDecl (ModuleDecl name _) = name

50−identifierFromExternDecl (ValueOperator op _ _ _) = runOpNameT op

51−identifierFromExternDecl (TypeOperator op _ _ _) = runOpNameT op

52−identifierFromExternDecl Dependency{} = "~Dependency~"

53−identifierFromExternDecl Export{} = "~Export~"

34+identifierFromIdeDeclaration :: IdeDeclaration -> Text

35+identifierFromIdeDeclaration d = case d of

36+ IdeValue name _ -> name

37+ IdeType name _ -> runProperNameT name

38+ IdeTypeSynonym name _ -> runProperNameT name

39+ IdeDataConstructor name _ _ -> name

40+ IdeTypeClass name -> runProperNameT name

41+ IdeValueOperator op _ _ _ -> runOpNameT op

42+ IdeTypeOperator op _ _ _ -> runOpNameT op

5443

5544identifierFromMatch :: Match -> Text

56−identifierFromMatch (Match _ ed) = identifierFromExternDecl ed

45+identifierFromMatch (Match _ ed) = identifierFromIdeDeclaration ed

5746

58−completionFromMatch :: Match -> Maybe Completion

59−completionFromMatch (Match m d) = case d of

60− ValueDeclaration name type' -> Just $ Completion (m, name, prettyTypeT type')

61− TypeDeclaration name kind -> Just $ Completion (m, runProperNameT name, T.pack $ P.prettyPrintKind kind)

62− TypeSynonymDeclaration name kind -> Just $ Completion (m, runProperNameT name, prettyTypeT kind)

63− DataConstructor name _ type' -> Just $ Completion (m, name, prettyTypeT type')

64− TypeClassDeclaration name -> Just $ Completion (m, runProperNameT name, "class")

65− ModuleDecl name _ -> Just $ Completion ("module", name, "module")

66− ValueOperator op ref precedence associativity -> Just $ Completion (m, runOpNameT op, showFixity precedence associativity ref op)

67− TypeOperator op ref precedence associativity -> Just $ Completion (m, runOpNameT op, showFixity precedence associativity ref op)

68− Dependency{} -> Nothing

69− Export{} -> Nothing

47+completionFromMatch :: Match -> Completion

48+completionFromMatch (Match m' d) = case d of

49+ IdeValue name type' -> Completion (m, name, prettyTypeT type')

50+ IdeType name kind -> Completion (m, runProperNameT name, toS (P.prettyPrintKind kind))

51+ IdeTypeSynonym name kind -> Completion (m, runProperNameT name, prettyTypeT kind)

52+ IdeDataConstructor name _ type' -> Completion (m, name, prettyTypeT type')

53+ IdeTypeClass name -> Completion (m, runProperNameT name, "class")

54+ IdeValueOperator op ref precedence associativity -> Completion (m, runOpNameT op, showFixity precedence associativity ref op)

55+ IdeTypeOperator op ref precedence associativity -> Completion (m, runOpNameT op, showFixity precedence associativity ref op)

7056 where

57+ m = runModuleNameT m'

7158 showFixity p a r o =

7259 let asso = case a of

7360 P.Infix -> "infix"

7461 P.Infixl -> "infixl"

7562 P.Infixr -> "infixr"

76− in T.unwords [asso, T.pack (show p), r, "as", runOpNameT o]

77−

63+ in T.unwords [asso, show p, r, "as", runOpNameT o]

7864

7965encodeT :: (ToJSON a) => a -> Text

80−encodeT = toStrict . decodeUtf8 . encode

66+encodeT = toS . decodeUtf8 . encode

8167

8268decodeT :: (FromJSON a) => Text -> Maybe a

83−decodeT = decode . encodeUtf8 . fromStrict

69+decodeT = decode . encodeUtf8 . toS

src/Language/PureScript/Ide/Watcher.hs+6−8

@@ -14,33 +14,31 @@

1414

1515module Language.PureScript.Ide.Watcher where

1616

17−import Control.Concurrent (threadDelay)

17+import Protolude

18+

1819import Control.Concurrent.STM

19−import Control.Monad

20−import Control.Monad.Trans.Except

2120import Language.PureScript.Ide.Externs

2221import Language.PureScript.Ide.State

2322import Language.PureScript.Ide.Types

24−import Prelude

2523import System.FilePath

2624import System.FSNotify

2725

2826-- | Reloads an ExternsFile from Disc. If the Event indicates the ExternsFile

2927-- was deleted we don't do anything.

30−reloadFile :: TVar PscIdeState -> Event -> IO ()

28+reloadFile :: TVar IdeState -> Event -> IO ()

3129reloadFile _ Removed{} = pure ()

32−reloadFile stateVar ev = do

30+reloadFile ref ev = do

3331 let fp = eventPath ev

3432 ef' <- runExceptT (readExternFile fp)

3533 case ef' of

3634 Left _ -> pure ()

3735 Right ef -> do

38− atomically (insertModuleSTM stateVar ef)

36+ atomically (insertExternsSTM ref ef *> populateStage2STM ref)

3937 putStrLn ("Reloaded File at: " ++ fp)

4038

4139-- | Installs filewatchers for the given directory and reloads ExternsFiles when

4240-- they change on disc

43−watcher :: TVar PscIdeState -> FilePath -> IO ()

41+watcher :: TVar IdeState -> FilePath -> IO ()

4442watcher stateVar fp =

4543 withManagerConf (defaultConfig { confDebounce = NoDebounce }) $ \mgr -> do

4644 _ <- watchTree mgr fp

src/Language/PureScript/Publish.hs+1

@@ -21,6 +21,7 @@ module Language.PureScript.Publish

2121 , getResolvedDependencies

2222 ) where

2323

24+import Prelude ()

2425import Prelude.Compat hiding (userError)

2526

2627import Control.Arrow ((***))

tests/Language/PureScript/Ide/FilterSpec.hs+18−29

@@ -1,32 +1,31 @@

11{-# LANGUAGE OverloadedStrings #-}

2+{-# LANGUAGE NoImplicitPrelude #-}

23module Language.PureScript.Ide.FilterSpec where

34

4−import Data.Text (Text)

5+import Protolude

56import Language.PureScript.Ide.Filter

67import Language.PureScript.Ide.Types

78import qualified Language.PureScript as P

89import Test.Hspec

910

10−value :: Text -> ExternDecl

11−value s = ValueDeclaration s $ P.TypeWildcard $ P.SourceSpan "" (P.SourcePos 0 0) (P.SourcePos 0 0)

11+value :: Text -> IdeDeclaration

12+value s = IdeValue s $ P.TypeWildcard $ P.SourceSpan "" (P.SourcePos 0 0) (P.SourcePos 0 0)

13+

14+moduleA, moduleB :: Module

15+moduleA = (P.moduleNameFromString "Module.A", [value "function1"])

16+moduleB = (P.moduleNameFromString "Module.B", [value "data1"])

1217

1318modules :: [Module]

14−modules =

15− [

16− ("Module.A", [value "function1"]),

17− ("Module.B", [value "data1"]),

18− ("Module.C", [ModuleDecl "Module.C" []]),

19− ("Module.D", [Dependency "Module.C" [] Nothing, value "asd"])

20− ]

19+modules = [moduleA, moduleB]

2120

2221runEq :: Text -> [Module]

2322runEq s = runFilter (equalityFilter s) modules

23+

2424runPrefix :: Text -> [Module]

2525runPrefix s = runFilter (prefixFilter s) modules

26−runModule :: [ModuleIdent] -> [Module]

26+

27+runModule :: [P.ModuleName] -> [Module]

2728runModule ms = runFilter (moduleFilter ms) modules

28−runDependency :: [ModuleIdent] -> [Module]

29−runDependency ms = runFilter (dependencyFilter ms) modules

3029

3130spec :: Spec

3231spec = do

@@ -34,30 +33,20 @@ spec = do

3433 it "removes empty modules" $

3534 runEq "test" `shouldBe` []

3635 it "keeps function declarations that are equal" $

37− runEq "function1" `shouldBe` [head modules]

38− -- TODO: It would be more sensible to match Constructors

36+ runEq "function1" `shouldBe` [moduleA]

3937 it "keeps data declarations that are equal" $

40− runEq "data1" `shouldBe` [modules !! 1]

38+ runEq "data1" `shouldBe` [moduleB]

4139 describe "prefixFilter" $ do

4240 it "keeps everything on empty string" $

4341 runPrefix "" `shouldBe` modules

4442 it "keeps functionname prefix matches" $

45− runPrefix "fun" `shouldBe` [head modules]

43+ runPrefix "fun" `shouldBe` [moduleA]

4644 it "keeps data decls prefix matches" $

47− runPrefix "dat" `shouldBe` [modules !! 1]

48− it "keeps module decl prefix matches" $

49− runPrefix "Mod" `shouldBe` [modules !! 2]

45+ runPrefix "dat" `shouldBe` [moduleB]

5046 describe "moduleFilter" $ do

5147 it "removes everything on empty input" $

5248 runModule [] `shouldBe` []

5349 it "only keeps the specified modules" $

54− runModule ["Module.A", "Module.C"] `shouldBe` [head modules, modules !! 2]

50+ runModule [P.moduleNameFromString "Module.A"] `shouldBe` [moduleA]

5551 it "ignores modules that are not in scope" $

56− runModule ["Module.A", "Module.C", "Unknown"] `shouldBe` [head modules, modules !! 2]

57− describe "dependencyFilter" $ do

58− it "removes everything on empty input" $

59− runDependency [] `shouldBe` []

60− it "only keeps the specified modules if they have no imports" $

61− runDependency ["Module.A", "Module.B"] `shouldBe` [head modules, modules !! 1]

62− it "keeps the specified modules and their imports" $

63− runDependency ["Module.A", "Module.D"] `shouldBe` [head modules, modules !! 2, modules !! 3]

52+ runModule (P.moduleNameFromString <$> ["Module.A", "Unknown"]) `shouldBe` [moduleA]

tests/Language/PureScript/Ide/Imports/IntegrationSpec.hs+14−25

@@ -1,8 +1,10 @@

11{-# LANGUAGE OverloadedStrings #-}

2+{-# LANGUAGE NoImplicitPrelude #-}

23module Language.PureScript.Ide.Imports.IntegrationSpec where

34

4−import Control.Monad (void)

5−import Data.Text (Text)

5+

6+import Protolude

7+

68import qualified Data.Text as T

79import qualified Data.Text.IO as TIO

810import qualified Language.PureScript.Ide.Integration as Integration

@@ -12,9 +14,7 @@ import System.Directory

1214import System.FilePath

1315

1416setup :: IO ()

15−setup = do

16− Integration.reset

17− mapM_ Integration.loadModuleWithDeps ["ImportsSpec", "ImportsSpec1"]

17+setup = void (Integration.reset *> Integration.loadAll)

1818

1919withSupportFiles :: (FilePath -> FilePath -> IO a) -> IO ()

2020withSupportFiles test = do

@@ -35,52 +35,41 @@ spec = beforeAll_ setup . describe "Adding imports" $ do

3535 let

3636 sourceFileSkeleton :: [Text] -> [Text]

3737 sourceFileSkeleton importSection =

38− [ "module ImportsSpec where" , ""] ++ importSection ++ [ "" , "myId = id"]

38+ [ "module ImportsSpec where" , ""] ++ importSection ++ [ "" , "myId x = x"]

3939 it "adds an implicit import" $ do

4040 withSupportFiles (Integration.addImplicitImport "ImportsSpec1")

4141 outputFileShouldBe (sourceFileSkeleton

4242 [ "import ImportsSpec1"

43− , "import Main (id)"

4443 ])

4544 it "adds an explicit unqualified import" $ do

4645 withSupportFiles (Integration.addImport "exportedFunction")

4746 outputFileShouldBe (sourceFileSkeleton

4847 [ "import ImportsSpec1 (exportedFunction)"

49− , "import Main (id)"

5048 ])

5149 it "adds an explicit unqualified import (type)" $ do

5250 withSupportFiles (Integration.addImport "MyType")

53− outputFileShouldBe (sourceFileSkeleton [ "import ImportsSpec1 (MyType)"

54− , "import Main (id)"

55− ])

51+ outputFileShouldBe (sourceFileSkeleton ["import ImportsSpec1 (MyType)"])

5652 it "adds an explicit unqualified import (parameterized type)" $ do

5753 withSupportFiles (Integration.addImport "MyParamType")

58− outputFileShouldBe (sourceFileSkeleton [ "import ImportsSpec1 (MyParamType)"

59− , "import Main (id)"

60− ])

54+ outputFileShouldBe (sourceFileSkeleton ["import ImportsSpec1 (MyParamType)"])

6155 it "adds an explicit unqualified import (typeclass)" $ do

6256 withSupportFiles (Integration.addImport "ATypeClass")

63− outputFileShouldBe (sourceFileSkeleton [ "import ImportsSpec1 (class ATypeClass)"

64− , "import Main (id)"])

57+ outputFileShouldBe (sourceFileSkeleton ["import ImportsSpec1 (class ATypeClass)"])

6558 it "adds an explicit unqualified import (dataconstructor)" $ do

6659 withSupportFiles (Integration.addImport "MyJust")

67− outputFileShouldBe (sourceFileSkeleton [ "import ImportsSpec1 (MyMaybe(MyJust))"

68− , "import Main (id)"])

60+ outputFileShouldBe (sourceFileSkeleton ["import ImportsSpec1 (MyMaybe(MyJust))"])

6961 it "adds an explicit unqualified import (newtype)" $ do

7062 withSupportFiles (Integration.addImport "MyNewtype")

71− outputFileShouldBe (sourceFileSkeleton [ "import ImportsSpec1 (MyNewtype(MyNewtype))"

72− , "import Main (id)"])

63+ outputFileShouldBe (sourceFileSkeleton ["import ImportsSpec1 (MyNewtype(MyNewtype))"])

7364 it "adds an explicit unqualified import (typeclass member function)" $ do

7465 withSupportFiles (Integration.addImport "typeClassFun")

75− outputFileShouldBe (sourceFileSkeleton [ "import ImportsSpec1 (typeClassFun)"

76− , "import Main (id)"])

66+ outputFileShouldBe (sourceFileSkeleton ["import ImportsSpec1 (typeClassFun)"])

7767 it "doesn't add a newtypes constructor if only the type is exported" $ do

7868 withSupportFiles (Integration.addImport "OnlyTypeExported")

79− outputFileShouldBe (sourceFileSkeleton [ "import ImportsSpec1 (OnlyTypeExported)"

80− , "import Main (id)"])

69+ outputFileShouldBe (sourceFileSkeleton ["import ImportsSpec1 (OnlyTypeExported)"])

8170 it "doesn't add an import if the identifier is defined in the module itself" $ do

8271 withSupportFiles (Integration.addImport "myId")

83− outputFileShouldBe (sourceFileSkeleton [ "import Main (id)"])

72+ outputFileShouldBe (sourceFileSkeleton [])

8473 it "responds with an error if it's undecidable whether we want a type or constructor" $

8574 withSupportFiles (\sourceFp outFp -> do

8675 r <- Integration.addImport "SpecialCase" sourceFp outFp

tests/Language/PureScript/Ide/ImportsSpec.hs+9−9

@@ -1,8 +1,10 @@

11{-# LANGUAGE OverloadedStrings #-}

2+{-# LANGUAGE NoImplicitPrelude #-}

23module Language.PureScript.Ide.ImportsSpec where

34

4−import Data.Maybe (fromJust)

5−import Data.Text (Text)

5+import Protolude

6+import Unsafe (fromJust)

7+

68import qualified Language.PureScript as P

79import Language.PureScript.Ide.Imports

810import Language.PureScript.Ide.Types

@@ -17,11 +19,9 @@ simpleFile =

1719 ]

1820

1921splitSimpleFile :: (P.ModuleName, [Text], [Import], [Text])

20−splitSimpleFile = fromRight $ sliceImportSection simpleFile

22+splitSimpleFile = fromRight (sliceImportSection simpleFile)

2123 where

22− fromRight (Right r) = r

23− fromRight (Left _) = error "fromRight"

24−

24+ fromRight = fromJust . rightToMaybe

2525withImports :: [Text] -> [Text]

2626withImports is =

2727 take 2 simpleFile ++ is ++ drop 2 simpleFile

@@ -68,11 +68,11 @@ spec = do

6868 describe "import commands" $ do

6969 let simpleFileImports = let (_, _, i, _) = splitSimpleFile in i

7070 addValueImport i mn is =

71− prettyPrintImportSection (addExplicitImport' (ValueDeclaration i wildcard) mn is)

71+ prettyPrintImportSection (addExplicitImport' (IdeValue i wildcard) mn is)

7272 addOpImport op mn is =

73− prettyPrintImportSection (addExplicitImport' (ValueOperator op "" 2 P.Infix) mn is)

73+ prettyPrintImportSection (addExplicitImport' (IdeValueOperator op "" 2 P.Infix) mn is)

7474 addDtorImport i t mn is =

75− prettyPrintImportSection (addExplicitImport' (DataConstructor i t wildcard) mn is)

75+ prettyPrintImportSection (addExplicitImport' (IdeDataConstructor i t wildcard) mn is)

7676 it "adds an implicit unqualified import" $

7777 shouldBe

7878 (addImplicitImport' simpleFileImports (P.moduleNameFromString "Data.Map"))

tests/Language/PureScript/Ide/Integration.hs+60−75

@@ -14,6 +14,7 @@

1414

1515{-# LANGUAGE OverloadedStrings #-}

1616{-# LANGUAGE ScopedTypeVariables #-}

17+{-# LANGUAGE NoImplicitPrelude #-}

1718module Language.PureScript.Ide.Integration

1819 (

1920 -- managing the server process

@@ -29,8 +30,9 @@ module Language.PureScript.Ide.Integration

2930 -- sending commands

3031 , addImport

3132 , addImplicitImport

33+ , loadAll

3234 , loadModule

33− , loadModuleWithDeps

35+ , loadModules

3436 , getCwd

3537 , getFlexCompletions

3638 , getFlexCompletionsInModule

@@ -43,19 +45,15 @@ module Language.PureScript.Ide.Integration

4345 , parseTextResult

4446 ) where

4547

46−import Control.Concurrent (threadDelay)

47−import Control.Exception

48−import Control.Monad (join, when)

48+import Protolude

49+import Unsafe (fromJust)

50+

4951import Data.Aeson

5052import Data.Aeson.Types

51−import qualified Data.ByteString.Lazy.UTF8 as BSL

52−import Data.Either (isRight)

53−import Data.Maybe (fromJust, isNothing, fromMaybe)

5453import qualified Data.Text as T

5554import qualified Data.Vector as V

5655import Language.PureScript.Ide.Util

5756import System.Directory

58−import System.Exit

5957import System.FilePath

6058import System.IO.Error (mkIOError, userErrorType)

6159import System.Process

@@ -80,26 +78,23 @@ stopServer = terminateProcess

8078withServer :: IO a -> IO a

8179withServer s = do

8280 _ <- startServer

83− started <- tryNTimes 5 (shush <$> (try getCwd :: IO (Either SomeException String)))

81+ started <- tryNTimes 5 (rightToMaybe <$> (try getCwd :: IO (Either SomeException Text)))

8482 when (isNothing started) $

8583 throwIO (mkIOError userErrorType "psc-ide-server didn't start in time" Nothing Nothing)

8684 r <- s

8785 quitServer

8886 pure r

8987

90−shush :: Either a b -> Maybe b

91−shush = either (const Nothing) Just

92−

9388-- project management utils

9489

9590compileTestProject :: IO Bool

9691compileTestProject = do

9792 pdir <- projectDirectory

9893 (_, _, _, procHandle) <- createProcess $

99− (shell $ "psc " ++ fileGlob) { cwd = Just pdir

100− , std_out = CreatePipe

101− , std_err = CreatePipe

102− }

94+ (shell . toS $ "psc " <> fileGlob) { cwd = Just pdir

95+ , std_out = CreatePipe

96+ , std_err = CreatePipe

97+ }

10398 r <- tryNTimes 5 (getProcessExitCode procHandle)

10499 pure (fromMaybe False (isSuccess <$> r))

105100

@@ -121,24 +116,17 @@ deleteOutputFolder = do

121116deleteFileIfExists :: FilePath -> IO ()

122117deleteFileIfExists fp = whenM (doesFileExist fp) (removeFile fp)

123118

124−whenM :: Monad m => m Bool -> m () -> m ()

125−whenM p f = do

126− x <- p

127− when x f

128−

129119isSuccess :: ExitCode -> Bool

130120isSuccess ExitSuccess = True

131121isSuccess (ExitFailure _) = False

132122

133−fileGlob :: String

134−fileGlob = unwords

135− [ "\"src/**/*.purs\""

136− ]

123+fileGlob :: Text

124+fileGlob = "\"src/**/*.purs\""

137125

138126-- Integration Testing API

139127

140−sendCommand :: Value -> IO String

141−sendCommand v = readCreateProcess

128+sendCommand :: Value -> IO Text

129+sendCommand v = toS <$> readCreateProcess

142130 ((shell "psc-ide-client") { std_out=CreatePipe

143131 , std_err=CreatePipe

144132 })

@@ -146,65 +134,68 @@ sendCommand v = readCreateProcess

146134

147135quitServer :: IO ()

148136quitServer = do

149− let quitCommand = object ["command" .= ("quit" :: String)]

150− _ <- try $ sendCommand quitCommand :: IO (Either SomeException String)

137+ let quitCommand = object ["command" .= ("quit" :: Text)]

138+ _ <- try $ sendCommand quitCommand :: IO (Either SomeException Text)

151139 return ()

152140

153141reset :: IO ()

154142reset = do

155− let resetCommand = object ["command" .= ("reset" :: String)]

156− _ <- try $ sendCommand resetCommand :: IO (Either SomeException String)

143+ let resetCommand = object ["command" .= ("reset" :: Text)]

144+ _ <- try $ sendCommand resetCommand :: IO (Either SomeException Text)

157145 return ()

158146

159−getCwd :: IO String

147+getCwd :: IO Text

160148getCwd = do

161− let cwdCommand = object ["command" .= ("cwd" :: String)]

149+ let cwdCommand = object ["command" .= ("cwd" :: Text)]

162150 sendCommand cwdCommand

163151

164−loadModuleWithDeps :: String -> IO String

165−loadModuleWithDeps m = sendCommand $ load [] [m]

152+loadModule :: Text -> IO Text

153+loadModule m = loadModules [m]

166154

167−loadModule :: String -> IO String

168−loadModule m = sendCommand $ load [m] []

155+loadModules :: [Text] -> IO Text

156+loadModules = sendCommand . load

169157

170−getFlexCompletions :: String -> IO [(String, String, String)]

158+loadAll :: IO Text

159+loadAll = sendCommand (load [])

160+

161+getFlexCompletions :: Text -> IO [(Text, Text, Text)]

171162getFlexCompletions q = parseCompletions <$> sendCommand (completion [] (Just (flexMatcher q)) Nothing)

172163

173−getFlexCompletionsInModule :: String -> String -> IO [(String, String, String)]

164+getFlexCompletionsInModule :: Text -> Text -> IO [(Text, Text, Text)]

174165getFlexCompletionsInModule q m = parseCompletions <$> sendCommand (completion [] (Just (flexMatcher q)) (Just m))

175166

176−getType :: String -> IO [(String, String, String)]

167+getType :: Text -> IO [(Text, Text, Text)]

177168getType q = parseCompletions <$> sendCommand (typeC q [])

178169

179−addImport :: String -> FilePath -> FilePath -> IO String

170+addImport :: Text -> FilePath -> FilePath -> IO Text

180171addImport identifier fp outfp = sendCommand (addImportC identifier fp outfp)

181172

182−addImplicitImport :: String -> FilePath -> FilePath -> IO String

173+addImplicitImport :: Text -> FilePath -> FilePath -> IO Text

183174addImplicitImport mn fp outfp = sendCommand (addImplicitImportC mn fp outfp)

184175

185−rebuildModule :: FilePath -> IO String

176+rebuildModule :: FilePath -> IO Text

186177rebuildModule m = sendCommand (rebuildC m Nothing)

187178

188179-- Command Encoding

189180

190−commandWrapper :: String -> Value -> Value

181+commandWrapper :: Text -> Value -> Value

191182commandWrapper c p = object ["command" .= c, "params" .= p]

192183

193−load :: [String] -> [String] -> Value

194−load ms ds = commandWrapper "load" (object ["modules" .= ms, "dependencies" .= ds])

184+load :: [Text] -> Value

185+load ms = commandWrapper "load" (object ["modules" .= ms])

195186

196−typeC :: String -> [Value] -> Value

187+typeC :: Text -> [Value] -> Value

197188typeC q filters = commandWrapper "type" (object ["search" .= q, "filters" .= filters])

198189

199−addImportC :: String -> FilePath -> FilePath -> Value

190+addImportC :: Text -> FilePath -> FilePath -> Value

200191addImportC identifier = addImportW $

201− object [ "importCommand" .= ("addImport" :: String)

192+ object [ "importCommand" .= ("addImport" :: Text)

202193 , "identifier" .= identifier

203194 ]

204195

205−addImplicitImportC :: String -> FilePath -> FilePath -> Value

196+addImplicitImportC :: Text -> FilePath -> FilePath -> Value

206197addImplicitImportC mn = addImportW $

207− object [ "importCommand" .= ("addImplicitImport" :: String)

198+ object [ "importCommand" .= ("addImplicitImport" :: Text)

208199 , "module" .= mn

209200 ]

210201

@@ -222,7 +213,7 @@ addImportW importCommand fp outfp =

222213 ])

223214

224215

225−completion :: [Value] -> Maybe Value -> Maybe String -> Value

216+completion :: [Value] -> Maybe Value -> Maybe Text -> Value

226217completion filters matcher currentModule =

227218 let

228219 matcher' = case matcher of

@@ -234,16 +225,16 @@ completion filters matcher currentModule =

234225 in

235226 commandWrapper "complete" (object $ "filters" .= filters : matcher' ++ currentModule' )

236227

237−flexMatcher :: String -> Value

238−flexMatcher q = object [ "matcher" .= ("flex" :: String)

228+flexMatcher :: Text -> Value

229+flexMatcher q = object [ "matcher" .= ("flex" :: Text)

239230 , "params" .= object ["search" .= q]

240231 ]

241232

242233-- Result parsing

243234

244−unwrapResult :: Value -> Parser (Either String Value)

235+unwrapResult :: Value -> Parser (Either Text Value)

245236unwrapResult = withObject "result" $ \o -> do

246− (rt :: String) <- o .: "resultType"

237+ (rt :: Text) <- o .: "resultType"

247238 case rt of

248239 "error" -> do

249240 res <- o .: "result"

@@ -251,16 +242,16 @@ unwrapResult = withObject "result" $ \o -> do

251242 "success" -> do

252243 res <- o .: "result"

253244 pure (Right res)

254− _ -> fail "lol"

245+ _ -> mzero

255246

256−withResult :: (Value -> Parser a) -> Value -> Parser (Either String a)

247+withResult :: (Value -> Parser a) -> Value -> Parser (Either Text a)

257248withResult p v = do

258249 r <- unwrapResult v

259250 case r of

260251 Left err -> pure (Left err)

261252 Right res -> Right <$> p res

262253

263−completionParser :: Value -> Parser [(String, String, String)]

254+completionParser :: Value -> Parser [(Text, Text, Text)]

264255completionParser = withArray "res" $ \cs ->

265256 mapM (withObject "completion" $ \o -> do

266257 ident <- o .: "identifier"

@@ -268,22 +259,16 @@ completionParser = withArray "res" $ \cs ->

268259 ty <- o .: "type"

269260 pure (module', ident, ty)) (V.toList cs)

270261

271−valueFromString :: String -> Value

272−valueFromString = fromJust . decode . BSL.fromString

262+valueFromText :: Text -> Value

263+valueFromText = fromJust . decode . toS

273264

274−resultIsSuccess :: String -> Bool

275−resultIsSuccess = isRight . join . parseEither unwrapResult . valueFromString

265+resultIsSuccess :: Text -> Bool

266+resultIsSuccess = isRight . join . first toS . parseEither unwrapResult . valueFromText

276267

277−parseCompletions :: String -> [(String, String, String)]

278−parseCompletions s = fromJust $ do

279− cs <- parseMaybe (withResult completionParser) (valueFromString s)

280− case cs of

281− Left _ -> error "Failed to parse completions"

282− Right cs' -> pure cs'

268+parseCompletions :: Text -> [(Text, Text, Text)]

269+parseCompletions s =

270+ fromJust $ join (rightToMaybe <$> parseMaybe (withResult completionParser) (valueFromText s))

283271

284−parseTextResult :: String -> String

285−parseTextResult s = fromJust $ do

286− r <- parseMaybe (withResult (withText "tr" pure)) (valueFromString s)

287− case r of

288− Left _ -> error "Failed to parse textResult"

289− Right r' -> pure (T.unpack r')

272+parseTextResult :: Text -> Text

273+parseTextResult s =

274+ fromJust $ join (rightToMaybe <$> parseMaybe (withResult (withText "tr" pure)) (valueFromText s))

tests/Language/PureScript/Ide/MatcherSpec.hs+15−16

@@ -1,33 +1,32 @@

11{-# LANGUAGE OverloadedStrings #-}

2+{-# LANGUAGE NoImplicitPrelude #-}

23

34module Language.PureScript.Ide.MatcherSpec where

45

5−import Control.Monad (void)

6−import Data.Text (Text)

6+import Protolude

7+

78import qualified Language.PureScript as P

89import Language.PureScript.Ide.Integration

910import Language.PureScript.Ide.Matcher

1011import Language.PureScript.Ide.Types

1112import Test.Hspec

1213

13−value :: Text -> ExternDecl

14−value s = ValueDeclaration s $ P.TypeWildcard $ P.SourceSpan "" (P.SourcePos 0 0) (P.SourcePos 0 0)

14+value :: Text -> IdeDeclaration

15+value s = IdeValue s $ P.TypeWildcard $ P.SourceSpan "" (P.SourcePos 0 0) (P.SourcePos 0 0)

1516

16−completions :: [Match]

17−completions =

18− [ Match "" (value "firstResult")

19− , Match "" (value "secondResult")

20− , Match "" (value "fiult")

21− ]

17+firstResult, secondResult, fiult :: Match

18+firstResult = Match (P.moduleNameFromString "Match") (value "firstResult")

19+secondResult = Match (P.moduleNameFromString "Match") (value "secondResult")

20+fiult = Match (P.moduleNameFromString "Match") (value "fiult")

2221

23−mkResult :: [Int] -> [Match]

24−mkResult = map (completions !!)

22+completions :: [Match]

23+completions = [firstResult, secondResult, fiult]

2524

2625runFlex :: Text -> [Match]

2726runFlex s = runMatcher (flexMatcher s) completions

2827

2928setup :: IO ()

30−setup = reset *> void (loadModuleWithDeps "Main")

29+setup = reset *> void loadAll

3130

3231spec :: Spec

3332spec = do

@@ -35,9 +34,9 @@ spec = do

3534 it "doesn't match on an empty string" $

3635 runFlex "" `shouldBe` []

3736 it "matches on equality" $

38− runFlex "firstResult" `shouldBe` mkResult [0]

37+ runFlex "firstResult" `shouldBe` [firstResult]

3938 it "scores short matches higher and sorts accordingly" $

40− runFlex "filt" `shouldBe` mkResult [2, 0]

39+ runFlex "filt" `shouldBe` [fiult, firstResult]

4140

4241 beforeAll_ setup . describe "Integration Tests: Flex Matcher" $ do

4342 it "doesn't match on an empty string" $ do

@@ -45,4 +44,4 @@ spec = do

4544 cs `shouldBe` []

4645 it "matches on equality" $ do

4746 cs <- getFlexCompletions "const"

48− cs `shouldBe` [("Main", "const", "forall a b. a -> b -> a")]

47+ cs `shouldBe` [("MatcherSpec", "const", "forall a b. a -> b -> a")]

tests/Language/PureScript/Ide/RebuildSpec.hs+10−6

@@ -1,19 +1,23 @@

1+{-# LANGUAGE NoImplicitPrelude #-}

2+{-# LANGUAGE OverloadedStrings #-}

13module Language.PureScript.Ide.RebuildSpec where

24

5+import Protolude

6+

37import qualified Language.PureScript.Ide.Integration as Integration

48import System.FilePath

59import Test.Hspec

610

7−shouldBeSuccess :: String -> IO ()

11+shouldBeSuccess :: Text -> IO ()

812shouldBeSuccess = shouldBe True . Integration.resultIsSuccess

913

10−shouldBeFailure :: String -> IO ()

14+shouldBeFailure :: Text -> IO ()

1115shouldBeFailure = shouldBe False . Integration.resultIsSuccess

1216

1317spec :: Spec

1418spec = before_ Integration.reset . describe "Rebuilding single modules" $ do

1519 it "rebuilds a correct module without dependencies successfully" $ do

16− _ <- Integration.loadModuleWithDeps "RebuildSpecSingleModule"

20+ _ <- Integration.loadModule "RebuildSpecSingleModule"

1721 pdir <- Integration.projectDirectory

1822 let file = pdir </> "src" </> "RebuildSpecSingleModule.purs"

1923 Integration.rebuildModule file >>= shouldBeSuccess

@@ -22,12 +26,12 @@ spec = before_ Integration.reset . describe "Rebuilding single modules" $ do

2226 let file = pdir </> "src" </> "RebuildSpecSingleModule.fail"

2327 Integration.rebuildModule file >>= shouldBeFailure

2428 it "rebuilds a correct module with its dependencies successfully" $ do

25− _ <- Integration.loadModuleWithDeps "RebuildSpecWithDeps"

29+ _ <- Integration.loadModules ["RebuildSpecWithDeps", "RebuildSpecDep"]

2630 pdir <- Integration.projectDirectory

2731 let file = pdir </> "src" </> "RebuildSpecWithDeps.purs"

2832 Integration.rebuildModule file >>= shouldBeSuccess

2933 it "rebuilds a correct module that has reverse dependencies" $ do

30− _ <- Integration.loadModuleWithDeps "RebuildSpecWithDeps"

34+ _ <- Integration.loadModule "RebuildSpecWithDeps"

3135 pdir <- Integration.projectDirectory

3236 let file = pdir </> "src" </> "RebuildSpecDep.purs"

3337 Integration.rebuildModule file >>= shouldBeSuccess

@@ -37,7 +41,7 @@ spec = before_ Integration.reset . describe "Rebuilding single modules" $ do

3741 let file = pdir </> "src" </> "RebuildSpecWithDeps.purs"

3842 Integration.rebuildModule file >>= shouldBeFailure

3943 it "rebuilds a correct module with a foreign file" $ do

40− _ <- Integration.loadModuleWithDeps "RebuildSpecWithForeign"

44+ _ <- Integration.loadModule "RebuildSpecWithForeign"

4145 pdir <- Integration.projectDirectory

4246 let file = pdir </> "src" </> "RebuildSpecWithForeign.purs"

4347 Integration.rebuildModule file >>= shouldBeSuccess

tests/Language/PureScript/Ide/ReexportsSpec.hs+11−13

@@ -1,8 +1,9 @@

11{-# LANGUAGE OverloadedStrings #-}

2+{-# LANGUAGE NoImplicitPrelude #-}

23module Language.PureScript.Ide.ReexportsSpec where

34

4−import Control.Exception (evaluate)

5−import Data.List (sort)

5+import Protolude

6+

67import qualified Data.Map as Map

78import Language.PureScript.Ide.Reexports

89import Language.PureScript.Ide.Types

@@ -23,28 +24,28 @@ dep1 = Dependency "Test.Foo" [] (Just "T")

2324dep2 :: ExternDecl

2425dep2 = Dependency "Test.Bar" [] (Just "T")

2526

26−circularModule :: Module

27+circularModule :: ModuleOld

2728circularModule = ("Circular", [Export "Circular"])

2829

29−module1 :: Module

30+module1 :: ModuleOld

3031module1 = ("Module1", [Export "Module2", Export "Module3", decl1])

3132

32−module2 :: Module

33+module2 :: ModuleOld

3334module2 = ("Module2", [decl2])

3435

35−module3 :: Module

36+module3 :: ModuleOld

3637module3 = ("Module3", [decl3])

3738

38−module4 :: Module

39+module4 :: ModuleOld

3940module4 = ("Module4", [Export "T", decl1, dep1, dep2])

4041

41−result :: Module

42+result :: ModuleOld

4243result = ("Module1", [decl1, decl2, Export "Module3"])

4344

44−db :: Map.Map ModuleIdent [ExternDecl]

45+db :: Map ModuleIdent [ExternDecl]

4546db = Map.fromList [module1, module2, module3]

4647

47−shouldBeEqualSorted :: Module -> Module -> Expectation

48+shouldBeEqualSorted :: ModuleOld -> ModuleOld -> Expectation

4849shouldBeEqualSorted (n1, d1) (n2, d2) = (n1, sort d1) `shouldBe` (n2, sort d2)

4950

5051spec :: Spec

@@ -64,9 +65,6 @@ spec =

6465 let replaced = replaceReexport (Export "Module2") module1 module2

6566 in replaceReexport (Export "Module2") replaced module2 `shouldBeEqualSorted` result

6667

67− it "should error when given a non-Export to replace" $

68− evaluate (replaceReexport decl1 module1 module2)

69− `shouldThrow` errorCall "Should only get Exports here."

7068 it "replaces all Exports with their corresponding declarations" $

7169 replaceReexports module1 db `shouldBe` ("Module1", [decl1, decl2, decl3])

7270

tests/Language/PureScript/IdeSpec.hsdeleted−35

@@ -1,35 +0,0 @@

1−{-# LANGUAGE OverloadedStrings #-}

2−

3−module Language.PureScript.IdeSpec where

4−

5−import Control.Concurrent.STM

6−import Control.Monad.Reader

7−import Data.List

8−import qualified Data.Map as Map

9−import Language.PureScript.Ide

10−import Language.PureScript.Ide.Types

11−import Test.Hspec

12−

13−testState :: PscIdeState

14−testState = PscIdeState (Map.fromList [("Data.Array", []), ("Control.Monad.Eff", [])]) Map.empty Nothing

15−

16−defaultConfig :: Configuration

17−defaultConfig =

18− Configuration

19− {

20− confOutputPath = "output/"

21− , confDebug = False

22− }

23−

24−spec :: SpecWith ()

25−spec =

26− describe "list" $

27− describe "loadedModules" $ do

28− it "returns an empty list when no modules are loaded" $ do

29− st <- newTVarIO emptyPscIdeState

30− result <- runReaderT printModules (PscIdeEnvironment st defaultConfig)

31− result `shouldBe` ModuleList []

32− it "returns the list of loaded modules" $ do

33− st <- newTVarIO testState

34− ModuleList result <- runReaderT printModules (PscIdeEnvironment st defaultConfig)

35− sort result `shouldBe` sort ["Data.Array", "Control.Monad.Eff"]

tests/support/pscide/src/ImportsSpec.purs+1−3

@@ -1,5 +1,3 @@

11module ImportsSpec where

22

3−import Main (id)

4−

5−myId = id

3+myId x = x

tests/support/pscide/src/Main.purs → tests/support/pscide/src/MatcherSpec.pursrenamed+1−1

@@ -1,4 +1,4 @@

1−module Main where

1+module MatcherSpec where

22

33id :: forall a. a -> a

44id x = x

tests/support/pscide/src/RebuildSpecSingleModule.purs+1−1

@@ -1,4 +1,4 @@

11module RebuildSpecSingleModule where

22

33id x = x

4−const x y = x

4+lulz x y = x