a88fa55 · rowtype-yoga/purescript-native

git.iko.soy/rowtype-yoga/purescript-native

Merge branch 'master' into pure11

commita88fa553bf1e5901ce95d143fd8a3b7ae9e7c832 authorAndy Arvanitis <andyarvanitis@gmail.com> dateWed 25 Jan 2017, 23:28 (10 years ago) parent7b0e991 220e6ae

34 files changed+1336−604

compare with golang

unifiedsplit

LICENSE+310

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

4848 bytestring-builder

4949 case-insensitive

5050 cereal

51+ cheapskate

5152 clock

5253 cmdargs

5354 comonad

@@ -58,7 +59,13 @@ PureScript uses the following Haskell library packages. Their license files foll

5859 contravariant

5960 cookie

6061 cryptonite

62+ css-text

63+ data-default

6164 data-default-class

65+ data-default-instances-base

66+ data-default-instances-containers

67+ data-default-instances-dlist

68+ data-default-instances-old-locale

6269 data-ordlist

6370 deepseq

6471 directory

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

142149 system-fileio

143150 system-filepath

144151 tagged

152+ tagsoup

145153 template-haskell

146154 temporary

147155 terminfo

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

152160 transformers-base

153161 transformers-compat

154162 turtle

163+ uniplate

155164 unix

156165 unix-compat

157166 unix-time

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

172181 x509-store

173182 x509-system

174183 x509-validation

184+ xss-sanitize

175185 zlib

176186

177187Glob LICENSE file:

@@ -1311,6 +1321,39 @@ cereal LICENSE file:

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

13121322 POSSIBILITY OF SUCH DAMAGE.

13131323

1324+cheapskate LICENSE file:

1325+

1327+

1329+

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

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

1332+

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

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

1335+

1336+ * Redistributions in binary form must reproduce the above

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

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

1339+ with the distribution.

1340+

1341+ * Neither the name of John MacFarlane nor the names of other

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

1343+ from this software without specific prior written permission.

1344+

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

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

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

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

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

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

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

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

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

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

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

1356+

13141357clock LICENSE file:

13151358

@@ -1606,6 +1649,63 @@ cryptonite LICENSE file:

16061649 OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF

16071650 SUCH DAMAGE.

16081651

1652+css-text LICENSE file:

1653+

1654+ The following license covers this documentation, and the source code, except

1655+ where otherwise indicated.

1656+

1658+

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

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

1661+

1662+ * Redistributions of source code must retain the above copyright notice, this

1663+ list of conditions and the following disclaimer.

1664+

1665+ * Redistributions in binary form must reproduce the above copyright notice,

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

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

1668+

1669+ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS "AS IS" AND ANY EXPRESS OR

1670+ IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF

1671+ MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO

1672+ EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY DIRECT, INDIRECT,

1673+ INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT

1674+ NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA,

1675+ OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF

1676+ LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE

1677+ OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF

1678+ ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

1679+

1680+data-default LICENSE file:

1681+

1683+

1685+

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

1687+ are permitted provided that the following conditions are met:

1688+

1689+ * Redistributions of source code must retain the above copyright notice, this

1690+ list of conditions and the following disclaimer.

1691+ * Redistributions in binary form must reproduce the above copyright notice,

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

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

1694+ * Neither the name of the author nor the names of his contributors

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

1696+ without specific prior written permission.

1697+

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

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

1700+ WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE

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

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

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

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

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

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

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

1708+

16091709data-default-class LICENSE file:

16101710

@@ -1635,6 +1735,122 @@ data-default-class LICENSE file:

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

16361736 SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

16371737

1738+data-default-instances-base LICENSE file:

1739+

1741+

1743+

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

1745+ are permitted provided that the following conditions are met:

1746+

1747+ * Redistributions of source code must retain the above copyright notice, this

1748+ list of conditions and the following disclaimer.

1749+ * Redistributions in binary form must reproduce the above copyright notice,

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

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

1752+ * Neither the name of the author nor the names of his contributors

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

1754+ without specific prior written permission.

1755+

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

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

1758+ WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE

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

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

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

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

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

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

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

1766+

1767+data-default-instances-containers LICENSE file:

1768+

1770+

1772+

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

1774+ are permitted provided that the following conditions are met:

1775+

1776+ * Redistributions of source code must retain the above copyright notice, this

1777+ list of conditions and the following disclaimer.

1778+ * Redistributions in binary form must reproduce the above copyright notice,

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

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

1781+ * Neither the name of the author nor the names of his contributors

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

1783+ without specific prior written permission.

1784+

1785+ THIS SOFTWARE IS PROVIDED BY LUKAS MAI AND CONTRIBUTORS "AS IS" AND ANY

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

1787+ WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE

1788+ DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR ANY

1789+ DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES

1790+ (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;

1791+ LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON

1792+ ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT

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

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

1795+

1796+data-default-instances-dlist LICENSE file:

1797+

1799+

1801+

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

1803+ are permitted provided that the following conditions are met:

1804+

1805+ * Redistributions of source code must retain the above copyright notice, this

1806+ list of conditions and the following disclaimer.

1807+ * Redistributions in binary form must reproduce the above copyright notice,

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

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

1810+ * Neither the name of the author nor the names of his contributors

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

1812+ without specific prior written permission.

1813+

1814+ THIS SOFTWARE IS PROVIDED BY LUKAS MAI AND CONTRIBUTORS "AS IS" AND ANY

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

1816+ WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE

1817+ DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR ANY

1818+ DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES

1819+ (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;

1820+ LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON

1821+ ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT

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

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

1824+

1825+data-default-instances-old-locale LICENSE file:

1826+

1828+

1830+

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

1832+ are permitted provided that the following conditions are met:

1833+

1834+ * Redistributions of source code must retain the above copyright notice, this

1835+ list of conditions and the following disclaimer.

1836+ * Redistributions in binary form must reproduce the above copyright notice,

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

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

1839+ * Neither the name of the author nor the names of his contributors

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

1841+ without specific prior written permission.

1842+

1843+ THIS SOFTWARE IS PROVIDED BY LUKAS MAI AND CONTRIBUTORS "AS IS" AND ANY

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

1845+ WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE

1846+ DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR ANY

1847+ DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES

1848+ (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;

1849+ LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON

1850+ ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT

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

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

1853+

16381854data-ordlist LICENSE file:

16391855

@@ -4366,6 +4582,39 @@ tagged LICENSE file:

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

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

43684584

4585+tagsoup LICENSE file:

4586+

4587+ Copyright Neil Mitchell 2006-2016.

4589+

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

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

4592+ met:

4593+

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

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

4596+

4597+ * Redistributions in binary form must reproduce the above

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

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

4600+ with the distribution.

4601+

4602+ * Neither the name of Neil Mitchell nor the names of other

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

4604+ from this software without specific prior written permission.

4605+

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

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

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

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

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

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

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

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

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

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

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

4617+

43694618template-haskell LICENSE file:

43704619

43714620

@@ -4649,6 +4898,39 @@ turtle LICENSE file:

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

46504899 SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

46514900

4901+uniplate LICENSE file:

4902+

4903+ Copyright Neil Mitchell 2006-2013.

4905+

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

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

4908+ met:

4909+

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

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

4912+

4913+ * Redistributions in binary form must reproduce the above

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

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

4916+ with the distribution.

4917+

4918+ * Neither the name of Neil Mitchell nor the names of other

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

4920+ from this software without specific prior written permission.

4921+

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

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

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

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

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

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

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

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

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

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

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

4933+

46524934unix LICENSE file:

46534935

46544936 The Glasgow Haskell Compiler License

@@ -5238,6 +5520,34 @@ x509-validation LICENSE file:

52385520 OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF

52395521 SUCH DAMAGE.

52405522

5523+xss-sanitize LICENSE file:

5524+

5525+ The following license covers this documentation, and the source code, except

5526+ where otherwise indicated.

5527+

5529+

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

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

5532+

5533+ * Redistributions of source code must retain the above copyright notice, this

5534+ list of conditions and the following disclaimer.

5535+

5536+ * Redistributions in binary form must reproduce the above copyright notice,

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

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

5539+

5540+ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS "AS IS" AND ANY EXPRESS OR

5541+ IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF

5542+ MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO

5543+ EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY DIRECT, INDIRECT,

5544+ INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT

5545+ NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA,

5546+ OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF

5547+ LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE

5548+ OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF

5549+ ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

5550+

52415551zlib LICENSE file:

52425552

psc-ide-server/Main.hs+12−4

@@ -29,6 +29,7 @@ import "monad-logger" Control.Monad.Logger

2929import qualified Data.Text.IO as T

3030import qualified Data.ByteString.Lazy.Char8 as BS8

3131import Data.Version (showVersion)

32+import GHC.IO.Exception (IOErrorType(..), IOException(..))

3233import Language.PureScript.Ide

3334import Language.PureScript.Ide.Command

3435import Language.PureScript.Ide.Util

@@ -144,14 +145,21 @@ startServer port env = withSocketsDo $ do

144145 -- $(logDebug) ("Answer was: " <> T.pack (show result))

145146 liftIO (hFlush stdout)

146147 case result of

147− Right r -> liftIO $ BS8.hPutStrLn h (Aeson.encode r)

148− Left err -> liftIO $ BS8.hPutStrLn h (Aeson.encode err)

148+ Right r -> liftIO $ catchGoneHandle (BS8.hPutStrLn h (Aeson.encode r))

149+ Left err -> liftIO $ catchGoneHandle (BS8.hPutStrLn h (Aeson.encode err))

149150 Nothing -> do

150151 $(logError) ("Parsing the command failed. Command: " <> cmd)

151152 liftIO $ do

152− T.hPutStrLn h (encodeT (GeneralError "Error parsing Command."))

153+ catchGoneHandle (T.hPutStrLn h (encodeT (GeneralError "Error parsing Command.")))

153154 hFlush stdout

154− liftIO (hClose h)

155+ liftIO $ catchGoneHandle (hClose h)

156+

157+catchGoneHandle :: IO () -> IO ()

158+catchGoneHandle =

159+ handle (\e -> case e of

160+ IOError { ioe_type = ResourceVanished } ->

161+ putText ("[Error] psc-ide-server tried interact with the handle, but the connection was already gone.")

162+ _ -> throwIO e)

155163

156164acceptCommand :: (MonadIO m, MonadLogger m, MonadError Text m)

157165 => Socket -> m (Text, Handle)

purescript.cabal+7−6

@@ -122,9 +122,11 @@ library

122122 aeson-better-errors >= 0.8,

123123 ansi-terminal >= 0.6.2 && < 0.7,

124124 base-compat >=0.6.0,

125+ blaze-html >= 0.8.1 && < 0.9,

125126 bower-json >= 1.0.0.1 && < 1.1,

126127 boxes >= 0.1.4 && < 0.2.0,

127128 bytestring -any,

129+ cheapskate >= 0.1 && < 0.2,

128130 containers -any,

129131 clock -any,

130132 data-ordlist >= 0.4.7.0,

@@ -293,6 +295,7 @@ library

293295 Language.PureScript.Docs.RenderedCode.RenderType

294296 Language.PureScript.Docs.RenderedCode.RenderKind

295297 Language.PureScript.Docs.AsMarkdown

298+ Language.PureScript.Docs.AsHtml

296299 Language.PureScript.Docs.ParseInPackage

297300 Language.PureScript.Docs.Utils.MonoidExtras

298301

@@ -516,7 +519,6 @@ executable psc-ide-server

516519 aeson >= 0.8 && < 1.0,

517520 bytestring -any,

518521 purescript -any,

519− base-compat >=0.6.0,

520522 directory -any,

521523 filepath -any,

522524 monad-logger -any,

@@ -526,8 +528,7 @@ executable psc-ide-server

526528 protolude >= 0.1.6,

527529 stm -any,

528530 text -any,

529− transformers -any,

530− transformers-compat -any

531+ transformers -any

531532 ghc-options: -Wall -O2 -threaded

532533 hs-source-dirs: psc-ide-server

533534

@@ -589,6 +590,8 @@ test-suite tests

589590 hspec -any,

590591 hspec-discover -any,

591592 HUnit -any,

593+ lens -any,

594+ monad-logger -any,

592595 mtl -any,

593596 optparse-applicative -any,

594597 parsec -any,

@@ -613,14 +616,12 @@ test-suite tests

613616 TestPsci

614617 TestPscIde

615618 PscIdeSpec

619+ Language.PureScript.Ide.Test

616620 Language.PureScript.Ide.FilterSpec

617621 Language.PureScript.Ide.ImportsSpec

618− Language.PureScript.Ide.Imports.IntegrationSpec

619− Language.PureScript.Ide.Integration

620622 Language.PureScript.Ide.MatcherSpec

621623 Language.PureScript.Ide.RebuildSpec

622624 Language.PureScript.Ide.ReexportsSpec

623− Language.PureScript.Ide.SourceFile.IntegrationSpec

624625 Language.PureScript.Ide.SourceFileSpec

625626 Language.PureScript.Ide.StateSpec

626627 buildable: True

src/Language/PureScript/Crash.hs+1−1

@@ -6,6 +6,6 @@ import Prelude.Compat

66internalError :: String -> a

77internalError =

88 error

9− . ("An internal error ocurred during compilation: " ++)

9+ . ("An internal error occurred during compilation: " ++)

1010 . (++ "\nPlease report this at https://github.com/purescript/purescript/issues")

1111 . show

src/Language/PureScript/Docs/AsHtml.hsnew file+299

@@ -0,0 +1,299 @@

2+-- | Functions for rendering generated documentation from PureScript code as

3+-- HTML.

5+module Language.PureScript.Docs.AsHtml (

6+ HtmlOutput(..),

7+ HtmlOutputModule(..),

8+ HtmlRenderContext(..),

9+ nullRenderContext,

10+ declNamespace,

11+ packageAsHtml,

12+ moduleAsHtml,

13+ makeFragment,

14+ renderMarkdown

15+) where

16+

17+import Prelude

18+import Control.Arrow (second)

19+import Control.Category ((>>>))

20+import Control.Monad (unless)

21+import Data.Char (isUpper)

22+import Data.Monoid ((<>))

23+import Data.Foldable (for_)

24+import Data.String (fromString)

25+

26+import Data.Text (Text)

27+import qualified Data.Text as T

28+

29+import Text.Blaze.Html5 as H hiding (map)

30+import qualified Text.Blaze.Html5.Attributes as A

31+import qualified Cheapskate

32+

33+import qualified Language.PureScript as P

34+

35+import Language.PureScript.Docs.Types

36+import Language.PureScript.Docs.RenderedCode hiding (sp)

37+import qualified Language.PureScript.Docs.Render as Render

38+

39+declNamespace :: Declaration -> Namespace

40+declNamespace = declInfoNamespace . declInfo

41+

42+data HtmlOutput a = HtmlOutput

43+ { htmlIndex :: [(Maybe Char, a)]

44+ , htmlModules :: [(P.ModuleName, HtmlOutputModule a)]

45+ }

46+ deriving (Show, Functor)

47+

48+data HtmlOutputModule a = HtmlOutputModule

49+ { htmlOutputModuleLocals :: a

50+ , htmlOutputModuleReExports :: [(InPackage P.ModuleName, a)]

51+ }

52+ deriving (Show, Functor)

53+

54+data HtmlRenderContext = HtmlRenderContext

55+ { currentModuleName :: P.ModuleName

56+ , buildDocLink :: Namespace -> Text -> ContainingModule -> Maybe DocLink

57+ , renderDocLink :: DocLink -> Text

58+ , renderSourceLink :: P.SourceSpan -> Text

59+ }

60+

61+-- |

62+-- An HtmlRenderContext for when you don't want to render any links.

63+nullRenderContext :: P.ModuleName -> HtmlRenderContext

64+nullRenderContext mn = HtmlRenderContext

65+ { currentModuleName = mn

66+ , buildDocLink = const (const (const Nothing))

67+ , renderDocLink = const ""

68+ , renderSourceLink = const ""

69+ }

70+

71+packageAsHtml :: (P.ModuleName -> HtmlRenderContext) -> Package a -> HtmlOutput Html

72+packageAsHtml getHtmlCtx Package{..} =

73+ HtmlOutput indexFile modules

74+ where

75+ indexFile = []

76+ modules = map (\m -> moduleAsHtml (getHtmlCtx (modName m)) m) pkgModules

77+

78+moduleAsHtml :: HtmlRenderContext -> Module -> (P.ModuleName, HtmlOutputModule Html)

79+moduleAsHtml r Module{..} = (modName, HtmlOutputModule modHtml reexports)

80+ where

81+ renderDecl = declAsHtml r

82+ modHtml = do

83+ for_ modComments renderMarkdown

84+ for_ modDeclarations renderDecl

85+ reexports =

86+ map (second (foldMap renderDecl)) modReExports

87+

88+-- renderIndex :: LinksContext -> [(Maybe Char, Html)]

89+-- renderIndex LinksContext{..} = go ctxBookmarks

90+-- where

91+-- go = takeLocals

92+-- >>> groupIndex getIndex renderEntry

93+-- >>> map (second (ul . mconcat))

94+--

95+-- getIndex (_, title_) = do

96+-- c <- textHeadMay title_

97+-- guard (toUpper c `elem` ['A'..'Z'])

98+-- pure c

99+--

100+-- textHeadMay t =

101+-- case T.length t of

102+-- 0 -> Nothing

103+-- _ -> Just (T.index t 0)

104+--

105+-- renderEntry (mn, title_) =

106+-- li $ do

107+-- let url = T.pack (filePathFor mn `relativeTo` "index") <> "#" <> title_

108+-- code $

109+-- a ! A.href (v url) $ text title_

110+-- sp

111+-- text ("(" <> P.runModuleName mn <> ")")

112+--

113+-- groupIndex :: Ord i => (a -> Maybe i) -> (a -> b) -> [a] -> [(Maybe i, [b])]

114+-- groupIndex f g =

115+-- map (second DList.toList) . M.toList . foldr go' M.empty . sortBy (comparing f)

116+-- where

117+-- go' x = insertOrAppend (f x) (g x)

118+-- insertOrAppend idx val m =

119+-- let cur = M.findWithDefault DList.empty idx m

120+-- new = DList.snoc cur val

121+-- in M.insert idx new m

122+

123+declAsHtml :: HtmlRenderContext -> Declaration -> Html

124+declAsHtml r d@Declaration{..} = do

125+ let declFragment = makeFragment (declInfoNamespace declInfo) declTitle

126+ H.div ! A.class_ "decl" ! A.id (v (T.drop 1 declFragment)) $ do

127+ h3 ! A.class_ "decl__title clearfix" $ do

128+ a ! A.class_ "decl__anchor" ! A.href (v declFragment) $ "#"

129+ text declTitle

130+ for_ declSourceSpan (linkToSource r)

131+

132+ H.div ! A.class_ "decl__body" $ do

133+ case declInfo of

134+ AliasDeclaration fixity alias_ ->

135+ renderAlias fixity alias_

136+ _ ->

137+ pre ! A.class_ "decl__signature" $ code $

138+ codeAsHtml r (Render.renderDeclaration d)

139+

140+ for_ declComments renderMarkdown

141+

142+ let (instances, dctors, members) = partitionChildren declChildren

143+

144+ unless (null dctors) $ do

145+ h4 "Constructors"

146+ renderChildren r dctors

147+

148+ unless (null members) $ do

149+ h4 "Members"

150+ renderChildren r members

151+

152+ unless (null instances) $ do

153+ h4 "Instances"

154+ renderChildren r instances

155+ where

156+ linkToSource :: HtmlRenderContext -> P.SourceSpan -> Html

157+ linkToSource ctx srcspan =

158+ H.span ! A.class_ "decl__source" $

159+ a ! A.href (v (renderSourceLink ctx srcspan)) $ text "Source"

160+

161+renderChildren :: HtmlRenderContext -> [ChildDeclaration] -> Html

162+renderChildren _ [] = return ()

163+renderChildren r xs = ul $ mapM_ go xs

164+ where

165+ go decl = item decl . code . codeAsHtml r . Render.renderChildDeclaration $ decl

166+ item decl = let fragment = makeFragment (childDeclInfoNamespace (cdeclInfo decl)) (cdeclTitle decl)

167+ in li ! A.id (v (T.drop 1 fragment))

168+

169+codeAsHtml :: HtmlRenderContext -> RenderedCode -> Html

170+codeAsHtml r = outputWith elemAsHtml

171+ where

172+ elemAsHtml e = case e of

173+ Syntax x ->

174+ withClass "syntax" (text x)

175+ Keyword x ->

176+ withClass "keyword" (text x)

177+ Space ->

178+ text " "

179+ Symbol ns name link_ ->

180+ case link_ of

181+ Link mn ->

182+ let

183+ class_ = if startsWithUpper name then "ctor" else "ident"

184+ in

185+ linkToDecl ns name mn (withClass class_ (text name))

186+ NoLink ->

187+ text name

188+

189+ linkToDecl = linkToDeclaration r

190+

191+ startsWithUpper :: Text -> Bool

192+ startsWithUpper str =

193+ if T.null str

194+ then False

195+ else isUpper (T.index str 0)

196+

197+renderLink :: HtmlRenderContext -> DocLink -> Html -> Html

198+renderLink r link_@DocLink{..} =

199+ a ! A.href (v (renderDocLink r link_ <> fragmentFor link_))

200+ ! A.title (v fullyQualifiedName)

201+ where

202+ fullyQualifiedName = case linkLocation of

203+ SameModule -> fq (currentModuleName r) linkTitle

204+ LocalModule _ modName -> fq modName linkTitle

205+ DepsModule _ _ _ modName -> fq modName linkTitle

206+ BuiltinModule modName -> fq modName linkTitle

207+

208+ fq mn str = P.runModuleName mn <> "." <> str

209+

210+makeFragment :: Namespace -> Text -> Text

211+makeFragment ns = (prefix <>) . escape

212+ where

213+ prefix = case ns of

214+ TypeLevel -> "#t:"

215+ ValueLevel -> "#v:"

216+ KindLevel -> "#k:"

217+

218+ -- TODO

219+ escape = id

220+

221+fragmentFor :: DocLink -> Text

222+fragmentFor l = makeFragment (linkNamespace l) (linkTitle l)

223+

224+linkToDeclaration ::

225+ HtmlRenderContext ->

226+ Namespace ->

227+ Text ->

228+ ContainingModule ->

229+ Html ->

230+ Html

231+linkToDeclaration r ns target containMn =

232+ maybe id (renderLink r) (buildDocLink r ns target containMn)

233+

234+renderAlias :: P.Fixity -> FixityAlias -> Html

235+renderAlias (P.Fixity associativity precedence) alias_ =

236+ p $ do

237+ -- TODO: Render a link

238+ toHtml $ "Operator alias for " <> P.showQualified showAliasName alias_ <> " "

239+ em $

240+ text ("(" <> associativityStr <> " / precedence " <> T.pack (show precedence) <> ")")

241+ where

242+ showAliasName (Left valueAlias) = P.runProperName valueAlias

243+ showAliasName (Right typeAlias) = case typeAlias of

244+ (Left identifier) -> P.runIdent identifier

245+ (Right properName) -> P.runProperName properName

246+ associativityStr = case associativity of

247+ P.Infixl -> "left-associative"

248+ P.Infixr -> "right-associative"

249+ P.Infix -> "non-associative"

250+

251+-- | Render Markdown to HTML. Safe for untrusted input. Relative links are

252+-- | removed.

253+renderMarkdown :: Text -> H.Html

254+renderMarkdown =

255+ H.toMarkup . removeRelativeLinks . Cheapskate.markdown opts

256+ where

257+ opts = Cheapskate.def { Cheapskate.allowRawHtml = False }

258+

259+removeRelativeLinks :: Cheapskate.Doc -> Cheapskate.Doc

260+removeRelativeLinks = Cheapskate.walk go

261+ where

262+ go :: Cheapskate.Inlines -> Cheapskate.Inlines

263+ go = (>>= stripRelatives)

264+

265+ stripRelatives :: Cheapskate.Inline -> Cheapskate.Inlines

266+ stripRelatives (Cheapskate.Link contents_ href _)

267+ | isRelativeURI href = contents_

268+ stripRelatives other = pure other

269+

270+ -- Tests for a ':' character in the first segment of a URI.

271+ --

272+ -- See Section 4.2 of RFC 3986:

273+ -- https://tools.ietf.org/html/rfc3986#section-4.2

274+ --

275+ -- >>> isRelativeURI "http://example.com/" == False

276+ -- >>> isRelativeURI "mailto:me@example.com" == False

277+ -- >>> isRelativeURI "foo/bar" == True

278+ -- >>> isRelativeURI "/bar" == True

279+ -- >>> isRelativeURI "./bar" == True

280+ isRelativeURI :: Text -> Bool

281+ isRelativeURI =

282+ T.takeWhile (/= '/') >>> T.all (/= ':')

283+

284+v :: Text -> AttributeValue

285+v = toValue

286+

287+withClass :: String -> Html -> Html

288+withClass className content = H.span ! A.class_ (fromString className) $ content

289+

290+partitionChildren ::

291+ [ChildDeclaration] ->

292+ ([ChildDeclaration], [ChildDeclaration], [ChildDeclaration])

293+partitionChildren = foldl go ([], [], [])

294+ where

295+ go (instances, dctors, members) rcd =

296+ case cdeclInfo rcd of

297+ ChildInstance _ _ -> (rcd : instances, dctors, members)

298+ ChildDataConstructor _ -> (instances, rcd : dctors, members)

299+ ChildTypeClassMember _ -> (instances, dctors, rcd : members)

src/Language/PureScript/Docs/Types.hs+84−1

@@ -5,7 +5,7 @@ module Language.PureScript.Docs.Types

55 where

77import Protolude hiding (to, from)

8−import Prelude (String, unlines)

8+import Prelude (String, unlines, lookup)

1010import Control.Arrow ((***))

1111

@@ -353,6 +353,89 @@ ignorePackage :: InPackage a -> a

353353ignorePackage (Local x) = x

354354ignorePackage (FromDep _ x) = x

355355

356+----------------------------------------------------

357+-- Types for links between declarations

358+

359+data LinksContext = LinksContext

360+ { ctxGithub :: (GithubUser, GithubRepo)

361+ , ctxModuleMap :: Map P.ModuleName PackageName

362+ , ctxResolvedDependencies :: [(PackageName, Version)]

363+ , ctxPackageName :: PackageName

364+ , ctxVersion :: Version

365+ , ctxVersionTag :: Text

366+ }

367+ deriving (Show, Eq, Ord)

368+

369+data DocLink = DocLink

370+ { linkLocation :: LinkLocation

371+ , linkTitle :: Text

372+ , linkNamespace :: Namespace

373+ }

374+ deriving (Show, Eq, Ord)

375+

376+data LinkLocation

377+ -- | A link to a declaration in the same module.

378+ = SameModule

379+

380+ -- | A link to a declaration in a different module, but still in the current

381+ -- package; we need to store the current module and the other declaration's

382+ -- module.

383+ | LocalModule P.ModuleName P.ModuleName

384+

385+ -- | A link to a declaration in a different package. We store: current module

386+ -- name, name of the other package, version of the other package, and name of

387+ -- the module in the other package that the declaration is in.

388+ | DepsModule P.ModuleName PackageName Version P.ModuleName

389+

390+ -- | A link to a declaration that is built in to the compiler, e.g. the Prim

391+ -- module. In this case we only need to store the module that the builtin

392+ -- comes from (at the time of writing, this will only ever be "Prim").

393+ | BuiltinModule P.ModuleName

394+ deriving (Show, Eq, Ord)

395+

396+-- | Given a links context, a thing to link to (either a value or a type), and

397+-- its containing module, attempt to create a DocLink.

398+getLink :: LinksContext -> P.ModuleName -> Namespace -> Text -> ContainingModule -> Maybe DocLink

399+getLink LinksContext{..} curMn namespace target containingMod = do

400+ location <- getLinkLocation

401+ return DocLink

402+ { linkLocation = location

403+ , linkTitle = target

404+ , linkNamespace = namespace

405+ }

406+

407+ where

408+ getLinkLocation = normalLinkLocation <|> builtinLinkLocation

409+

410+ normalLinkLocation = do

411+ case containingMod of

412+ ThisModule ->

413+ return SameModule

414+ OtherModule destMn ->

415+ case Map.lookup destMn ctxModuleMap of

416+ Nothing ->

417+ return $ LocalModule curMn destMn

418+ Just pkgName -> do

419+ pkgVersion <- lookup pkgName ctxResolvedDependencies

420+ return $ DepsModule curMn pkgName pkgVersion destMn

421+

422+ builtinLinkLocation = do

423+ let primMn = P.moduleNameFromString "Prim"

424+ guard $ containingMod == OtherModule primMn

425+ -- TODO: ensure the declaration exists in the builtin module too

426+ return $ BuiltinModule primMn

427+

428+getLinksContext :: Package a -> LinksContext

429+getLinksContext Package{..} =

430+ LinksContext

431+ { ctxGithub = pkgGithub

432+ , ctxModuleMap = pkgModuleMap

433+ , ctxResolvedDependencies = pkgResolvedDependencies

434+ , ctxPackageName = bowerName pkgMeta

435+ , ctxVersion = pkgVersion

436+ , ctxVersionTag = pkgVersionTag

437+ }

438+

356439----------------------

357440-- Parsing

358441

src/Language/PureScript/Errors.hs+12−7

@@ -20,6 +20,7 @@ import Data.Functor.Identity (Identity(..))

2020import Data.List (transpose, nub, nubBy, sortBy, partition)

2121import Data.Maybe (maybeToList, fromMaybe, mapMaybe)

2222import Data.Ord (comparing)

23+import Data.String (fromString)

2324import qualified Data.Map as M

2425import qualified Data.Text as T

2526import Data.Text (Text)

@@ -31,7 +32,8 @@ import Language.PureScript.Environment

3132import Language.PureScript.Label (Label(..))

3233import Language.PureScript.Names

3334import Language.PureScript.Pretty

34−import Language.PureScript.Pretty.Common (before, endWith)

35+import Language.PureScript.Pretty.Common (endWith)

36+import Language.PureScript.PSString (PSString, decodeStringWithReplacement)

3537import Language.PureScript.Traversals

3638import Language.PureScript.Types

3739import qualified Language.PureScript.Publish.BoxesHelpers as BoxHelpers

@@ -1264,12 +1266,15 @@ renderBox = unlines

12641266 whiteSpace = all isSpace

12651267

12661268toTypelevelString :: Type -> Maybe Box.Box

1267−toTypelevelString (TypeLevelString s) = Just $ Box.text $ T.unpack $ prettyPrintString s

1268−toTypelevelString (TypeApp (TypeConstructor f) x)

1269− | f == primName "TypeString" = Just $ typeAsBox x

1270−toTypelevelString (TypeApp (TypeApp (TypeConstructor f) x) ret)

1271− | f == primName "TypeConcat" = before <$> (toTypelevelString x) <*> (toTypelevelString ret)

1272−toTypelevelString _ = Nothing

1269+toTypelevelString t = (Box.text . decodeStringWithReplacement) <$> toTypelevelString' t

1270+ where

1271+ toTypelevelString' :: Type -> Maybe PSString

1272+ toTypelevelString' (TypeLevelString s) = Just s

1273+ toTypelevelString' (TypeApp (TypeConstructor f) x)

1274+ | f == primName "TypeString" = Just $ fromString $ prettyPrintType x

1275+ toTypelevelString' (TypeApp (TypeApp (TypeConstructor f) x) ret)

1276+ | f == primName "TypeConcat" = toTypelevelString' x <> toTypelevelString' ret

1277+ toTypelevelString' _ = Nothing

12731278

12741279-- | Rethrow an error with a more detailed error message in the case of failure

12751280rethrow :: (MonadError e m) => (e -> e) -> m a -> m a

src/Language/PureScript/Ide.hs+34−10

@@ -47,9 +47,13 @@ handleCommand :: (Ide m, MonadLogger m, MonadError PscIdeError m) =>

4747 Command -> m Success

4848handleCommand c = case c of

4949 Load [] ->

50− findAvailableExterns >>= loadModules

50+ findAvailableExterns >>= loadModulesAsync

5151 Load modules ->

52− loadModules modules

52+ loadModulesAsync modules

53+ LoadSync [] ->

54+ findAvailableExterns >>= loadModulesSync

55+ LoadSync modules ->

56+ loadModulesSync modules

5357 Type search filters currentModule ->

5458 findType search filters currentModule

5559 Complete filters matcher currentModule ->

@@ -78,7 +82,9 @@ handleCommand c = case c of

7882 Left question ->

7983 pure (CompletionResult (map (completionFromMatch . map withEmptyAnn) question))

8084 Rebuild file ->

81− rebuildFile file

85+ rebuildFileAsync file

86+ RebuildSync file ->

87+ rebuildFileSync file

8288 Cwd ->

8389 TextResult . toS <$> liftIO getCurrentDirectory

8490 Reset ->

@@ -162,6 +168,31 @@ findAllSourceFiles = do

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

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

164170-- populates Stage 2 and 3 of the state.

171+loadModulesAsync

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

173+ => [P.ModuleName]

174+ -> m Success

175+loadModulesAsync moduleNames = do

176+ tr <- loadModules moduleNames

177+

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

179+ -- successfully parsed modules.

180+ env <- ask

181+ let ll = confLogLevel (ideConfiguration env)

182+ -- populateStage2 and 3 return Unit for now, so it's fine to discard this

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

184+ _ <- liftIO (async (runLogger ll (runReaderT (populateStage2 *> populateStage3) env)))

185+ pure tr

186+

187+loadModulesSync

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

189+ => [P.ModuleName]

190+ -> m Success

191+loadModulesSync moduleNames = do

192+ tr <- loadModules moduleNames

193+ populateStage2 *> populateStage3

194+ pure tr

195+

165196loadModules

166197 :: (Ide m, MonadError PscIdeError m, MonadLogger m)

167198 => [P.ModuleName]

@@ -182,12 +213,5 @@ loadModules moduleNames = do

182213 $(logWarn) ("Failed to parse: " <> show failures)

183214 traverse_ insertModule allModules

184215

185− -- Finally we kick off the worker with @async@ and return the number of

186− -- successfully parsed modules.

187− env <- ask

188− let ll = confLogLevel (ideConfiguration env)

189− -- populateStage2 and 3 return Unit for now, so it's fine to discard this

190− -- result. We might want to block on this in a benchmarking situation.

191− _ <- liftIO (async (runLogger ll (runReaderT (populateStage2 *> populateStage3) env)))

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

193217 <> show (length allModules) <> " source files."))

src/Language/PureScript/Ide/Command.hs+4

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

2525

2626data Command

2727 = Load [P.ModuleName]

28+ | LoadSync [P.ModuleName] -- used in tests

2829 | Type

2930 { typeSearch :: Text

3031 , typeFilters :: [Filter]

@@ -54,6 +55,7 @@ data Command

5455 | Import FilePath (Maybe FilePath) [Filter] ImportCommand

5556 | List { listType :: ListType }

5657 | Rebuild FilePath -- ^ Rebuild the specified file using the loaded externs

58+ | RebuildSync FilePath -- ^ Rebuild the specified file using the loaded externs

5759 | Cwd

5860 | Reset

5961 | Quit

@@ -61,6 +63,7 @@ data Command

6163commandName :: Command -> Text

6264commandName c = case c of

6365 Load{} -> "Load"

66+ LoadSync{} -> "LoadSync"

6467 Type{} -> "Type"

6568 Complete{} -> "Complete"

6669 Pursuit{} -> "Pursuit"

@@ -69,6 +72,7 @@ commandName c = case c of

6972 Import{} -> "Import"

7073 List{} -> "List"

7174 Rebuild{} -> "Rebuild"

75+ RebuildSync{} -> "RebuildSync"

7276 Cwd{} -> "Cwd"

7377 Reset{} -> "Reset"

7478 Quit{} -> "Quit"

src/Language/PureScript/Ide/Completion.hs+3

@@ -8,6 +8,9 @@ import Protolude

88import Language.PureScript.Ide.Filter

99import Language.PureScript.Ide.Matcher

1010import Language.PureScript.Ide.Types

11+import qualified Language.PureScript as P

12+

13+type Module = (P.ModuleName, [IdeDeclarationAnn])

1114

1215-- | Applies the CompletionFilters and the Matcher to the given Modules

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

src/Language/PureScript/Ide/Error.hs+1

@@ -29,6 +29,7 @@ data PscIdeError

2929 | ModuleFileNotFound ModuleIdent

3030 | ParseError P.ParseError Text

3131 | RebuildError [JSONError]

32+ deriving (Show, Eq)

3233

3334instance ToJSON PscIdeError where

3435 toJSON (RebuildError errs) = object

src/Language/PureScript/Ide/Externs.hs+15−12

@@ -54,9 +54,9 @@ readExternFile fp = do

5454 where

5555 version = toS (showVersion P.version)

5656

57−convertExterns :: P.ExternsFile -> (Module, [(P.ModuleName, P.DeclarationRef)])

57+convertExterns :: P.ExternsFile -> ([IdeDeclarationAnn], [(P.ModuleName, P.DeclarationRef)])

5858convertExterns ef =

59− ((P.efModuleName ef, decls), exportDecls)

59+ (decls, exportDecls)

6060 where

6161 decls = map

6262 (IdeDeclarationAnn emptyAnn)

@@ -71,8 +71,10 @@ convertExterns ef =

7171

7272removeTypeDeclarationsForClass :: IdeDeclaration -> Endo [IdeDeclaration]

7373removeTypeDeclarationsForClass (IdeDeclTypeClass n) = Endo (filter notDuplicate)

74− where notDuplicate (IdeDeclType t) = n ^. properNameT /= t ^. ideTypeName . properNameT

75− notDuplicate (IdeDeclTypeSynonym s) = n ^. properNameT /= s ^. ideSynonymName . properNameT

74+ where notDuplicate (IdeDeclType t) =

75+ n ^. ideTCName . properNameT /= t ^. ideTypeName . properNameT

76+ notDuplicate (IdeDeclTypeSynonym s) =

77+ n ^. ideTCName . properNameT /= s ^. ideSynonymName . properNameT

7678 notDuplicate _ = True

7779removeTypeDeclarationsForClass _ = mempty

7880

@@ -88,12 +90,13 @@ convertDecl :: P.ExternsDeclaration -> Maybe IdeDeclaration

8890convertDecl P.EDType{..} = Just $ IdeDeclType $

8991 IdeType edTypeName edTypeKind

9092convertDecl P.EDTypeSynonym{..} = Just $ IdeDeclTypeSynonym

91− (IdeSynonym edTypeSynonymName edTypeSynonymType)

93+ (IdeTypeSynonym edTypeSynonymName edTypeSynonymType)

9294convertDecl P.EDDataConstructor{..} = Just $ IdeDeclDataConstructor $

9395 IdeDataConstructor edDataCtorName edDataCtorTypeCtor edDataCtorType

9496convertDecl P.EDValue{..} = Just $ IdeDeclValue $

9597 IdeValue edValueName edValueType

96−convertDecl P.EDClass{..} = Just (IdeDeclTypeClass edClassName)

98+convertDecl P.EDClass{..} = Just $ IdeDeclTypeClass $

99+ IdeTypeClass edClassName []

97100convertDecl P.EDKind{..} = Just (IdeDeclKind edKindName)

98101convertDecl P.EDInstance{} = Nothing

99102

@@ -117,10 +120,10 @@ convertTypeOperator P.ExternsTypeFixity{..} =

117120

118121annotateModule

119122 :: (DefinitionSites P.SourceSpan, TypeAnnotations)

120− -> Module

121− -> Module

122−annotateModule (defs, types) (moduleName, decls) =

123− (moduleName, map convertDeclaration decls)

123+ -> [IdeDeclarationAnn]

124+ -> [IdeDeclarationAnn]

125+annotateModule (defs, types) decls =

126+ map convertDeclaration decls

124127 where

125128 convertDeclaration :: IdeDeclarationAnn -> IdeDeclarationAnn

126129 convertDeclaration (IdeDeclarationAnn ann d) = case d of

@@ -132,8 +135,8 @@ annotateModule (defs, types) (moduleName, decls) =

132135 annotateType (s ^. ideSynonymName . properNameT) (IdeDeclTypeSynonym s)

133136 IdeDeclDataConstructor dtor ->

134137 annotateValue (dtor ^. ideDtorName . properNameT) (IdeDeclDataConstructor dtor)

135− IdeDeclTypeClass i ->

136− annotateType (i ^. properNameT) (IdeDeclTypeClass i)

138+ IdeDeclTypeClass tc ->

139+ annotateType (tc ^. ideTCName . properNameT) (IdeDeclTypeClass tc)

137140 IdeDeclValueOperator op ->

138141 annotateValue (op ^. ideValueOpAlias & valueOperatorAliasT) (IdeDeclValueOperator op)

139142 IdeDeclTypeOperator op ->

src/Language/PureScript/Ide/Filter.hs+2

@@ -32,6 +32,8 @@ import Language.PureScript.Ide.Util

3232

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

3434

35+type Module = (P.ModuleName, [IdeDeclarationAnn])

36+

3537mkFilter :: ([Module] -> [Module]) -> Filter

3638mkFilter = Filter . Endo

3739

src/Language/PureScript/Ide/Imports.hs+2−2

@@ -197,8 +197,8 @@ addExplicitImport' decl moduleName imports =

197197 then imports

198198 else updateAtFirstOrPrepend matches (insertDeclIntoImport decl) freshImport imports

199199 where

200− refFromDeclaration (IdeDeclTypeClass n) =

201− P.TypeClassRef n

200+ refFromDeclaration (IdeDeclTypeClass tc) =

201+ P.TypeClassRef (tc ^. ideTCName)

202202 refFromDeclaration (IdeDeclDataConstructor dtor) =

203203 P.TypeRef (dtor ^. ideDtorTypeName) Nothing

204204 refFromDeclaration (IdeDeclType t) =

src/Language/PureScript/Ide/Logging.hs+4

@@ -4,6 +4,7 @@ module Language.PureScript.Ide.Logging

44 ( runLogger

55 , logPerf

66 , displayTimeSpec

7+ , labelTimespec

78 ) where

910import Protolude

@@ -24,6 +25,9 @@ runLogger logLevel' =

2425 LogDebug -> not (logLevel == LevelOther "perf")

2526 LogPerf -> logLevel == LevelOther "perf")

2627

28+labelTimespec :: Text -> TimeSpec -> Text

29+labelTimespec label duration = label <> ": " <> displayTimeSpec duration

30+

2731logPerf :: (MonadIO m, MonadLogger m) => (TimeSpec -> Text) -> m t -> m t

2832logPerf format f = do

2933 start <- liftIO (getTime Monotonic)

src/Language/PureScript/Ide/Rebuild.hs+40−10

@@ -2,7 +2,9 @@

22{-# LANGUAGE TemplateHaskell #-}

44module Language.PureScript.Ide.Rebuild

5− ( rebuildFile

5+ ( rebuildFileSync

6+ , rebuildFileAsync

7+ , rebuildFile

68 ) where

810import Protolude

@@ -15,6 +17,7 @@ import qualified Data.Set as S

1517import qualified Language.PureScript as P

1618import Language.PureScript.Errors.JSON

1719import Language.PureScript.Ide.Error

20+import Language.PureScript.Ide.Logging

1821import Language.PureScript.Ide.State

1922import Language.PureScript.Ide.Types

2023import System.IO.UTF8 (readUTF8FileT)

@@ -37,8 +40,11 @@ import System.IO.UTF8 (readUTF8FileT)

3740rebuildFile

3841 :: (Ide m, MonadLogger m, MonadError PscIdeError m)

3942 => FilePath

43+ -- ^ The file to rebuild

44+ -> (ReaderT IdeEnvironment (LoggingT IO) () -> m ())

45+ -- ^ A runner for the second build with open exports

4046 -> m Success

41−rebuildFile path = do

47+rebuildFile path runOpenBuild = do

4248

4349 input <- liftIO (readUTF8FileT path)

4450

@@ -51,7 +57,7 @@ rebuildFile path = do

5157

5258 -- Externs files must be sorted ahead of time, so that they get applied

5359 -- correctly to the 'Environment'.

54− externs <- sortExterns m =<< getExternFiles

60+ externs <- logPerf (labelTimespec "Sorting externs") (sortExterns m =<< getExternFiles)

5561

5662 outputDirectory <- confOutputPath . ideConfiguration <$> ask

5763

@@ -62,25 +68,49 @@ rebuildFile path = do

6268

6369 let makeEnv = MakeActionsEnv outputDirectory filePathMap foreigns False

6470 -- Rebuild the single module using the cached externs

65− (result, warnings) <- liftIO

71+ (result, warnings) <- logPerf (labelTimespec "Rebuilding Module") $

72+ liftIO

6673 . P.runMake P.defaultOptions

6774 . P.rebuildModule (buildMakeActions

6875 >>= shushProgress $ makeEnv) externs $ m

6976 case result of

7077 Left errors -> throwError (RebuildError (toJSONErrors False P.Error errors))

7178 Right _ -> do

72− rebuildModuleOpen makeEnv externs m

79+ runOpenBuild (rebuildModuleOpen makeEnv externs m)

7380 pure (RebuildSuccess (toJSONErrors False P.Warning warnings))

7481

82+rebuildFileAsync

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

84+ => FilePath -> m Success

85+rebuildFileAsync fp = rebuildFile fp asyncRun

86+ where

87+ asyncRun :: ReaderT IdeEnvironment (LoggingT IO) () -> m ()

88+ asyncRun action = do

89+ env <- ask

90+ let ll = confLogLevel (ideConfiguration env)

91+ void (liftIO (async (runLogger ll (runReaderT action env))))

92+

93+rebuildFileSync

94+ :: forall m. (Ide m, MonadLogger m, MonadError PscIdeError m)

95+ => FilePath -> m Success

96+rebuildFileSync fp = rebuildFile fp syncRun

97+ where

98+ syncRun :: ReaderT IdeEnvironment (LoggingT IO) () -> m ()

99+ syncRun action = do

100+ env <- ask

101+ let ll = confLogLevel (ideConfiguration env)

102+ void (liftIO (runLogger ll (runReaderT action env)))

103+

104+

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

76106-- inside the rebuild cache

77107rebuildModuleOpen

78− :: (Ide m, MonadLogger m, MonadError PscIdeError m)

108+ :: (Ide m, MonadLogger m)

79109 => MakeActionsEnv

80110 -> [P.ExternsFile]

81111 -> P.Module

82112 -> m ()

83−rebuildModuleOpen makeEnv externs m = do

113+rebuildModuleOpen makeEnv externs m = void $ runExceptT $ do

84114 (openResult, _) <- liftIO

85115 . P.runMake P.defaultOptions

86116 . P.rebuildModule (buildMakeActions

@@ -99,8 +129,8 @@ rebuildModuleOpen makeEnv externs m = do

99129data MakeActionsEnv =

100130 MakeActionsEnv

101131 { maeOutputDirectory :: FilePath

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

103− , maeForeignPathMap :: Map P.ModuleName FilePath

132+ , maeFilePathMap :: ModuleMap (Either P.RebuildPolicy FilePath)

133+ , maeForeignPathMap :: ModuleMap FilePath

104134 , maePrefixComment :: Bool

105135 }

106136

@@ -130,7 +160,7 @@ shushCodegen ma MakeActionsEnv{..} =

130160sortExterns

131161 :: (Ide m, MonadError PscIdeError m)

132162 => P.Module

133− -> Map P.ModuleName P.ExternsFile

163+ -> ModuleMap P.ExternsFile

134164 -> m [P.ExternsFile]

135165sortExterns m ex = do

136166 sorted' <- runExceptT

src/Language/PureScript/Ide/Reexports.hs+33−21

@@ -18,25 +18,26 @@ module Language.PureScript.Ide.Reexports

1818 , prettyPrintReexportResult

1919 , reexportHasFailures

2020 , ReexportResult(..)

21+ -- for tests

22+ , resolveReexports'

2123 ) where

2224

2325import Protolude

2426

2527import Control.Lens hiding ((&))

26−

2728import qualified Data.Map as Map

2829import qualified Language.PureScript as P

2930import Language.PureScript.Ide.Types

3031import Language.PureScript.Ide.Util

3132

32−-- | Contains the module with resolved reexports, and eventual failures

33+-- | Contains the module with resolved reexports, and possible failures

3334data ReexportResult a

3435 = ReexportResult

3536 { reResolved :: a

3637 , reFailed :: [(P.ModuleName, P.DeclarationRef)]

3738 } deriving (Show, Eq, Functor)

3839

39−-- | Uses the passed formatter to format the resolved module, and adds eventual

40+-- | Uses the passed formatter to format the resolved module, and adds possible

4041-- failures

4142prettyPrintReexportResult

4243 :: (a -> Text)

@@ -56,16 +57,27 @@ prettyPrintReexportResult f ReexportResult{..}

5657reexportHasFailures :: ReexportResult a -> Bool

5758reexportHasFailures = not . null . reFailed

5859

59−-- | Resolves Reexports for a given Module, by looking up the reexported values

60−-- from the passed in Map

60+-- | Resolves Reexports for the given Modules, by looking up the reexported

61+-- values from the passed in DeclarationRefs

6162resolveReexports

62− :: Map P.ModuleName [IdeDeclarationAnn]

63+ :: ModuleMap [(P.ModuleName, P.DeclarationRef)]

64+ -- ^ the references to resolve

65+ -> ModuleMap [IdeDeclarationAnn]

6366 -- ^ Modules to search for the reexported declarations

64− -> (Module, [(P.ModuleName, P.DeclarationRef)])

65− -- ^ The module to resolve reexports for, aswell as the references to resolve

66− -> ReexportResult Module

67−resolveReexports modules ((moduleName, decls), refs) =

68− ReexportResult (moduleName, decls <> concat resolvedRefs) failedRefs

67+ -> ModuleMap (ReexportResult [IdeDeclarationAnn])

68+resolveReexports reexportRefs modules =

69+ Map.mapWithKey (\moduleName decls ->

70+ maybe (ReexportResult decls [])

71+ (resolveReexports' modules decls)

72+ (Map.lookup moduleName reexportRefs)) modules

73+

74+resolveReexports'

75+ :: ModuleMap [IdeDeclarationAnn]

76+ -> [IdeDeclarationAnn]

77+ -> [(P.ModuleName, P.DeclarationRef)]

78+ -> ReexportResult [IdeDeclarationAnn]

79+resolveReexports' modules decls refs =

80+ ReexportResult (decls <> concat resolvedRefs) failedRefs

6981 where

7082 (failedRefs, resolvedRefs) = partitionEithers (resolveRef' <$> refs)

7183 resolveRef' x@(mn, r) = case Map.lookup mn modules of

@@ -78,7 +90,7 @@ resolveRef

7890 -> Either P.DeclarationRef [IdeDeclarationAnn]

7991resolveRef decls ref = case ref of

8092 P.TypeRef tn mdtors ->

81− case findRef (\x -> x ^? _IdeDeclType . ideTypeName <&> (== tn) & fromMaybe False) of

93+ case findRef (anyOf (_IdeDeclType . ideTypeName) (== tn)) of

8294 Nothing -> Left ref

8395 Just d -> Right $ d : case mdtors of

8496 Nothing ->

@@ -88,13 +100,13 @@ resolveRef decls ref = case ref of

88100 findDtors tn

89101 Just dtors -> mapMaybe lookupDtor dtors

90102 P.ValueRef i ->

91− findWrapped (\x -> x ^? _IdeDeclValue . ideValueIdent <&> (== i) & fromMaybe False)

103+ findWrapped (anyOf (_IdeDeclValue . ideValueIdent) (== i))

92104 P.ValueOpRef name ->

93− findWrapped (\x -> x ^? _IdeDeclValueOperator . ideValueOpName <&> (== name) & fromMaybe False)

105+ findWrapped (anyOf (_IdeDeclValueOperator . ideValueOpName) (== name))

94106 P.TypeOpRef name ->

95− findWrapped (\x -> x ^? _IdeDeclTypeOperator . ideTypeOpName <&> (== name) & fromMaybe False)

107+ findWrapped (anyOf (_IdeDeclTypeOperator . ideTypeOpName) (== name))

96108 P.TypeClassRef name ->

97− findWrapped (\case IdeDeclTypeClass n -> n == name; _ -> False)

109+ findWrapped (anyOf (_IdeDeclTypeClass . ideTCName) (== name))

98110 _ ->

99111 Left ref

100112 where

@@ -102,9 +114,9 @@ resolveRef decls ref = case ref of

102114 findRef f = find (f . discardAnn) decls

103115

104116 lookupDtor name =

105− findRef (\x -> x ^? _IdeDeclDataConstructor . ideDtorName <&> (== name) & fromMaybe False)

117+ findRef (anyOf (_IdeDeclDataConstructor . ideDtorName) (== name))

106118

107− findDtors tn = filter (f . discardAnn) decls

108− where

109− f :: IdeDeclaration -> Bool

110− f decl = decl ^? _IdeDeclDataConstructor . ideDtorTypeName <&> (== tn) & fromMaybe False

119+ findDtors tn = filter (anyOf

120+ (idaDeclaration

121+ . _IdeDeclDataConstructor

122+ . ideDtorTypeName) (== tn)) decls

src/Language/PureScript/Ide/State.hs+74−27

@@ -14,6 +14,7 @@

1414

1515{-# LANGUAGE PackageImports #-}

1616{-# LANGUAGE TemplateHaskell #-}

17+{-# LANGUAGE NamedFieldPuns #-}

1718

1819module Language.PureScript.Ide.State

1920 ( getLoadedModulenames

@@ -29,10 +30,12 @@ module Language.PureScript.Ide.State

2930 , populateStage3STM

3031 -- for tests

3132 , resolveOperatorsForModule

33+ , resolveInstances

3234 ) where

3335

3436import Protolude

3537

38+import Control.Arrow

3639import Control.Concurrent.STM

3740import Control.Lens hiding (op, (&))

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

@@ -58,7 +61,7 @@ getLoadedModulenames :: Ide m => m [P.ModuleName]

5861getLoadedModulenames = Map.keys <$> getExternFiles

5962

6063-- | Gets all loaded ExternFiles

61−getExternFiles :: Ide m => m (Map P.ModuleName ExternsFile)

64+getExternFiles :: Ide m => m (ModuleMap ExternsFile)

6265getExternFiles = s1Externs <$> getStage1

6366

6467-- | Insert a Module into Stage1 of the State

@@ -121,7 +124,7 @@ setStage3STM ref s3 = do

121124-- | Checks if the given ModuleName matches the last rebuild cache and if it

122125-- does returns all loaded definitions + the definitions inside the rebuild

123126-- cache

124−getAllModules :: Ide m => Maybe P.ModuleName -> m [Module]

127+getAllModules :: Ide m => Maybe P.ModuleName -> m [(P.ModuleName, [IdeDeclarationAnn])]

125128getAllModules mmoduleName = do

126129 declarations <- s3Declarations <$> getStage3

127130 rebuild <- cachedRebuild

@@ -136,7 +139,7 @@ getAllModules mmoduleName = do

136139 ast =

137140 fromMaybe (Map.empty, Map.empty) (Map.lookup moduleName asts)

138141 cachedModule =

139− snd . annotateModule ast . fst . convertExterns $ ef

142+ annotateModule ast (fst (convertExterns ef))

140143 tmp =

141144 Map.insert moduleName cachedModule declarations

142145 resolved =

@@ -192,43 +195,84 @@ populateStage3 = do

192195 st <- ideStateVar <$> ask

193196 let message duration = "Finished populating Stage3 in " <> displayTimeSpec duration

194197 results <- logPerf message (liftIO (atomically (populateStage3STM st)))

195− traverse_

196− (logWarnN . prettyPrintReexportResult (P.runModuleName . fst))

197− (filter reexportHasFailures results)

198+ void $ Map.traverseWithKey

199+ (\mn -> logWarnN . prettyPrintReexportResult (const (P.runModuleName mn)))

200+ (Map.filter reexportHasFailures results)

198201

199202-- | STM version of populateStage3

200−populateStage3STM :: TVar IdeState -> STM [ReexportResult Module]

203+populateStage3STM

204+ :: TVar IdeState

205+ -> STM (ModuleMap (ReexportResult [IdeDeclarationAnn]))

201206populateStage3STM ref = do

202207 externs <- s1Externs <$> getStage1STM ref

203208 (AstData asts) <- s2AstData <$> getStage2STM ref

204− let modules = Map.map convertExterns externs

205− nModules :: Map P.ModuleName (Module, [(P.ModuleName, P.DeclarationRef)])

206− nModules = Map.mapWithKey

207− (\moduleName (m, refs) ->

208− (fromMaybe m $ annotateModule <$> Map.lookup moduleName asts <*> pure m, refs)) modules

209− -- resolves reexports and discards load failures for now

210− result = resolveReexports (map (snd . fst) nModules) <$> Map.elems nModules

211− resultP = resolveOperators (Map.fromList (reResolved <$> result))

212− setStage3STM ref (Stage3 resultP Nothing)

213− pure result

209+ let (modules, reexportRefs) = (map fst &&& map snd) (Map.map convertExterns externs)

210+ results =

211+ resolveLocations asts modules

212+ & resolveInstances externs

213+ & resolveOperators

214+ & resolveReexports reexportRefs

215+ setStage3STM ref (Stage3 (map reResolved results) Nothing)

216+ pure results

217+

218+

219+resolveLocations

220+ :: ModuleMap (DefinitionSites P.SourceSpan, TypeAnnotations)

221+ -> ModuleMap [IdeDeclarationAnn]

222+ -> ModuleMap [IdeDeclarationAnn]

223+resolveLocations asts =

224+ Map.mapWithKey (\mn decls ->

225+ maybe decls (flip annotateModule decls) (Map.lookup mn asts))

226+

227+resolveInstances

228+ :: ModuleMap P.ExternsFile

229+ -> ModuleMap [IdeDeclarationAnn]

230+ -> ModuleMap [IdeDeclarationAnn]

231+resolveInstances externs declarations =

232+ Map.foldr (flip (foldr go)) declarations

233+ . Map.mapWithKey (\mn ef -> mapMaybe (extractInstances mn) (efDeclarations ef))

234+ $ externs

235+ where

236+ extractInstances mn P.EDInstance{..} =

237+ case edInstanceClassName of

238+ P.Qualified (Just classModule) className ->

239+ Just (IdeInstance mn

240+ edInstanceName

241+ edInstanceTypes

242+ edInstanceConstraints, classModule, className)

243+ _ -> Nothing

244+ extractInstances _ _ = Nothing

245+

246+ go ::

247+ (IdeInstance, P.ModuleName, P.ProperName 'P.ClassName)

248+ -> ModuleMap [IdeDeclarationAnn]

249+ -> ModuleMap [IdeDeclarationAnn]

250+ go (ideInstance, classModule, className) acc' =

251+ let

252+ matchTC =

253+ anyOf (idaDeclaration . _IdeDeclTypeClass . ideTCName) (== className)

254+ updateDeclaration =

255+ mapIf matchTC (idaDeclaration

256+ . _IdeDeclTypeClass

257+ . ideTCInstances

258+ %~ cons ideInstance)

259+ in

260+ acc' & ix classModule %~ updateDeclaration

214261

215262resolveOperators

216− :: Map P.ModuleName [IdeDeclarationAnn]

217− -> Map P.ModuleName [IdeDeclarationAnn]

263+ :: ModuleMap [IdeDeclarationAnn]

264+ -> ModuleMap [IdeDeclarationAnn]

218265resolveOperators modules =

219266 map (resolveOperatorsForModule modules) modules

220267

221268-- | Looks up the types and kinds for operators and assigns them to their

222269-- declarations

223270resolveOperatorsForModule

224− :: Map P.ModuleName [IdeDeclarationAnn]

271+ :: ModuleMap [IdeDeclarationAnn]

225272 -> [IdeDeclarationAnn]

226273 -> [IdeDeclarationAnn]

227−resolveOperatorsForModule modules = map ((over idaDeclaration) resolveOperator)

274+resolveOperatorsForModule modules = map (idaDeclaration %~ resolveOperator)

228275 where

229− hasName :: Eq b => Lens' a b -> b -> a -> Bool

230− hasName l a x = x ^. l == a

231−

232276 getDeclarations :: P.ModuleName -> [IdeDeclaration]

233277 getDeclarations moduleName =

234278 Map.lookup moduleName modules

@@ -239,14 +283,14 @@ resolveOperatorsForModule modules = map ((over idaDeclaration) resolveOperator)

239283 | (P.Qualified (Just mn) (Left ident)) <- op ^. ideValueOpAlias =

240284 let t = getDeclarations mn

241285 & mapMaybe (preview _IdeDeclValue)

242− & filter (hasName ideValueIdent ident)

286+ & filter (anyOf ideValueIdent (== ident))

243287 & map (view ideValueType)

244288 & listToMaybe

245289 in IdeDeclValueOperator (op & ideValueOpType .~ t)

246290 | (P.Qualified (Just mn) (Right dtor)) <- op ^. ideValueOpAlias =

247291 let t = getDeclarations mn

248292 & mapMaybe (preview _IdeDeclDataConstructor)

249− & filter (hasName ideDtorName dtor)

293+ & filter (anyOf ideDtorName (== dtor))

250294 & map (view ideDtorType)

251295 & listToMaybe

252296 in IdeDeclValueOperator (op & ideValueOpType .~ t)

@@ -254,9 +298,12 @@ resolveOperatorsForModule modules = map ((over idaDeclaration) resolveOperator)

254298 | P.Qualified (Just mn) properName <- op ^. ideTypeOpAlias =

255299 let k = getDeclarations mn

256300 & mapMaybe (preview _IdeDeclType)

257− & filter (hasName ideTypeName properName)

301+ & filter (anyOf ideTypeName (== properName))

258302 & map (view ideTypeKind)

259303 & listToMaybe

260304 in IdeDeclTypeOperator (op & ideTypeOpKind .~ k)

261305 resolveOperator x = x

262306

307+

308+mapIf :: Functor f => (b -> Bool) -> (b -> b) -> f b -> f b

309+mapIf p f = map (\x -> if p x then f x else x)

src/Language/PureScript/Ide/Types.hs+23−10

@@ -27,13 +27,14 @@ import qualified Language.PureScript as P

2727import qualified Language.PureScript.Errors.JSON as P

2828

2929type ModuleIdent = Text

30+type ModuleMap a = Map P.ModuleName a

3031

3132data IdeDeclaration

3233 = IdeDeclValue IdeValue

3334 | IdeDeclType IdeType

34− | IdeDeclTypeSynonym IdeSynonym

35+ | IdeDeclTypeSynonym IdeTypeSynonym

3536 | IdeDeclDataConstructor IdeDataConstructor

36− | IdeDeclTypeClass (P.ProperName 'P.ClassName)

37+ | IdeDeclTypeClass IdeTypeClass

3738 | IdeDeclValueOperator IdeValueOperator

3839 | IdeDeclTypeOperator IdeTypeOperator

3940 | IdeDeclKind (P.ProperName 'P.KindName)

@@ -49,7 +50,7 @@ data IdeType = IdeType

4950 , _ideTypeKind :: P.Kind

5051 } deriving (Show, Eq, Ord)

5152

52−data IdeSynonym = IdeSynonym

53+data IdeTypeSynonym = IdeTypeSynonym

5354 { _ideSynonymName :: P.ProperName 'P.TypeName

5455 , _ideSynonymType :: P.Type

5556 } deriving (Show, Eq, Ord)

@@ -60,6 +61,18 @@ data IdeDataConstructor = IdeDataConstructor

6061 , _ideDtorType :: P.Type

6162 } deriving (Show, Eq, Ord)

6263

64+data IdeTypeClass = IdeTypeClass

65+ { _ideTCName :: P.ProperName 'P.ClassName

66+ , _ideTCInstances :: [IdeInstance]

67+ } deriving (Show, Eq, Ord)

68+

69+data IdeInstance = IdeInstance

70+ { _ideInstanceModule :: P.ModuleName

71+ , _ideInstanceName :: P.Ident

72+ , _ideInstanceTypes :: [P.Type]

73+ , _ideInstanceConstraints :: Maybe [P.Constraint]

74+ } deriving (Show, Eq, Ord)

75+

6376data IdeValueOperator = IdeValueOperator

6477 { _ideValueOpName :: P.OpName 'P.ValueOpName

6578 , _ideValueOpAlias :: P.Qualified (Either P.Ident (P.ProperName 'P.ConstructorName))

@@ -79,8 +92,10 @@ data IdeTypeOperator = IdeTypeOperator

7992makePrisms ''IdeDeclaration

8093makeLenses ''IdeValue

8194makeLenses ''IdeType

82−makeLenses ''IdeSynonym

95+makeLenses ''IdeTypeSynonym

8396makeLenses ''IdeDataConstructor

97+makeLenses ''IdeTypeClass

98+makeLenses ''IdeInstance

8499makeLenses ''IdeValueOperator

85100makeLenses ''IdeTypeOperator

86101

@@ -101,11 +116,9 @@ makeLenses ''IdeDeclarationAnn

101116emptyAnn :: Annotation

102117emptyAnn = Annotation Nothing Nothing Nothing

103118

104−type Module = (P.ModuleName, [IdeDeclarationAnn])

105−

106119type DefinitionSites a = Map IdeDeclNamespace a

107120type TypeAnnotations = Map P.Ident P.Type

108−newtype AstData a = AstData (Map P.ModuleName (DefinitionSites a, TypeAnnotations))

121+newtype AstData a = AstData (ModuleMap (DefinitionSites a, TypeAnnotations))

109122 -- ^ SourceSpans for the definition sites of Values and Types aswell as type

110123 -- annotations found in a module

111124 deriving (Show, Eq, Ord, Functor, Foldable)

@@ -147,8 +160,8 @@ emptyStage3 :: Stage3

147160emptyStage3 = Stage3 M.empty Nothing

148161

149162data Stage1 = Stage1

150− { s1Externs :: M.Map P.ModuleName P.ExternsFile

151− , s1Modules :: M.Map P.ModuleName (P.Module, FilePath)

163+ { s1Externs :: ModuleMap P.ExternsFile

164+ , s1Modules :: ModuleMap (P.Module, FilePath)

152165 }

153166

154167data Stage2 = Stage2

@@ -156,7 +169,7 @@ data Stage2 = Stage2

156169 }

157170

158171data Stage3 = Stage3

159− { s3Declarations :: M.Map P.ModuleName [IdeDeclarationAnn]

172+ { s3Declarations :: ModuleMap [IdeDeclarationAnn]

160173 , s3CachedRebuild :: Maybe (P.ModuleName, P.ExternsFile)

161174 }

162175

src/Language/PureScript/Ide/Util.hs+8−7

@@ -33,9 +33,10 @@ module Language.PureScript.Ide.Util

3333import Protolude hiding (decodeUtf8,

3434 encodeUtf8)

3535

36−import Control.Lens ((^.), Iso', iso)

36+import Control.Lens hiding ((&), op)

3737import Data.Aeson

3838import qualified Data.Text as T

39+import qualified Data.Text.Lazy as TL

3940import Data.Text.Lazy.Encoding (decodeUtf8, encodeUtf8)

4041import qualified Language.PureScript as P

4142import Language.PureScript.Ide.Logging

@@ -47,7 +48,7 @@ identifierFromIdeDeclaration d = case d of

4748 IdeDeclType t -> t ^. ideTypeName . properNameT

4849 IdeDeclTypeSynonym s -> s ^. ideSynonymName . properNameT

4950 IdeDeclDataConstructor dtor -> dtor ^. ideDtorName . properNameT

50− IdeDeclTypeClass name -> P.runProperName name

51+ IdeDeclTypeClass tc -> tc ^. ideTCName . properNameT

5152 IdeDeclValueOperator op -> op ^. ideValueOpName & P.runOpName

5253 IdeDeclTypeOperator op -> op ^. ideTypeOpName & P.runOpName

5354 IdeDeclKind name -> P.runProperName name

@@ -67,14 +68,14 @@ completionFromMatch (Match (m, IdeDeclarationAnn ann decl)) =

6768 where

6869 (complIdentifier, complExpandedType) = case decl of

6970 IdeDeclValue v -> (v ^. ideValueIdent . identT, v ^. ideValueType & prettyTypeT)

70− IdeDeclType t -> (t ^. ideTypeName . properNameT, t ^. ideTypeKind & P.prettyPrintKind & toS )

71+ IdeDeclType t -> (t ^. ideTypeName . properNameT, t ^. ideTypeKind & P.prettyPrintKind)

7172 IdeDeclTypeSynonym s -> (s ^. ideSynonymName . properNameT, s ^. ideSynonymType & prettyTypeT)

7273 IdeDeclDataConstructor d -> (d ^. ideDtorName . properNameT, d ^. ideDtorType & prettyTypeT)

73− IdeDeclTypeClass name -> (P.runProperName name, "class")

74+ IdeDeclTypeClass d -> (d ^. ideTCName . properNameT, "type class")

7475 IdeDeclValueOperator (IdeValueOperator op ref precedence associativity typeP) ->

7576 (P.runOpName op, maybe (showFixity precedence associativity (valueOperatorAliasT ref) op) prettyTypeT typeP)

7677 IdeDeclTypeOperator (IdeTypeOperator op ref precedence associativity kind) ->

77− (P.runOpName op, maybe (showFixity precedence associativity (typeOperatorAliasT ref) op) (toS . P.prettyPrintKind) kind)

78+ (P.runOpName op, maybe (showFixity precedence associativity (typeOperatorAliasT ref) op) P.prettyPrintKind kind)

7879 IdeDeclKind k -> (P.runProperName k, "kind")

7980

8081 complModule = P.runModuleName m

@@ -103,10 +104,10 @@ typeOperatorAliasT i =

103104 P.showQualified P.runProperName i

104105

105106encodeT :: (ToJSON a) => a -> Text

106−encodeT = toS . decodeUtf8 . encode

107+encodeT = TL.toStrict . decodeUtf8 . encode

107108

108109decodeT :: (FromJSON a) => Text -> Maybe a

109−decodeT = decode . encodeUtf8 . toS

110+decodeT = decode . encodeUtf8 . TL.fromStrict

110111

111112unwrapPositioned :: P.Declaration -> P.Declaration

112113unwrapPositioned (P.PositionedDeclaration _ _ x) = unwrapPositioned x

src/Language/PureScript/PSString.hs+10

@@ -5,6 +5,7 @@ module Language.PureScript.PSString

55 , toUTF16CodeUnits

66 , decodeString

77 , decodeStringEither

8+ , decodeStringWithReplacement

89 , prettyPrintString

910 , prettyPrintStringJS

1011 , mkString

@@ -52,15 +53,24 @@ newtype PSString = PSString { toUTF16CodeUnits :: [Word16] }

5253instance Show PSString where

5354 show = show . codePoints

5455

56+-- |

5557-- Decode a PSString to a String, representing any lone surrogates as the

5658-- reserved code point with that index. Warning: if there are any lone

5759-- surrogates, converting the result to Text via Data.Text.pack will result in

5860-- loss of information as those lone surrogates will be replaced with U+FFFD

5961-- REPLACEMENT CHARACTER. Because this function requires care to use correctly,

6062-- we do not export it.

63+--

6164codePoints :: PSString -> String

6265codePoints = map (either (chr . fromIntegral) id) . decodeStringEither

6366

67+-- |

68+-- Decode a PSString as UTF-16 text. Lone surrogates will be replaced with

69+-- U+FFFD REPLACEMENT CHARACTER

70+--

71+decodeStringWithReplacement :: PSString -> String

72+decodeStringWithReplacement = map (either (const '\xFFFD') id) . decodeStringEither

73+

6474-- |

6575-- Decode a PSString as UTF-16. Lone surrogates in the input are represented in

6676-- the output with the Left constructor; characters which were successfully

tests/Language/PureScript/Ide/FilterSpec.hs+2

@@ -8,6 +8,8 @@ import Language.PureScript.Ide.Types

88import qualified Language.PureScript as P

99import Test.Hspec

1010

11+type Module = (P.ModuleName, [IdeDeclarationAnn])

12+

1113value :: Text -> IdeDeclarationAnn

1214value s = IdeDeclarationAnn emptyAnn (IdeDeclValue (IdeValue (P.Ident (toS s)) P.REmpty))

1315

tests/Language/PureScript/Ide/Imports/IntegrationSpec.hsdeleted−83

@@ -1,83 +0,0 @@

1−{-# LANGUAGE OverloadedStrings #-}

2−{-# LANGUAGE NoImplicitPrelude #-}

3−module Language.PureScript.Ide.Imports.IntegrationSpec where

4−

5−

6−import Protolude

7−

8−import qualified Data.Text as T

9−import qualified Language.PureScript.Ide.Integration as Integration

10−import Test.Hspec

11−

12−import System.Directory

13−import System.FilePath

14−import System.IO.UTF8 (readUTF8FileT)

15−

16−setup :: IO ()

17−setup = void (Integration.reset *> Integration.loadAll)

18−

19−withSupportFiles :: (FilePath -> FilePath -> IO a) -> IO ()

20−withSupportFiles test = do

21− pdir <- Integration.projectDirectory

22− let sourceFp = pdir </> "src" </> "ImportsSpec.purs"

23− outFp = pdir </> "src" </> "ImportsSpecOut.tmp"

24− Integration.deleteFileIfExists outFp

25− void $ test sourceFp outFp

26−

27−outputFileShouldBe :: [Text] -> IO ()

28−outputFileShouldBe expectation = do

29− outFp <- (</> "src" </> "ImportsSpecOut.tmp") <$> Integration.projectDirectory

30− outRes <- readUTF8FileT outFp

31− shouldBe (T.strip <$> T.lines outRes) expectation

32−

33−spec :: Spec

34−spec = beforeAll_ setup . describe "Adding imports" $ do

35− let

36− sourceFileSkeleton :: [Text] -> [Text]

37− sourceFileSkeleton importSection =

38− [ "module ImportsSpec where" , ""] ++ importSection ++ [ "" , "myId x = x"]

39− it "adds an implicit import" $ do

40− withSupportFiles (Integration.addImplicitImport "ImportsSpec1")

41− outputFileShouldBe (sourceFileSkeleton

42− [ "import ImportsSpec1"

43− ])

44− it "adds an explicit unqualified import" $ do

45− withSupportFiles (Integration.addImport "exportedFunction")

46− outputFileShouldBe (sourceFileSkeleton

47− [ "import ImportsSpec1 (exportedFunction)"

48− ])

49− it "adds an explicit unqualified import (type)" $ do

50− withSupportFiles (Integration.addImport "MyType")

51− outputFileShouldBe (sourceFileSkeleton ["import ImportsSpec1 (MyType)"])

52− it "adds an explicit unqualified import (parameterized type)" $ do

53− withSupportFiles (Integration.addImport "MyParamType")

54− outputFileShouldBe (sourceFileSkeleton ["import ImportsSpec1 (MyParamType)"])

55− it "adds an explicit unqualified import (typeclass)" $ do

56− withSupportFiles (Integration.addImport "ATypeClass")

57− outputFileShouldBe (sourceFileSkeleton ["import ImportsSpec1 (class ATypeClass)"])

58− it "adds an explicit unqualified import (dataconstructor)" $ do

59− withSupportFiles (Integration.addImport "MyJust")

60− outputFileShouldBe (sourceFileSkeleton ["import ImportsSpec1 (MyMaybe(..))"])

61− it "adds an explicit unqualified import (newtype)" $ do

62− withSupportFiles (Integration.addImport "MyNewtype")

63− outputFileShouldBe (sourceFileSkeleton ["import ImportsSpec1 (MyNewtype(..))"])

64− it "adds an explicit unqualified import (typeclass member function)" $ do

65− withSupportFiles (Integration.addImport "typeClassFun")

66− outputFileShouldBe (sourceFileSkeleton ["import ImportsSpec1 (typeClassFun)"])

67− it "doesn't add a newtypes constructor if only the type is exported" $ do

68− withSupportFiles (Integration.addImport "OnlyTypeExported")

69− outputFileShouldBe (sourceFileSkeleton ["import ImportsSpec1 (OnlyTypeExported)"])

70− it "doesn't add an import if the identifier is defined in the module itself" $ do

71− withSupportFiles (Integration.addImport "myId")

72− outputFileShouldBe (sourceFileSkeleton [])

73− it "responds with an error if it's undecidable whether we want a type or constructor" $

74− withSupportFiles (\sourceFp outFp -> do

75− r <- Integration.addImport "SpecialCase" sourceFp outFp

76− shouldBe False (Integration.resultIsSuccess r)

77− shouldBe False =<< doesFileExist outFp)

78− it "responds with an error if the identifier cannot be found and doesn't \

79− \write to the output file" $

80− withSupportFiles (\sourceFp outFp -> do

81− r <- Integration.addImport "doesntExist" sourceFp outFp

82− shouldBe False (Integration.resultIsSuccess r)

83− shouldBe False =<< doesFileExist outFp)

tests/Language/PureScript/Ide/ImportsSpec.hs+66−1

@@ -6,8 +6,12 @@ import Protolude

66import Data.Maybe (fromJust)

88import qualified Language.PureScript as P

9+import Language.PureScript.Ide.Command as Command

10+import Language.PureScript.Ide.Error

911import Language.PureScript.Ide.Imports

12+import qualified Language.PureScript.Ide.Test as Test

1013import Language.PureScript.Ide.Types

14+import System.FilePath

1115import Test.Hspec

1216

1317simpleFile :: [Text]

@@ -22,6 +26,7 @@ splitSimpleFile :: (P.ModuleName, [Text], [Import], [Text])

2226splitSimpleFile = fromRight (sliceImportSection simpleFile)

2327 where

2428 fromRight = fromJust . rightToMaybe

29+

2530withImports :: [Text] -> [Text]

2631withImports is =

2732 take 2 simpleFile ++ is ++ drop 2 simpleFile

@@ -144,7 +149,7 @@ spec = do

144149 addImport imports import' = addExplicitImport' import' moduleName imports

145150 valueImport ident = (IdeDeclValue (IdeValue (P.Ident ident) wildcard))

146151 typeImport name = (IdeDeclType (IdeType (P.ProperName name) P.kindType))

147− classImport name = (IdeDeclTypeClass (P.ProperName name))

152+ classImport name = (IdeDeclTypeClass (IdeTypeClass (P.ProperName name) []))

148153 dtorImport name typeName = (IdeDeclDataConstructor (IdeDataConstructor (P.ProperName name) (P.ProperName typeName) wildcard))

149154 -- expect any list of provided identifiers, when imported, to come out as specified

150155 expectSorted imports expected = shouldBe

@@ -171,3 +176,63 @@ spec = do

171176 -- the imported names don't actually have to exist!

172177 (map (uncurry dtorImport) [("Just", "Maybe"), ("Nothing", "Maybe"), ("SomeOtherConstructor", "SomeDataType")])

173178 ["import Prelude", "import Control.Monad (Maybe(..), SomeDataType(..), ap)"]

179+ describe "importing from a loaded IdeState" importFromIdeState

180+

181+implImport :: Text -> Command

182+implImport mn =

183+ Command.Import ("src" </> "ImportsSpec.purs") Nothing [] (Command.AddImplicitImport (Test.mn mn))

184+

185+addExplicitImport :: Text -> Command

186+addExplicitImport i =

187+ Command.Import ("src" </> "ImportsSpec.purs") Nothing [] (Command.AddImportForIdentifier i)

188+

189+importShouldBe :: [Text] -> [Text] -> Expectation

190+importShouldBe res importSection =

191+ res `shouldBe` [ "module ImportsSpec where" , ""] ++ importSection ++ [ "" , "myId x = x"]

192+

193+runIdeLoaded :: Command -> IO (Either PscIdeError Success)

194+runIdeLoaded c = do

195+ ([_, result], _) <- Test.inProject $ Test.runIde [Command.LoadSync [] , c]

196+ pure result

197+

198+importFromIdeState :: Spec

199+importFromIdeState = do

200+ it "adds an implicit import" $ do

201+ Right (MultilineTextResult result) <-

202+ runIdeLoaded (implImport "ImportsSpec1")

203+ result `importShouldBe` [ "import ImportsSpec1" ]

204+ it "adds an explicit unqualified import" $ do

205+ Right (MultilineTextResult result) <- runIdeLoaded (addExplicitImport "exportedFunction")

206+ result `importShouldBe` [ "import ImportsSpec1 (exportedFunction)" ]

207+ it "adds an explicit unqualified import (type)" $ do

208+ Right (MultilineTextResult result) <- runIdeLoaded (addExplicitImport "MyType")

209+ result `importShouldBe` [ "import ImportsSpec1 (MyType)" ]

210+ it "adds an explicit unqualified import (parameterized type)" $ do

211+ Right (MultilineTextResult result) <- runIdeLoaded (addExplicitImport "MyParamType")

212+ result `importShouldBe` [ "import ImportsSpec1 (MyParamType)" ]

213+ it "adds an explicit unqualified import (typeclass)" $ do

214+ Right (MultilineTextResult result) <- runIdeLoaded (addExplicitImport "ATypeClass")

215+ result `importShouldBe` [ "import ImportsSpec1 (class ATypeClass)" ]

216+ it "adds an explicit unqualified import (dataconstructor)" $ do

217+ Right (MultilineTextResult result) <- runIdeLoaded (addExplicitImport "MyJust")

218+ result `importShouldBe` [ "import ImportsSpec1 (MyMaybe(..))" ]

219+ it "adds an explicit unqualified import (newtype)" $ do

220+ Right (MultilineTextResult result) <- runIdeLoaded (addExplicitImport "MyNewtype")

221+ result `importShouldBe` [ "import ImportsSpec1 (MyNewtype(..))" ]

222+ it "adds an explicit unqualified import (typeclass member function)" $ do

223+ Right (MultilineTextResult result) <- runIdeLoaded (addExplicitImport "typeClassFun")

224+ result `importShouldBe` [ "import ImportsSpec1 (typeClassFun)" ]

225+ it "doesn't add a newtypes constructor if only the type is exported" $ do

226+ Right (MultilineTextResult result) <-

227+ runIdeLoaded (addExplicitImport "OnlyTypeExported")

228+ result `importShouldBe` [ "import ImportsSpec1 (OnlyTypeExported)" ]

229+ it "doesn't add an import if the identifier is defined in the module itself" $ do

230+ Right (MultilineTextResult result) <- runIdeLoaded (addExplicitImport "myId")

231+ result `importShouldBe` []

232+ it "responds with an error if it's undecidable whether we want a type or constructor" $ do

233+ result <- runIdeLoaded (addExplicitImport "SpecialCase")

234+ result `shouldSatisfy` isLeft

235+ it "responds with an error if the identifier cannot be found and doesn't \

236+ \write to the output file" $ do

237+ result <- runIdeLoaded (addExplicitImport "doesnExist")

238+ result `shouldSatisfy` isLeft

tests/Language/PureScript/Ide/Integration.hsdeleted−280

@@ -1,280 +0,0 @@

1−-----------------------------------------------------------------------------

2−--

3−-- Module : Language.PureScript.Ide.Integration

4−-- Description : A psc-ide client for use in integration tests

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−-- A psc-ide client for use in integration tests

13−-----------------------------------------------------------------------------

14−

15−{-# LANGUAGE OverloadedStrings #-}

16−{-# LANGUAGE ScopedTypeVariables #-}

17−{-# LANGUAGE NoImplicitPrelude #-}

18−module Language.PureScript.Ide.Integration

19− (

20− -- managing the server process

21− startServer

22− , withServer

23− , stopServer

24− , quitServer

25− -- util

26− , compileTestProject

27− , deleteOutputFolder

28− , projectDirectory

29− , deleteFileIfExists

30− -- sending commands

31− , addImport

32− , addImplicitImport

33− , loadAll

34− , loadModule

35− , loadModules

36− , getCwd

37− , getFlexCompletions

38− , getFlexCompletionsInModule

39− , getType

40− , rebuildModule

41− , reset

42− -- checking results

43− , resultIsSuccess

44− , parseCompletions

45− , parseTextResult

46− ) where

47−

48−import Protolude

49−import Data.Maybe (fromJust)

50−

51−import Data.Aeson

52−import Data.Aeson.Types

53−import qualified Data.Text.Encoding as T

54−import qualified Data.ByteString.Char8 as BS8

55−import qualified Data.ByteString.Lazy.Char8 as BSL8

56−import qualified Data.Vector as V

57−import qualified Language.PureScript as P

58−import System.Directory

59−import System.FilePath

60−import System.IO

61−import System.IO.Error (mkIOError, userErrorType)

62−import System.Process

63−

64−projectDirectory :: IO FilePath

65−projectDirectory = do

66− cd <- getCurrentDirectory

67− return $ cd </> "tests" </> "support" </> "pscide"

68−

69−startServer :: IO ProcessHandle

70−startServer = do

71− pdir <- projectDirectory

72− -- Turn off filewatching since it creates race condition in a testing environment

73− (_, _, _, procHandle) <- createProcess $

74− (shell "psc-ide-server --no-watch src/*.purs") {cwd = Just pdir}

75− threadDelay 2000000 -- give the server 2s to start up

76− return procHandle

77−

78−stopServer :: ProcessHandle -> IO ()

79−stopServer = terminateProcess

80−

81−withServer :: IO a -> IO a

82−withServer s = do

83− _ <- startServer

84− started <- tryNTimes 5 (rightToMaybe <$> (try getCwd :: IO (Either SomeException Text)))

85− when (isNothing started) $

86− throwIO (mkIOError userErrorType "psc-ide-server didn't start in time" Nothing Nothing)

87− r <- s

88− quitServer

89− pure r

90−

91−-- project management utils

92−

93−compileTestProject :: IO Bool

94−compileTestProject = do

95− pdir <- projectDirectory

96− (_, _, _, procHandle) <- createProcess $

97− (shell . toS $ "psc " <> fileGlob) { cwd = Just pdir }

98− r <- tryNTimes 10 (getProcessExitCode procHandle)

99− pure (fromMaybe False (isSuccess <$> r))

100−

101−tryNTimes :: Int -> IO (Maybe a) -> IO (Maybe a)

102−tryNTimes 0 _ = pure Nothing

103−tryNTimes n action = do

104− r <- action

105− case r of

106− Nothing -> do

107− threadDelay 500000

108− tryNTimes (n - 1) action

109− Just a -> pure (Just a)

110−

111−deleteOutputFolder :: IO ()

112−deleteOutputFolder = do

113− odir <- fmap (</> "output") projectDirectory

114− whenM (doesDirectoryExist odir) (removeDirectoryRecursive odir)

115−

116−deleteFileIfExists :: FilePath -> IO ()

117−deleteFileIfExists fp = whenM (doesFileExist fp) (removeFile fp)

118−

119−isSuccess :: ExitCode -> Bool

120−isSuccess ExitSuccess = True

121−isSuccess (ExitFailure _) = False

122−

123−fileGlob :: Text

124−fileGlob = "\"src/**/*.purs\""

125−

126−-- Integration Testing API

127−

128−sendCommand :: Value -> IO Text

129−sendCommand v = do

130− (Just hin, Just hout, _, _) <-

131− createProcess ((proc "psc-ide-client" []) {std_in=CreatePipe, std_out=CreatePipe})

132−

133− hSetEncoding hin utf8

134− hSetEncoding hout utf8

135−

136− BS8.hPutStrLn hin (BSL8.toStrict (encode v))

137− hFlush hin

138− T.decodeUtf8 <$> BS8.hGetLine hout

139−

140−quitServer :: IO ()

141−quitServer = do

142− let quitCommand = object ["command" .= ("quit" :: Text)]

143− _ <- try $ sendCommand quitCommand :: IO (Either SomeException Text)

144− return ()

145−

146−reset :: IO ()

147−reset = do

148− let resetCommand = object ["command" .= ("reset" :: Text)]

149− _ <- try $ sendCommand resetCommand :: IO (Either SomeException Text)

150− return ()

151−

152−getCwd :: IO Text

153−getCwd = do

154− let cwdCommand = object ["command" .= ("cwd" :: Text)]

155− sendCommand cwdCommand

156−

157−loadModule :: Text -> IO Text

158−loadModule m = loadModules [m]

159−

160−loadModules :: [Text] -> IO Text

161−loadModules = sendCommand . load

162−

163−loadAll :: IO Text

164−loadAll = sendCommand (load [])

165−

166−getFlexCompletions :: Text -> IO [(Text, Text, Text, Maybe P.SourceSpan)]

167−getFlexCompletions q = parseCompletions <$> sendCommand (completion [] (Just (flexMatcher q)) Nothing)

168−

169−getFlexCompletionsInModule :: Text -> Text -> IO [(Text, Text, Text, Maybe P.SourceSpan)]

170−getFlexCompletionsInModule q m = parseCompletions <$> sendCommand (completion [] (Just (flexMatcher q)) (Just m))

171−

172−getType :: Text -> IO [(Text, Text, Text, Maybe P.SourceSpan)]

173−getType q = parseCompletions <$> sendCommand (typeC q [])

174−

175−addImport :: Text -> FilePath -> FilePath -> IO Text

176−addImport identifier fp outfp = sendCommand (addImportC identifier fp outfp)

177−

178−addImplicitImport :: Text -> FilePath -> FilePath -> IO Text

179−addImplicitImport mn fp outfp = sendCommand (addImplicitImportC mn fp outfp)

180−

181−rebuildModule :: FilePath -> IO Text

182−rebuildModule m = sendCommand (rebuildC m Nothing)

183−

184−-- Command Encoding

185−

186−commandWrapper :: Text -> Value -> Value

187−commandWrapper c p = object ["command" .= c, "params" .= p]

188−

189−load :: [Text] -> Value

190−load ms = commandWrapper "load" (object ["modules" .= ms])

191−

192−typeC :: Text -> [Value] -> Value

193−typeC q filters = commandWrapper "type" (object ["search" .= q, "filters" .= filters])

194−

195−addImportC :: Text -> FilePath -> FilePath -> Value

196−addImportC identifier = addImportW $

197− object [ "importCommand" .= ("addImport" :: Text)

198− , "identifier" .= identifier

199− ]

200−

201−addImplicitImportC :: Text -> FilePath -> FilePath -> Value

202−addImplicitImportC mn = addImportW $

203− object [ "importCommand" .= ("addImplicitImport" :: Text)

204− , "module" .= mn

205− ]

206−

207−rebuildC :: FilePath -> Maybe FilePath -> Value

208−rebuildC file outFile =

209− commandWrapper "rebuild" (object [ "file" .= file

210− , "outfile" .= outFile

211− ])

212−

213−addImportW :: Value -> FilePath -> FilePath -> Value

214−addImportW importCommand fp outfp =

215− commandWrapper "import" (object [ "file" .= fp

216− , "outfile" .= outfp

217− , "importCommand" .= importCommand

218− ])

219−

220−

221−completion :: [Value] -> Maybe Value -> Maybe Text -> Value

222−completion filters matcher currentModule =

223− let

224− matcher' = case matcher of

225− Nothing -> []

226− Just m -> ["matcher" .= m]

227− currentModule' = case currentModule of

228− Nothing -> []

229− Just cm -> ["currentModule" .= cm]

230− in

231− commandWrapper "complete" (object $ "filters" .= filters : matcher' ++ currentModule' )

232−

233−flexMatcher :: Text -> Value

234−flexMatcher q = object [ "matcher" .= ("flex" :: Text)

235− , "params" .= object ["search" .= q]

236− ]

237−

238−-- Result parsing

239−

240−unwrapResult :: Value -> Parser (Either Text Value)

241−unwrapResult = withObject "result" $ \o -> do

242− (rt :: Text) <- o .: "resultType"

243− case rt of

244− "error" -> do

245− res <- o .: "result"

246− withArray "errors" (fmap (Left . fold) . traverse (withObject "error" (.: "message"))) res

247− "success" -> do

248− res <- o .: "result"

249− pure (Right res)

250− _ -> mzero

251−

252−withResult :: (Value -> Parser a) -> Value -> Parser (Either Text a)

253−withResult p v = do

254− r <- unwrapResult v

255− case r of

256− Left err -> pure (Left err)

257− Right res -> Right <$> p res

258−

259−completionParser :: Value -> Parser [(Text, Text, Text, Maybe P.SourceSpan)]

260−completionParser = withArray "res" $ \cs ->

261− mapM (withObject "completion" $ \o -> do

262− ident <- o .: "identifier"

263− module' <- o .: "module"

264− ty <- o .: "type"

265− ss <- o .: "definedAt"

266− pure (module', ident, ty, ss)) (V.toList cs)

267−

268−valueFromText :: Text -> Value

269−valueFromText = fromJust . decode . toS

270−

271−resultIsSuccess :: Text -> Bool

272−resultIsSuccess = isRight . join . first toS . parseEither unwrapResult . valueFromText

273−

274−parseCompletions :: Text -> [(Text, Text, Text, Maybe P.SourceSpan)]

275−parseCompletions s =

276− fromJust $ join (rightToMaybe <$> parseMaybe (withResult completionParser) (valueFromText s))

277−

278−parseTextResult :: Text -> Text

279−parseTextResult s =

280− fromJust $ join (rightToMaybe <$> parseMaybe (withResult (withText "tr" pure)) (valueFromText s))

tests/Language/PureScript/Ide/MatcherSpec.hs−13

@@ -6,7 +6,6 @@ module Language.PureScript.Ide.MatcherSpec where

66import Protolude

88import qualified Language.PureScript as P

9−import Language.PureScript.Ide.Integration

109import Language.PureScript.Ide.Matcher

1110import Language.PureScript.Ide.Types

1211import Language.PureScript.Ide.Util

@@ -26,9 +25,6 @@ completions = [firstResult, secondResult, fiult]

2625runFlex :: Text -> [Match IdeDeclarationAnn]

2726runFlex s = runMatcher (flexMatcher s) completions

2827

29−setup :: IO ()

30−setup = reset *> void loadAll

31−

3228spec :: Spec

3329spec = do

3430 describe "Flex Matcher" $ do

@@ -38,12 +34,3 @@ spec = do

3834 runFlex "firstResult" `shouldBe` [firstResult]

3935 it "scores short matches higher and sorts accordingly" $

4036 runFlex "filt" `shouldBe` [fiult, firstResult]

41−

42− beforeAll_ setup . describe "Integration Tests: Flex Matcher" $ do

43− it "doesn't match on an empty string" $ do

44− cs <- getFlexCompletions ""

45− cs `shouldBe` []

46− it "matches on equality" $ do

47− -- ignore any position information

48− (m, i, t, _) : _ <- getFlexCompletions "const"

49− (m, i, t) `shouldBe` ("MatcherSpec", "const", "∀ a b. a → b → a")

tests/Language/PureScript/Ide/RebuildSpec.hs+41−37

@@ -4,54 +4,58 @@ module Language.PureScript.Ide.RebuildSpec where

55import Protolude

7−import qualified Language.PureScript.Ide.Integration as Integration

7+import Language.PureScript.Ide.Command

8+import Language.PureScript.Ide.Matcher

9+import Language.PureScript.Ide.Types

10+import qualified Language.PureScript.Ide.Test as Test

811import System.FilePath

912import Test.Hspec

1013

11−shouldBeSuccess :: Text -> IO ()

12−shouldBeSuccess = shouldBe True . Integration.resultIsSuccess

14+load :: [Text] -> Command

15+load = LoadSync . map Test.mn

1316

14−shouldBeFailure :: Text -> IO ()

15−shouldBeFailure = shouldBe False . Integration.resultIsSuccess

17+rebuild :: FilePath -> Command

18+rebuild fp = Rebuild ("src" </> fp)

19+

20+rebuildSync :: FilePath -> Command

21+rebuildSync fp = RebuildSync ("src" </> fp)

1622

1723spec :: Spec

18−spec = before_ Integration.reset . describe "Rebuilding single modules" $ do

24+spec = describe "Rebuilding single modules" $ do

1925 it "rebuilds a correct module without dependencies successfully" $ do

20− _ <- Integration.loadModule "RebuildSpecSingleModule"

21− pdir <- Integration.projectDirectory

22− let file = pdir </> "src" </> "RebuildSpecSingleModule.purs"

23− Integration.rebuildModule file >>= shouldBeSuccess

26+ ([_, result], _) <- Test.inProject $

27+ Test.runIde [ load ["RebuildSpecSingleModule"]

28+ , rebuild "RebuildSpecSingleModule.purs"

29+ ]

30+ result `shouldSatisfy` isRight

2431 it "fails to rebuild an incorrect module without dependencies and returns the errors" $ do

25− pdir <- Integration.projectDirectory

26− let file = pdir </> "src" </> "RebuildSpecSingleModule.fail"

27− Integration.rebuildModule file >>= shouldBeFailure

32+ ([result], _) <- Test.inProject $

33+ Test.runIde [ rebuild "RebuildSpecSingleModule.fail" ]

34+ result `shouldSatisfy` isLeft

2835 it "rebuilds a correct module with its dependencies successfully" $ do

29− _ <- Integration.loadModules ["RebuildSpecWithDeps", "RebuildSpecDep"]

30− pdir <- Integration.projectDirectory

31− let file = pdir </> "src" </> "RebuildSpecWithDeps.purs"

32− Integration.rebuildModule file >>= shouldBeSuccess

36+ ([_, result], _) <- Test.inProject $

37+ Test.runIde [ load ["RebuildSpecWithDeps", "RebuildSpecDep"]

38+ , rebuild "RebuildSpecWithDeps.purs"

39+ ]

40+ result `shouldSatisfy` isRight

3341 it "rebuilds a correct module that has reverse dependencies" $ do

34− _ <- Integration.loadModule "RebuildSpecWithDeps"

35− pdir <- Integration.projectDirectory

36− let file = pdir </> "src" </> "RebuildSpecDep.purs"

37− Integration.rebuildModule file >>= shouldBeSuccess

42+ ([_, result], _) <- Test.inProject $

43+ Test.runIde [ load ["RebuildSpecWithDeps"], rebuild "RebuildSpecDep.purs" ]

44+ result `shouldSatisfy` isRight

3845 it "fails to rebuild a module if its dependencies are not loaded" $ do

39− _ <- Integration.loadModule "RebuildSpecWithDeps"

40− pdir <- Integration.projectDirectory

41− let file = pdir </> "src" </> "RebuildSpecWithDeps.purs"

42− Integration.rebuildModule file >>= shouldBeFailure

46+ ([_, result], _) <- Test.inProject $

47+ Test.runIde [ load ["RebuildSpecWithDeps"], rebuild "RebuildSpecWithDeps.purs" ]

48+ result `shouldSatisfy` isLeft

4349 it "rebuilds a correct module with a foreign file" $ do

44− _ <- Integration.loadModule "RebuildSpecWithForeign"

45− pdir <- Integration.projectDirectory

46− let file = pdir </> "src" </> "RebuildSpecWithForeign.purs"

47− Integration.rebuildModule file >>= shouldBeSuccess

50+ ([_, result], _) <- Test.inProject $

51+ Test.runIde [ load ["RebuildSpecWithForeign"], rebuild "RebuildSpecWithForeign.purs" ]

52+ result `shouldSatisfy` isRight

4853 it "fails to rebuild a module with a foreign import but no file" $ do

49− pdir <- Integration.projectDirectory

50− let file = pdir </> "src" </> "RebuildSpecWithMissingForeign.fail"

51− Integration.rebuildModule file >>= shouldBeFailure

54+ ([result], _) <- Test.inProject $

55+ Test.runIde [ rebuild "RebuildSpecWithMissingForeign.fail" ]

56+ result `shouldSatisfy` isLeft

5257 it "completes a hidden identifier after rebuilding" $ do

53− pdir <- Integration.projectDirectory

54− let file = pdir </> "src" </> "RebuildSpecWithHiddenIdent.purs"

55− Integration.rebuildModule file >>= shouldBeSuccess

56− res <- Integration.getFlexCompletionsInModule "hid" "RebuildSpecWithHiddenIdent"

57− shouldBe False (null res)

58+ ([_, (Right (CompletionResult [ result ]))], _) <- Test.inProject $

59+ Test.runIde [ rebuildSync "RebuildSpecWithHiddenIdent.purs"

60+ , Complete [] (flexMatcher "hid") (Just (Test.mn "RebuildSpecWithHiddenIdent"))]

61+ complIdentifier result `shouldBe` "hidden"

tests/Language/PureScript/Ide/ReexportsSpec.hs+15−13

@@ -10,6 +10,8 @@ import Language.PureScript.Ide.Types

1010import qualified Language.PureScript as P

1111import Test.Hspec

1212

13+type Module = (P.ModuleName, [IdeDeclarationAnn])

14+

1315m :: Text -> P.ModuleName

1416m = P.moduleNameFromString

1517

@@ -19,32 +21,32 @@ d = IdeDeclarationAnn emptyAnn

1921valueA, typeA, classA, dtorA1, dtorA2 :: IdeDeclarationAnn

2022valueA = d (IdeDeclValue (IdeValue (P.Ident "valueA") P.REmpty))

2123typeA = d (IdeDeclType (IdeType(P.ProperName "TypeA") P.kindType))

22−classA = d (IdeDeclTypeClass (P.ProperName "ClassA"))

24+classA = d (IdeDeclTypeClass (IdeTypeClass (P.ProperName "ClassA") []))

2325dtorA1 = d (IdeDeclDataConstructor (IdeDataConstructor (P.ProperName "DtorA1") (P.ProperName "TypeA") P.REmpty))

2426dtorA2 = d (IdeDeclDataConstructor (IdeDataConstructor (P.ProperName "DtorA2") (P.ProperName "TypeA") P.REmpty))

2527

26−env :: Map P.ModuleName [IdeDeclarationAnn]

28+env :: ModuleMap [IdeDeclarationAnn]

2729env = Map.fromList

2830 [ (m "A", [valueA, typeA, classA, dtorA1, dtorA2])

2931 ]

3032

3133type Refs = [(P.ModuleName, P.DeclarationRef)]

3234

33−succTestCases :: [(Text, Module, Refs, Module)]

35+succTestCases :: [(Text, [IdeDeclarationAnn], Refs, [IdeDeclarationAnn])]

3436succTestCases =

35− [ ("resolves a value reexport", (m "C", []), [(m "A", P.ValueRef (P.Ident "valueA"))], (m "C", [valueA]))

37+ [ ("resolves a value reexport", [], [(m "A", P.ValueRef (P.Ident "valueA"))], [valueA])

3638 , ("resolves a type reexport with explicit data constructors"

37− , (m "C", []), [(m "A", P.TypeRef (P.ProperName "TypeA") (Just [P.ProperName "DtorA1"]))], (m "C", [typeA, dtorA1]))

39+ , [], [(m "A", P.TypeRef (P.ProperName "TypeA") (Just [P.ProperName "DtorA1"]))], [typeA, dtorA1])

3840 , ("resolves a type reexport with implicit data constructors"

39− , (m "C", []), [(m "A", P.TypeRef (P.ProperName "TypeA") Nothing)], (m "C", [typeA, dtorA1, dtorA2]))

40− , ("resolves a class reexport", (m "C", []), [(m "A", P.TypeClassRef (P.ProperName "ClassA"))], (m "C", [classA]))

41+ , [], [(m "A", P.TypeRef (P.ProperName "TypeA") Nothing)], [typeA, dtorA1, dtorA2])

42+ , ("resolves a class reexport", [], [(m "A", P.TypeClassRef (P.ProperName "ClassA"))], [classA])

4143 ]

4244

43−failTestCases :: [(Text, Module, Refs)]

45+failTestCases :: [(Text, [IdeDeclarationAnn], Refs)]

4446failTestCases =

45− [ ("fails to resolve a non existing value", (m "C", []), [(m "A", P.ValueRef (P.Ident "valueB"))])

46− , ("fails to resolve a non existing type reexport" , (m "C", []), [(m "A", P.TypeRef (P.ProperName "TypeB") Nothing)])

47− , ("fails to resolve a non existing class reexport", (m "C", []), [(m "A", P.TypeClassRef (P.ProperName "ClassB"))])

47+ [ ("fails to resolve a non existing value", [], [(m "A", P.ValueRef (P.Ident "valueB"))])

48+ , ("fails to resolve a non existing type reexport" , [], [(m "A", P.TypeRef (P.ProperName "TypeB") Nothing)])

49+ , ("fails to resolve a non existing class reexport", [], [(m "A", P.TypeClassRef (P.ProperName "ClassB"))])

4850 ]

4951

5052spec :: Spec

@@ -52,12 +54,12 @@ spec = do

5254 describe "Successful Reexports" $

5355 for_ succTestCases $ \(desc, initial, refs, result) ->

5456 it (toS desc) $ do

55− let reResult = resolveReexports env (initial, refs)

57+ let reResult = resolveReexports' env initial refs

5658 reResolved reResult `shouldBe` result

5759 reResult `shouldSatisfy` not . reexportHasFailures

5860 describe "Failed Reexports" $

5961 for_ failTestCases $ \(desc, initial, refs) ->

6062 it (toS desc) $ do

61− let reResult = resolveReexports env (initial, refs)

63+ let reResult = resolveReexports' env initial refs

6264 reFailed reResult `shouldBe` refs

6365 reResult `shouldSatisfy` reexportHasFailures

tests/Language/PureScript/Ide/SourceFile/IntegrationSpec.hsdeleted−41

@@ -1,41 +0,0 @@

1−{-# LANGUAGE OverloadedStrings #-}

2−{-# LANGUAGE NoImplicitPrelude #-}

3−module Language.PureScript.Ide.SourceFile.IntegrationSpec where

4−

5−

6−import Protolude

7−

8−import qualified Data.Text as T

9−import qualified Language.PureScript.Ide.Integration as Integration

10−import qualified Language.PureScript as P

11−import Test.Hspec

12−

13−setup :: IO ()

14−setup = void (Integration.reset *> Integration.loadAll)

15−

16−spec :: Spec

17−spec = beforeAll_ setup $

18− describe "Sourcefile Integration" $ do

19− it "finds a value declaration" $

20− testCase "sfValue" (3, 1)

21− it "finds a type declaration" $

22− testCase "SFType" (5, 1)

23− it "finds a data declaration" $

24− testCase "SFData" (7, 1)

25− it "finds a data constructor" $

26− testCase "SFOne" (7, 1)

27− it "finds a typeclass" $

28− testCase "SFClass" (9, 1)

29− it "finds a typeclass member" $

30− testCase "sfShow" (10, 3)

31−

32−testCase :: Text -> (Int, Int) -> IO ()

33−testCase s (x, y) = do

34− P.SourceSpan f (P.SourcePos l c) _ <- getLocation s

35− toS f `shouldSatisfy` T.isSuffixOf "SourceFileSpec.purs"

36− (l, c) `shouldBe` (x, y)

37−

38−getLocation :: Text -> IO P.SourceSpan

39−getLocation s = do

40− (_, _, _, Just location) : _ <- Integration.getType s

41− pure location

tests/Language/PureScript/Ide/SourceFileSpec.hs+42

@@ -5,8 +5,10 @@ module Language.PureScript.Ide.SourceFileSpec where

55import Protolude

77import qualified Language.PureScript as P

8+import Language.PureScript.Ide.Command

89import Language.PureScript.Ide.SourceFile

910import Language.PureScript.Ide.Types

11+import Language.PureScript.Ide.Test

1012import Test.Hspec

1113

1214span0, span1, span2 :: P.SourceSpan

@@ -52,3 +54,43 @@ spec = do

5254 describe "Type annotations" $ do

5355 it "extracts a type annotation" $

5456 extractTypeAnnotations [typeAnnotation1] `shouldBe` [(P.Ident "value1", P.REmpty)]

57+ describe "Finding Source Spans for identifiers" $ do

58+ it "finds a value declaration" $ do

59+ Just r <- getLocation "sfValue"

60+ r `shouldBe` valueSS

61+ it "finds a synonym declaration" $ do

62+ Just r <- getLocation "SFType"

63+ r `shouldBe` synonymSS

64+ it "finds a data declaration and its constructors" $ do

65+ rs <- traverse getLocation ["SFData", "SFOne", "SFTwo", "SFThree"]

66+ traverse_ (`shouldBe` (Just typeSS)) rs

67+ it "finds a class declaration" $ do

68+ Just r <- getLocation "SFClass"

69+ r `shouldBe` classSS

70+

71+getLocation :: Text -> IO (Maybe P.SourceSpan)

72+getLocation s = do

73+ ([Right (CompletionResult [c])], _) <-

74+ runIde' defConfig ideState [Type s [] Nothing]

75+ pure (complLocation c)

76+ where

77+ ideState = emptyIdeState `s3`

78+ [ ("Test",

79+ [ ideValue "sfValue" Nothing `annLoc` valueSS

80+ , ideSynonym "SFType" P.tyString `annLoc` synonymSS

81+ , ideType "SFData" Nothing `annLoc` typeSS

82+ , ideDtor "SFOne" "SFData" Nothing `annLoc` typeSS

83+ , ideDtor "SFTwo" "SFData" Nothing `annLoc` typeSS

84+ , ideDtor "SFThree" "SFData" Nothing `annLoc` typeSS

85+ , ideTypeClass "SFClass" [] `annLoc` classSS

86+ ])

87+ ]

88+

89+valueSS, synonymSS, typeSS, classSS :: P.SourceSpan

90+valueSS = ss 3 1

91+synonymSS = ss 5 1

92+typeSS = ss 7 1

93+classSS = ss 8 1

94+

95+ss :: Int -> Int -> P.SourceSpan

96+ss x y = P.SourceSpan "Test.purs" (P.SourcePos x y) (P.SourcePos x y)

tests/Language/PureScript/Ide/StateSpec.hs+53−13

@@ -3,6 +3,7 @@

33module Language.PureScript.Ide.StateSpec where

55import Protolude

6+import Control.Lens hiding ((&))

67import Language.PureScript.Ide.Types

78import Language.PureScript.Ide.State

89import qualified Language.PureScript as P

@@ -21,7 +22,7 @@ typeOperator :: Maybe P.Kind -> IdeDeclarationAnn

2122typeOperator =

2223 d . IdeDeclTypeOperator . IdeTypeOperator (P.OpName ":") (P.Qualified (Just (mn "Test")) (P.ProperName "List")) 2 P.Infix

2324

24−testModule :: Module

25+testModule :: (P.ModuleName, [IdeDeclarationAnn])

2526testModule = (mn "Test", [ d (IdeDeclValue (IdeValue (P.Ident "function") P.REmpty))

2627 , d (IdeDeclDataConstructor (IdeDataConstructor (P.ProperName "Cons") (P.ProperName "List") (P.REmpty)))

2728 , d (IdeDeclType (IdeType (P.ProperName "List") P.kindType))

@@ -34,18 +35,57 @@ d :: IdeDeclaration -> IdeDeclarationAnn

3435d = IdeDeclarationAnn emptyAnn

3536

3637mn :: Text -> P.ModuleName

37−mn = P.moduleNameFromString . toS

38+mn = P.moduleNameFromString

3839

39−testState :: Map P.ModuleName [IdeDeclarationAnn]

40−testState = Map.fromList

41− [ testModule

42− ]

40+testState :: ModuleMap [IdeDeclarationAnn]

41+testState = Map.fromList [testModule]

42+

43+-- The accessor fields for these data types are not exposed unfortunately

44+ef :: P.ExternsFile

45+ef = P.ExternsFile

46+ -- { efVersion =

47+ mempty

48+ -- , efModuleName =

49+ (mn "InstanceModule")

50+ -- , efExports =

51+ mempty

52+ -- , efImports =

53+ mempty

54+ -- , efFixities =

55+ mempty

56+ -- , efTypeFixities =

57+ mempty

58+ --, efDeclarations =

59+ [ P.EDInstance

60+ -- { edInstanceClassName =

61+ (P.Qualified (Just (mn "ClassModule")) (P.ProperName "MyClass"))

62+ -- , edInstanceName =

63+ (P.Ident "myClassInstance")

64+ -- , edInstanceTypes =

65+ mempty

66+ -- , edInstanceConstraints =

67+ mempty

68+ -- }

69+ ]

70+ -- }

71+

72+moduleMap :: ModuleMap [IdeDeclarationAnn]

73+moduleMap = Map.singleton (mn "ClassModule") [d (IdeDeclTypeClass (IdeTypeClass (P.ProperName "MyClass") []))]

74+

75+ideInstance :: IdeInstance

76+ideInstance = IdeInstance (mn "InstanceModule") (P.Ident "myClassInstance") mempty mempty

4377

4478spec :: Spec

45−spec = describe "resolving operators" $ do

46− it "resolves the type for a value operator" $

47− resolveOperatorsForModule testState (snd testModule) `shouldSatisfy` elem (valueOperator (Just P.REmpty))

48− it "resolves the type for a constructor operator" $

49− resolveOperatorsForModule testState (snd testModule) `shouldSatisfy` elem (ctorOperator (Just P.REmpty))

50− it "resolves the kind for a type operator" $

51− resolveOperatorsForModule testState (snd testModule) `shouldSatisfy` elem (typeOperator (Just P.kindType))

79+spec = do

80+ describe "resolving operators" $ do

81+ it "resolves the type for a value operator" $

82+ resolveOperatorsForModule testState (snd testModule) `shouldSatisfy` elem (valueOperator (Just P.REmpty))

83+ it "resolves the type for a constructor operator" $

84+ resolveOperatorsForModule testState (snd testModule) `shouldSatisfy` elem (ctorOperator (Just P.REmpty))

85+ it "resolves the kind for a type operator" $

86+ resolveOperatorsForModule testState (snd testModule) `shouldSatisfy` elem (typeOperator (Just P.kindType))

87+ describe "resolving instances for type classes" $ do

88+ it "resolves an instance for an existing type class" $ do

89+ resolveInstances (Map.singleton (mn "InstanceModule") ef) moduleMap

90+ `shouldSatisfy`

91+ elemOf (ix (mn "ClassModule") . ix 0 . idaDeclaration . _IdeDeclTypeClass . ideTCInstances . folded) ideInstance

tests/Language/PureScript/Ide/Test.hsnew file+135

@@ -0,0 +1,135 @@

1+{-# LANGUAGE NoImplicitPrelude #-}

2+{-# LANGUAGE OverloadedStrings #-}

3+{-# LANGUAGE PackageImports #-}

4+module Language.PureScript.Ide.Test where

6+import Control.Concurrent.STM

7+import "monad-logger" Control.Monad.Logger

8+import qualified Data.Map as Map

9+import Language.PureScript.Ide

10+import Language.PureScript.Ide.Command

11+import Language.PureScript.Ide.Error

12+import Language.PureScript.Ide.Types

13+import Protolude

14+import System.Directory

15+import System.FilePath

16+import System.Process

17+

18+import qualified Language.PureScript as P

19+

20+defConfig :: Configuration

21+defConfig =

22+ Configuration { confLogLevel = LogNone

23+ , confOutputPath = "output/"

24+ , confGlobs = ["src/*.purs"]

25+ }

26+

27+runIde' :: Configuration -> IdeState -> [Command] -> IO ([Either PscIdeError Success], IdeState)

28+runIde' conf s cs = do

29+ stateVar <- newTVarIO s

30+ let env' = IdeEnvironment {ideStateVar = stateVar, ideConfiguration = conf}

31+ r <- runNoLoggingT (runReaderT (traverse (runExceptT . handleCommand) cs) env')

32+ newState <- readTVarIO stateVar

33+ pure (r, newState)

34+

35+runIde :: [Command] -> IO ([Either PscIdeError Success], IdeState)

36+runIde = runIde' defConfig emptyIdeState

37+

38+s3 :: IdeState -> [(Text, [IdeDeclarationAnn])] -> IdeState

39+s3 s ds =

40+ s {ideStage3 = stage3}

41+ where

42+ stage3 = Stage3 (Map.fromList decls) Nothing

43+ decls = map (first P.moduleNameFromString) ds

44+

45+-- | Adding Annotations to IdeDeclarations

46+ann :: IdeDeclarationAnn -> Annotation -> IdeDeclarationAnn

47+ann (IdeDeclarationAnn _ d) a = IdeDeclarationAnn a d

48+

49+annLoc :: IdeDeclarationAnn -> P.SourceSpan -> IdeDeclarationAnn

50+annLoc (IdeDeclarationAnn a d) loc = IdeDeclarationAnn a {annLocation = Just loc} d

51+

52+annExp :: IdeDeclarationAnn -> P.ModuleName -> IdeDeclarationAnn

53+annExp (IdeDeclarationAnn a d) e = IdeDeclarationAnn a {annExportedFrom = Just e} d

54+

55+annTyp :: IdeDeclarationAnn -> P.Type -> IdeDeclarationAnn

56+annTyp (IdeDeclarationAnn a d) ta = IdeDeclarationAnn a {annTypeAnnotation = Just ta} d

57+

58+

59+ida :: IdeDeclaration -> IdeDeclarationAnn

60+ida = IdeDeclarationAnn emptyAnn

61+

62+-- | Builders for Ide declarations

63+ideValue :: Text -> Maybe P.Type -> IdeDeclarationAnn

64+ideValue i ty = ida (IdeDeclValue (IdeValue (P.Ident i) (fromMaybe P.tyString ty)))

65+

66+ideType :: Text -> Maybe P.Kind -> IdeDeclarationAnn

67+ideType pn ki = ida (IdeDeclType (IdeType (P.ProperName pn) (fromMaybe P.kindType ki)))

68+

69+ideSynonym :: Text -> P.Type -> IdeDeclarationAnn

70+ideSynonym pn ty = ida (IdeDeclTypeSynonym (IdeTypeSynonym (P.ProperName pn) ty))

71+

72+ideTypeClass :: Text -> [IdeInstance] -> IdeDeclarationAnn

73+ideTypeClass pn instances = ida (IdeDeclTypeClass (IdeTypeClass (P.ProperName pn) instances))

74+

75+ideDtor :: Text -> Text -> Maybe P.Type -> IdeDeclarationAnn

76+ideDtor pn tn ty = ida (IdeDeclDataConstructor (IdeDataConstructor (P.ProperName pn) (P.ProperName tn) (fromMaybe P.tyString ty)))

77+

78+ideValueOp :: Text -> P.Qualified (Either Text Text) -> Integer -> Maybe P.Associativity -> Maybe P.Type -> IdeDeclarationAnn

79+ideValueOp opName ident precedence assoc t =

80+ ida (IdeDeclValueOperator

81+ (IdeValueOperator

82+ (P.OpName opName)

83+ (bimap P.Ident P.ProperName <$> ident)

84+ (precedence)

85+ (fromMaybe P.Infix assoc)

86+ t))

87+

88+ideTypeOp :: Text -> P.Qualified Text -> Integer -> Maybe P.Associativity -> Maybe P.Kind -> IdeDeclarationAnn

89+ideTypeOp opName ident precedence assoc k =

90+ ida (IdeDeclTypeOperator

91+ (IdeTypeOperator

92+ (P.OpName opName)

93+ (P.ProperName <$> ident)

94+ (precedence)

95+ (fromMaybe P.Infix assoc)

96+ k))

97+

98+ideKind :: Text -> IdeDeclarationAnn

99+ideKind pn = ida (IdeDeclKind (P.ProperName pn))

100+

101+mn :: Text -> P.ModuleName

102+mn = P.moduleNameFromString

103+

104+inProject :: IO a -> IO a

105+inProject f = do

106+ cwd' <- getCurrentDirectory

107+ setCurrentDirectory ("." </> "tests" </> "support" </> "pscide")

108+ a <- f

109+ setCurrentDirectory cwd'

110+ pure a

111+

112+compileTestProject :: IO Bool

113+compileTestProject = inProject $ do

114+ (_, _, _, procHandle) <-

115+ createProcess $ (shell $ "psc \"src/**/*.purs\"")

116+ r <- tryNTimes 10 (getProcessExitCode procHandle)

117+ pure (fromMaybe False (isSuccess <$> r))

118+

119+isSuccess :: ExitCode -> Bool

120+isSuccess ExitSuccess = True

121+isSuccess (ExitFailure _) = False

122+

123+tryNTimes :: Int -> IO (Maybe a) -> IO (Maybe a)

124+tryNTimes 0 _ = pure Nothing

125+tryNTimes n action = do

126+ r <- action

127+ case r of

128+ Nothing -> do

129+ threadDelay 500000

130+ tryNTimes (n - 1) action

131+ Just a -> pure (Just a)

132+

133+deleteOutputFolder :: IO ()

134+deleteOutputFolder = inProject $

135+ whenM (doesDirectoryExist "output") (removeDirectoryRecursive "output")

tests/TestPscIde.hs+3−5

@@ -1,15 +1,13 @@

11module TestPscIde where

33import Control.Monad (unless)

4−import Language.PureScript.Ide.Integration

54import qualified PscIdeSpec

5+import Language.PureScript.Ide.Test

66import Test.Hspec

88main :: IO ()

99main = do

1010 deleteOutputFolder

1111 s <- compileTestProject

12− unless s $ fail "Failed to compile .purs sources"

13−

14− quitServer -- shuts down any left over server (primarily happens during development)

15− withServer (hspec PscIdeSpec.spec)

12+ unless s (fail "Failed to compile .purs sources")

13+ hspec PscIdeSpec.spec

tests/TestUtils.hs+1

@@ -78,6 +78,7 @@ supportModules =

7878 , "Data.Array"

7979 , "Data.Array.Partial"

8080 , "Data.Array.ST"

81+ , "Data.Array.ST.Iterator"

8182 , "Data.Bifoldable"

8283 , "Data.Bifunctor"

8384 , "Data.Bifunctor.Clown"