616aea1 · rowtype-yoga/purescript-native

LICENSE+310

compare with golang

unifiedsplit

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

48 bytestring-builder

49 case-insensitive

50 cereal

51+ cheapskate

51 clock

52 clock

52 cmdargs

53 cmdargs

53 comonad

54 comonad

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

58 contravariant

59 contravariant

59 cookie

60 cookie

60 cryptonite

61 cryptonite

62+ css-text

63+ data-default

61 data-default-class

64 data-default-class

65+ data-default-instances-base

66+ data-default-instances-containers

67+ data-default-instances-dlist

68+ data-default-instances-old-locale

62 data-ordlist

69 data-ordlist

63 deepseq

70 deepseq

64 directory

71 directory

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

142 system-fileio

149 system-fileio

143 system-filepath

150 system-filepath

144 tagged

151 tagged

152+ tagsoup

145 template-haskell

153 template-haskell

146 temporary

154 temporary

147 terminfo

155 terminfo

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

152 transformers-base

160 transformers-base

153 transformers-compat

161 transformers-compat

154 turtle

162 turtle

163+ uniplate

155 unix

164 unix

156 unix-compat

165 unix-compat

157 unix-time

166 unix-time

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

172 x509-store

181 x509-store

173 x509-system

182 x509-system

174 x509-validation

183 x509-validation

184+ xss-sanitize

175 zlib

185 zlib

176

186

177Glob LICENSE file:

187Glob LICENSE file:

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

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

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

1312 POSSIBILITY OF SUCH DAMAGE.

1322 POSSIBILITY OF SUCH DAMAGE.

1313

1323

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+

1314clock LICENSE file:

1357clock LICENSE file:

1315

1358

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

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

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

1607 SUCH DAMAGE.

1650 SUCH DAMAGE.

1608

1651

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+

1609data-default-class LICENSE file:

1709data-default-class LICENSE file:

1610

1710

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

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

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

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

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

1637

1737

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+

1638data-ordlist LICENSE file:

1854data-ordlist LICENSE file:

1639

1855

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

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

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

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

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

4368

4584

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+

4369template-haskell LICENSE file:

4618template-haskell LICENSE file:

4370

4619

4371

4620

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

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

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

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

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

4651

4900

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+

4652unix LICENSE file:

4934unix LICENSE file:

4653

4935

4654 The Glasgow Haskell Compiler License

4936 The Glasgow Haskell Compiler License

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

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

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

5239 SUCH DAMAGE.

5521 SUCH DAMAGE.

5240

5522

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+

5241zlib LICENSE file:

5551zlib LICENSE file:

5242

5552

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

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

29import qualified Data.Text.IO as T

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

31import Data.Version (showVersion)

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

32import Language.PureScript.Ide

33import Language.PureScript.Ide

33import Language.PureScript.Ide.Command

34import Language.PureScript.Ide.Command

34import Language.PureScript.Ide.Util

35import Language.PureScript.Ide.Util

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

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

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

145 liftIO (hFlush stdout)

146 liftIO (hFlush stdout)

146 case result of

147 case result of

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

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

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

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

149 Nothing -> do

150 Nothing -> do

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

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

151 liftIO $ do

152 liftIO $ do

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

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

153 hFlush stdout

154 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)

155

163

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

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

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

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

purescript.cabal+7−6

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

122 aeson-better-errors >= 0.8,

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

124 base-compat >=0.6.0,

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

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

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

126 boxes >= 0.1.4 && < 0.2.0,

127 boxes >= 0.1.4 && < 0.2.0,

127 bytestring -any,

128 bytestring -any,

129+ cheapskate >= 0.1 && < 0.2,

128 containers -any,

130 containers -any,

129 clock -any,

131 clock -any,

130 data-ordlist >= 0.4.7.0,

132 data-ordlist >= 0.4.7.0,

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

293 Language.PureScript.Docs.RenderedCode.RenderType

295 Language.PureScript.Docs.RenderedCode.RenderType

294 Language.PureScript.Docs.RenderedCode.RenderKind

296 Language.PureScript.Docs.RenderedCode.RenderKind

295 Language.PureScript.Docs.AsMarkdown

297 Language.PureScript.Docs.AsMarkdown

298+ Language.PureScript.Docs.AsHtml

296 Language.PureScript.Docs.ParseInPackage

299 Language.PureScript.Docs.ParseInPackage

297 Language.PureScript.Docs.Utils.MonoidExtras

300 Language.PureScript.Docs.Utils.MonoidExtras

298

301

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

516 aeson >= 0.8 && < 1.0,

519 aeson >= 0.8 && < 1.0,

517 bytestring -any,

520 bytestring -any,

518 purescript -any,

521 purescript -any,

519− base-compat >=0.6.0,

520 directory -any,

522 directory -any,

521 filepath -any,

523 filepath -any,

522 monad-logger -any,

524 monad-logger -any,

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

526 protolude >= 0.1.6,

528 protolude >= 0.1.6,

527 stm -any,

529 stm -any,

528 text -any,

530 text -any,

529− transformers -any,

531+ transformers -any

530− transformers-compat -any

531 ghc-options: -Wall -O2 -threaded

532 ghc-options: -Wall -O2 -threaded

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

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

533

534

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

589 hspec -any,

590 hspec -any,

590 hspec-discover -any,

591 hspec-discover -any,

591 HUnit -any,

592 HUnit -any,

593+ lens -any,

594+ monad-logger -any,

592 mtl -any,

595 mtl -any,

593 optparse-applicative -any,

596 optparse-applicative -any,

594 parsec -any,

597 parsec -any,

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

613 TestPsci

616 TestPsci

614 TestPscIde

617 TestPscIde

615 PscIdeSpec

618 PscIdeSpec

619+ Language.PureScript.Ide.Test

616 Language.PureScript.Ide.FilterSpec

620 Language.PureScript.Ide.FilterSpec

617 Language.PureScript.Ide.ImportsSpec

621 Language.PureScript.Ide.ImportsSpec

618− Language.PureScript.Ide.Imports.IntegrationSpec

619− Language.PureScript.Ide.Integration

620 Language.PureScript.Ide.MatcherSpec

622 Language.PureScript.Ide.MatcherSpec

621 Language.PureScript.Ide.RebuildSpec

623 Language.PureScript.Ide.RebuildSpec

622 Language.PureScript.Ide.ReexportsSpec

624 Language.PureScript.Ide.ReexportsSpec

623− Language.PureScript.Ide.SourceFile.IntegrationSpec

624 Language.PureScript.Ide.SourceFileSpec

625 Language.PureScript.Ide.SourceFileSpec

625 Language.PureScript.Ide.StateSpec

626 Language.PureScript.Ide.StateSpec

626 buildable: True

627 buildable: True

src/Language/PureScript/CodeGen/Cpp/Optimizer/Blocks.hs+1−1

@@ -84,7 +84,7 @@ collapseIfElses = everywhereOnCpp collapse

84 returns _ = False

85 go (cpp' : cpps') = cpp' : go cpps'

86 go cpp' = cpp'

87− collapse (CppIfElse (CppAccessor (CppVar "otherwise") (CppVar mn')) body _) | mn' == C.prelude = body

87+ collapse (CppIfElse (CppAccessor (CppVar "otherwise") (CppVar mn')) body _) | mn' == "Data_Boolean" = body

88 collapse cpp = cpp

89

90collapseCtorChecksToSwitch :: Cpp -> Cpp

src/Language/PureScript/CodeGen/Cpp/Recursion.hs+4−6

@@ -68,11 +68,7 @@ convertRecursiveLets = everywhereOnCpp go

68convertRecursive :: [Text] -> [Cpp] -> [Cpp]

69-------------------------------------------------------------------------------------------------

70convertRecursive names cpps

71− | not $ null lets

71+ | (_:_) <- lets = (everywhereOnCppTopDown remRecLet <$> cpps) ++ undefines

72− = defines ++

73− [letTable] ++

74− (everywhereOnCpp remRecLet <$> cpps) ++

75− undefines

76 where

72 where

77 tableName :: Text

73 tableName :: Text

78 tableName = "let"

74 tableName = "let"

@@ -93,8 +89,10 @@ convertRecursive names cpps

93 recLet _ = []

89 recLet _ = []

94 --

90 --

95 remRecLet :: Cpp -> Cpp

91 remRecLet :: Cpp -> Cpp

96− remRecLet (CppVariableIntroduction (name, _) _ (Just _))

92+ remRecLet cpp@(CppVariableIntroduction (name, _) _ (Just _))

93+ | name == head names = CppNamespace "" $ defines ++ [letTable]

97 | name `elem` names = CppNoOp

94 | name `elem` names = CppNoOp

95+ | otherwise = cpp

98 remRecLet cpp = cpp

96 remRecLet cpp = cpp

99 --

97 --

100 tableItem :: Cpp -> (Text, Cpp)

98 tableItem :: Cpp -> (Text, Cpp)

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

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

6internalError :: String -> a

7internalError =

8 error

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

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

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

11 . show

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

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

1+

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

3+-- HTML.

4+

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

5 where

6

7import Protolude hiding (to, from)

8−import Prelude (String, unlines)

8+import Prelude (String, unlines, lookup)

9

10import Control.Arrow ((***))

11

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

353ignorePackage (Local x) = x

354ignorePackage (FromDep _ x) = x

355

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+

356----------------------

439----------------------

357-- Parsing

440-- Parsing

358

441

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

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

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

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

22import Data.Ord (comparing)

23+import Data.String (fromString)

23import qualified Data.Map as M

24import qualified Data.Map as M

24import qualified Data.Text as T

25import qualified Data.Text as T

25import Data.Text (Text)

26import Data.Text (Text)

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

31import Language.PureScript.Label (Label(..))

32import Language.PureScript.Label (Label(..))

32import Language.PureScript.Names

33import Language.PureScript.Names

33import Language.PureScript.Pretty

34import 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)

35import Language.PureScript.Traversals

37import Language.PureScript.Traversals

36import Language.PureScript.Types

38import Language.PureScript.Types

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

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

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

1264 whiteSpace = all isSpace

1266 whiteSpace = all isSpace

1265

1267

1266toTypelevelString :: Type -> Maybe Box.Box

1268toTypelevelString :: Type -> Maybe Box.Box

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

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

1270+ where

1271+ toTypelevelString' :: Type -> Maybe PSString

1272+ toTypelevelString' (TypeLevelString s) = Just s

1268−toTypelevelString (TypeApp (TypeConstructor f) x)

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

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

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

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

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

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

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

1272−toTypelevelString _ = Nothing

1277+ toTypelevelString' _ = Nothing

1273

1278

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

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

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

1280rethrow :: (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) =>

47 Command -> m Success

48handleCommand c = case c of

49 Load [] ->

50− findAvailableExterns >>= loadModules

50+ findAvailableExterns >>= loadModulesAsync

51 Load modules ->

52− loadModules modules

52+ loadModulesAsync modules

53+ LoadSync [] ->

54+ findAvailableExterns >>= loadModulesSync

55+ LoadSync modules ->

56+ loadModulesSync modules

53 Type search filters currentModule ->

57 Type search filters currentModule ->

54 findType search filters currentModule

58 findType search filters currentModule

55 Complete filters matcher currentModule ->

59 Complete filters matcher currentModule ->

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

78 Left question ->

82 Left question ->

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

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

80 Rebuild file ->

84 Rebuild file ->

81− rebuildFile file

85+ rebuildFileAsync file

86+ RebuildSync file ->

87+ rebuildFileSync file

82 Cwd ->

88 Cwd ->

83 TextResult . toS <$> liftIO getCurrentDirectory

89 TextResult . toS <$> liftIO getCurrentDirectory

84 Reset ->

90 Reset ->

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

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

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

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

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

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

170-- 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+

165loadModules

196loadModules

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

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

167 => [P.ModuleName]

198 => [P.ModuleName]

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

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

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

183 traverse_ insertModule allModules

214 traverse_ insertModule allModules

184

215

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)))

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

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

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

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

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

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

25

26data Command

27 = Load [P.ModuleName]

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

28 | Type

29 | Type

29 { typeSearch :: Text

30 { typeSearch :: Text

30 , typeFilters :: [Filter]

31 , typeFilters :: [Filter]

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

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

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

55 | List { listType :: ListType }

56 | List { listType :: ListType }

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

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

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

57 | Cwd

59 | Cwd

58 | Reset

60 | Reset

59 | Quit

61 | Quit

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

61commandName :: Command -> Text

63commandName :: Command -> Text

62commandName c = case c of

64commandName c = case c of

63 Load{} -> "Load"

65 Load{} -> "Load"

66+ LoadSync{} -> "LoadSync"

64 Type{} -> "Type"

67 Type{} -> "Type"

65 Complete{} -> "Complete"

68 Complete{} -> "Complete"

66 Pursuit{} -> "Pursuit"

69 Pursuit{} -> "Pursuit"

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

69 Import{} -> "Import"

72 Import{} -> "Import"

70 List{} -> "List"

73 List{} -> "List"

71 Rebuild{} -> "Rebuild"

74 Rebuild{} -> "Rebuild"

75+ RebuildSync{} -> "RebuildSync"

72 Cwd{} -> "Cwd"

76 Cwd{} -> "Cwd"

73 Reset{} -> "Reset"

77 Reset{} -> "Reset"

74 Quit{} -> "Quit"

78 Quit{} -> "Quit"

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

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

8import Language.PureScript.Ide.Filter

9import Language.PureScript.Ide.Matcher

10import Language.PureScript.Ide.Types

11+import qualified Language.PureScript as P

12+

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

11

14

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

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

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

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

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

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

29 | ModuleFileNotFound ModuleIdent

30 | ParseError P.ParseError Text

31 | RebuildError [JSONError]

32+ deriving (Show, Eq)

32

33

33instance ToJSON PscIdeError where

34instance ToJSON PscIdeError where

34 toJSON (RebuildError errs) = object

35 toJSON (RebuildError errs) = object

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

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

54 where

55 version = toS (showVersion P.version)

56

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

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

58convertExterns ef =

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

59+ (decls, exportDecls)

60 where

61 decls = map

62 (IdeDeclarationAnn emptyAnn)

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

71

72removeTypeDeclarationsForClass :: IdeDeclaration -> Endo [IdeDeclaration]

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

74+ where notDuplicate (IdeDeclType t) =

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

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

76+ notDuplicate (IdeDeclTypeSynonym s) =

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

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

76 notDuplicate _ = True

78 notDuplicate _ = True

77removeTypeDeclarationsForClass _ = mempty

79removeTypeDeclarationsForClass _ = mempty

78

80

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

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

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

89 IdeType edTypeName edTypeKind

91 IdeType edTypeName edTypeKind

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

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

91− (IdeSynonym edTypeSynonymName edTypeSynonymType)

93+ (IdeTypeSynonym edTypeSynonymName edTypeSynonymType)

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

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

93 IdeDataConstructor edDataCtorName edDataCtorTypeCtor edDataCtorType

95 IdeDataConstructor edDataCtorName edDataCtorTypeCtor edDataCtorType

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

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

95 IdeValue edValueName edValueType

97 IdeValue edValueName edValueType

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

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

99+ IdeTypeClass edClassName []

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

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

98convertDecl P.EDInstance{} = Nothing

101convertDecl P.EDInstance{} = Nothing

99

102

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

117

120

118annotateModule

121annotateModule

119 :: (DefinitionSites P.SourceSpan, TypeAnnotations)

122 :: (DefinitionSites P.SourceSpan, TypeAnnotations)

120− -> Module

123+ -> [IdeDeclarationAnn]

121− -> Module

124+ -> [IdeDeclarationAnn]

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

125+annotateModule (defs, types) decls =

123− (moduleName, map convertDeclaration decls)

126+ map convertDeclaration decls

124 where

127 where

125 convertDeclaration :: IdeDeclarationAnn -> IdeDeclarationAnn

128 convertDeclaration :: IdeDeclarationAnn -> IdeDeclarationAnn

126 convertDeclaration (IdeDeclarationAnn ann d) = case d of

129 convertDeclaration (IdeDeclarationAnn ann d) = case d of

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

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

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

133 IdeDeclDataConstructor dtor ->

136 IdeDeclDataConstructor dtor ->

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

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

135− IdeDeclTypeClass i ->

138+ IdeDeclTypeClass tc ->

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

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

137 IdeDeclValueOperator op ->

140 IdeDeclValueOperator op ->

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

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

139 IdeDeclTypeOperator op ->

142 IdeDeclTypeOperator op ->

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

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

32

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

34

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

36+

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

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

36mkFilter = Filter . Endo

38mkFilter = Filter . Endo

37

39

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

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

197 then imports

198 else updateAtFirstOrPrepend matches (insertDeclIntoImport decl) freshImport imports

199 where

200− refFromDeclaration (IdeDeclTypeClass n) =

200+ refFromDeclaration (IdeDeclTypeClass tc) =

201− P.TypeClassRef n

201+ P.TypeClassRef (tc ^. ideTCName)

202 refFromDeclaration (IdeDeclDataConstructor dtor) =

203 P.TypeRef (dtor ^. ideDtorTypeName) Nothing

204 refFromDeclaration (IdeDeclType t) =

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

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

4 ( runLogger

5 , logPerf

6 , displayTimeSpec

7+ , labelTimespec

7 ) where

8 ) where

8

9

9import Protolude

10import Protolude

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

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

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

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

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

26

27

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

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

30+

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

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

28logPerf format f = do

32logPerf format f = do

29 start <- liftIO (getTime Monotonic)

33 start <- liftIO (getTime Monotonic)

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

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

2{-# LANGUAGE TemplateHaskell #-}

3

4module Language.PureScript.Ide.Rebuild

5+ ( rebuildFileSync

6+ , rebuildFileAsync

5− ( rebuildFile

7+ , rebuildFile

6 ) where

8 ) where

7

9

8import Protolude

10import Protolude

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

15import qualified Language.PureScript as P

17import qualified Language.PureScript as P

16import Language.PureScript.Errors.JSON

18import Language.PureScript.Errors.JSON

17import Language.PureScript.Ide.Error

19import Language.PureScript.Ide.Error

20+import Language.PureScript.Ide.Logging

18import Language.PureScript.Ide.State

21import Language.PureScript.Ide.State

19import Language.PureScript.Ide.Types

22import Language.PureScript.Ide.Types

20import System.IO.UTF8 (readUTF8FileT)

23import System.IO.UTF8 (readUTF8FileT)

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

37rebuildFile

40rebuildFile

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

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

39 => FilePath

42 => FilePath

43+ -- ^ The file to rebuild

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

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

40 -> m Success

46 -> m Success

41−rebuildFile path = do

47+rebuildFile path runOpenBuild = do

42

48

43 input <- liftIO (readUTF8FileT path)

49 input <- liftIO (readUTF8FileT path)

44

50

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

51

57

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

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

53 -- correctly to the 'Environment'.

59 -- correctly to the 'Environment'.

54− externs <- sortExterns m =<< getExternFiles

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

55

61

56 outputDirectory <- confOutputPath . ideConfiguration <$> ask

62 outputDirectory <- confOutputPath . ideConfiguration <$> ask

57

63

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

62

68

63 let makeEnv = MakeActionsEnv outputDirectory filePathMap foreigns False

69 let makeEnv = MakeActionsEnv outputDirectory filePathMap foreigns False

64 -- Rebuild the single module using the cached externs

70 -- Rebuild the single module using the cached externs

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

65− (result, warnings) <- liftIO

72+ liftIO

66 . P.runMake P.defaultOptions

73 . P.runMake P.defaultOptions

67 . P.rebuildModule (buildMakeActions

74 . P.rebuildModule (buildMakeActions

68 >>= shushProgress $ makeEnv) externs $ m

75 >>= shushProgress $ makeEnv) externs $ m

69 case result of

76 case result of

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

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

71 Right _ -> do

78 Right _ -> do

72− rebuildModuleOpen makeEnv externs m

79+ runOpenBuild (rebuildModuleOpen makeEnv externs m)

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

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

74

81

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+

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

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

76-- inside the rebuild cache

106-- inside the rebuild cache

77rebuildModuleOpen

107rebuildModuleOpen

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

108+ :: (Ide m, MonadLogger m)

79 => MakeActionsEnv

109 => MakeActionsEnv

80 -> [P.ExternsFile]

110 -> [P.ExternsFile]

81 -> P.Module

111 -> P.Module

82 -> m ()

112 -> m ()

83−rebuildModuleOpen makeEnv externs m = do

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

84 (openResult, _) <- liftIO

114 (openResult, _) <- liftIO

85 . P.runMake P.defaultOptions

115 . P.runMake P.defaultOptions

86 . P.rebuildModule (buildMakeActions

116 . P.rebuildModule (buildMakeActions

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

99data MakeActionsEnv =

129data MakeActionsEnv =

100 MakeActionsEnv

130 MakeActionsEnv

101 { maeOutputDirectory :: FilePath

131 { maeOutputDirectory :: FilePath

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

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

103− , maeForeignPathMap :: Map P.ModuleName FilePath

133+ , maeForeignPathMap :: ModuleMap FilePath

104 , maePrefixComment :: Bool

134 , maePrefixComment :: Bool

105 }

135 }

106

136

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

130sortExterns

160sortExterns

131 :: (Ide m, MonadError PscIdeError m)

161 :: (Ide m, MonadError PscIdeError m)

132 => P.Module

162 => P.Module

133− -> Map P.ModuleName P.ExternsFile

163+ -> ModuleMap P.ExternsFile

134 -> m [P.ExternsFile]

164 -> m [P.ExternsFile]

135sortExterns m ex = do

165sortExterns m ex = do

136 sorted' <- runExceptT

166 sorted' <- runExceptT

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

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

18 , prettyPrintReexportResult

19 , reexportHasFailures

20 , ReexportResult(..)

21+ -- for tests

22+ , resolveReexports'

21 ) where

23 ) where

22

24

23import Protolude

25import Protolude

24

26

25import Control.Lens hiding ((&))

27import Control.Lens hiding ((&))

26−

27import qualified Data.Map as Map

28import qualified Data.Map as Map

28import qualified Language.PureScript as P

29import qualified Language.PureScript as P

29import Language.PureScript.Ide.Types

30import Language.PureScript.Ide.Types

30import Language.PureScript.Ide.Util

31import Language.PureScript.Ide.Util

31

32

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

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

33data ReexportResult a

34data ReexportResult a

34 = ReexportResult

35 = ReexportResult

35 { reResolved :: a

36 { reResolved :: a

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

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

37 } deriving (Show, Eq, Functor)

38 } deriving (Show, Eq, Functor)

38

39

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

40-- failures

41-- failures

41prettyPrintReexportResult

42prettyPrintReexportResult

42 :: (a -> Text)

43 :: (a -> Text)

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

56reexportHasFailures :: ReexportResult a -> Bool

57reexportHasFailures :: ReexportResult a -> Bool

57reexportHasFailures = not . null . reFailed

58reexportHasFailures = not . null . reFailed

58

59

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

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

60−-- from the passed in Map

61+-- values from the passed in DeclarationRefs

61resolveReexports

62resolveReexports

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

64+ -- ^ the references to resolve

62− :: Map P.ModuleName [IdeDeclarationAnn]

65+ -> ModuleMap [IdeDeclarationAnn]

63 -- ^ Modules to search for the reexported declarations

66 -- ^ Modules to search for the reexported declarations

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]

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

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

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

66− -> ReexportResult Module

78+ -> ReexportResult [IdeDeclarationAnn]

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

79+resolveReexports' modules decls refs =

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

80+ ReexportResult (decls <> concat resolvedRefs) failedRefs

69 where

81 where

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

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

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

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

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

78 -> Either P.DeclarationRef [IdeDeclarationAnn]

90 -> Either P.DeclarationRef [IdeDeclarationAnn]

79resolveRef decls ref = case ref of

91resolveRef decls ref = case ref of

80 P.TypeRef tn mdtors ->

92 P.TypeRef tn mdtors ->

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

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

82 Nothing -> Left ref

94 Nothing -> Left ref

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

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

84 Nothing ->

96 Nothing ->

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

88 findDtors tn

100 findDtors tn

89 Just dtors -> mapMaybe lookupDtor dtors

101 Just dtors -> mapMaybe lookupDtor dtors

90 P.ValueRef i ->

102 P.ValueRef i ->

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

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

92 P.ValueOpRef name ->

104 P.ValueOpRef name ->

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

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

94 P.TypeOpRef name ->

106 P.TypeOpRef name ->

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

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

96 P.TypeClassRef name ->

108 P.TypeClassRef name ->

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

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

98 _ ->

110 _ ->

99 Left ref

111 Left ref

100 where

112 where

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

102 findRef f = find (f . discardAnn) decls

114 findRef f = find (f . discardAnn) decls

103

115

104 lookupDtor name =

116 lookupDtor name =

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

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

106

118

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

119+ findDtors tn = filter (anyOf

108− where

120+ (idaDeclaration

109− f :: IdeDeclaration -> Bool

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

121+ . _IdeDeclDataConstructor

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

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

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

14

15{-# LANGUAGE PackageImports #-}

16{-# LANGUAGE TemplateHaskell #-}

17+{-# LANGUAGE NamedFieldPuns #-}

17

18

18module Language.PureScript.Ide.State

19module Language.PureScript.Ide.State

19 ( getLoadedModulenames

20 ( getLoadedModulenames

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

29 , populateStage3STM

30 , populateStage3STM

30 -- for tests

31 -- for tests

31 , resolveOperatorsForModule

32 , resolveOperatorsForModule

33+ , resolveInstances

32 ) where

34 ) where

33

35

34import Protolude

36import Protolude

35

37

38+import Control.Arrow

36import Control.Concurrent.STM

39import Control.Concurrent.STM

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

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

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

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

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

58getLoadedModulenames = Map.keys <$> getExternFiles

61getLoadedModulenames = Map.keys <$> getExternFiles

59

62

60-- | Gets all loaded ExternFiles

63-- | Gets all loaded ExternFiles

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

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

62getExternFiles = s1Externs <$> getStage1

65getExternFiles = s1Externs <$> getStage1

63

66

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

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

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

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

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

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

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

123-- cache

126-- cache

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

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

125getAllModules mmoduleName = do

128getAllModules mmoduleName = do

126 declarations <- s3Declarations <$> getStage3

129 declarations <- s3Declarations <$> getStage3

127 rebuild <- cachedRebuild

130 rebuild <- cachedRebuild

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

136 ast =

139 ast =

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

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

138 cachedModule =

141 cachedModule =

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

142+ annotateModule ast (fst (convertExterns ef))

140 tmp =

143 tmp =

141 Map.insert moduleName cachedModule declarations

144 Map.insert moduleName cachedModule declarations

142 resolved =

145 resolved =

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

192 st <- ideStateVar <$> ask

195 st <- ideStateVar <$> ask

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

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

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

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

195− traverse_

198+ void $ Map.traverseWithKey

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

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

197− (filter reexportHasFailures results)

200+ (Map.filter reexportHasFailures results)

198

201

199-- | STM version of populateStage3

202-- | STM version of populateStage3

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

203+populateStage3STM

204+ :: TVar IdeState

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

201populateStage3STM ref = do

206populateStage3STM ref = do

202 externs <- s1Externs <$> getStage1STM ref

207 externs <- s1Externs <$> getStage1STM ref

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

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

204− let modules = Map.map convertExterns externs

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

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

210+ results =

206− nModules = Map.mapWithKey

211+ resolveLocations asts modules

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

212+ & resolveInstances externs

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))

213+ & resolveOperators

214+ & resolveReexports reexportRefs

212− setStage3STM ref (Stage3 resultP Nothing)

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

213− pure result

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

214

261

215resolveOperators

262resolveOperators

216− :: Map P.ModuleName [IdeDeclarationAnn]

263+ :: ModuleMap [IdeDeclarationAnn]

217− -> Map P.ModuleName [IdeDeclarationAnn]

264+ -> ModuleMap [IdeDeclarationAnn]

218resolveOperators modules =

265resolveOperators modules =

219 map (resolveOperatorsForModule modules) modules

266 map (resolveOperatorsForModule modules) modules

220

267

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

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

222-- declarations

269-- declarations

223resolveOperatorsForModule

270resolveOperatorsForModule

224− :: Map P.ModuleName [IdeDeclarationAnn]

271+ :: ModuleMap [IdeDeclarationAnn]

225 -> [IdeDeclarationAnn]

272 -> [IdeDeclarationAnn]

226 -> [IdeDeclarationAnn]

273 -> [IdeDeclarationAnn]

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

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

228 where

275 where

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

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

231−

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

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

233 getDeclarations moduleName =

277 getDeclarations moduleName =

234 Map.lookup moduleName modules

278 Map.lookup moduleName modules

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

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

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

240 let t = getDeclarations mn

284 let t = getDeclarations mn

241 & mapMaybe (preview _IdeDeclValue)

285 & mapMaybe (preview _IdeDeclValue)

242− & filter (hasName ideValueIdent ident)

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

243 & map (view ideValueType)

287 & map (view ideValueType)

244 & listToMaybe

288 & listToMaybe

245 in IdeDeclValueOperator (op & ideValueOpType .~ t)

289 in IdeDeclValueOperator (op & ideValueOpType .~ t)

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

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

247 let t = getDeclarations mn

291 let t = getDeclarations mn

248 & mapMaybe (preview _IdeDeclDataConstructor)

292 & mapMaybe (preview _IdeDeclDataConstructor)

249− & filter (hasName ideDtorName dtor)

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

250 & map (view ideDtorType)

294 & map (view ideDtorType)

251 & listToMaybe

295 & listToMaybe

252 in IdeDeclValueOperator (op & ideValueOpType .~ t)

296 in IdeDeclValueOperator (op & ideValueOpType .~ t)

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

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

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

255 let k = getDeclarations mn

299 let k = getDeclarations mn

256 & mapMaybe (preview _IdeDeclType)

300 & mapMaybe (preview _IdeDeclType)

257− & filter (hasName ideTypeName properName)

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

258 & map (view ideTypeKind)

302 & map (view ideTypeKind)

259 & listToMaybe

303 & listToMaybe

260 in IdeDeclTypeOperator (op & ideTypeOpKind .~ k)

304 in IdeDeclTypeOperator (op & ideTypeOpKind .~ k)

261 resolveOperator x = x

305 resolveOperator x = x

262

306

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

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

28

29type ModuleIdent = Text

30+type ModuleMap a = Map P.ModuleName a

30

31

31data IdeDeclaration

32data IdeDeclaration

32 = IdeDeclValue IdeValue

33 = IdeDeclValue IdeValue

33 | IdeDeclType IdeType

34 | IdeDeclType IdeType

34− | IdeDeclTypeSynonym IdeSynonym

35+ | IdeDeclTypeSynonym IdeTypeSynonym

35 | IdeDeclDataConstructor IdeDataConstructor

36 | IdeDeclDataConstructor IdeDataConstructor

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

37+ | IdeDeclTypeClass IdeTypeClass

37 | IdeDeclValueOperator IdeValueOperator

38 | IdeDeclValueOperator IdeValueOperator

38 | IdeDeclTypeOperator IdeTypeOperator

39 | IdeDeclTypeOperator IdeTypeOperator

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

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

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

49 , _ideTypeKind :: P.Kind

50 , _ideTypeKind :: P.Kind

50 } deriving (Show, Eq, Ord)

51 } deriving (Show, Eq, Ord)

51

52

52−data IdeSynonym = IdeSynonym

53+data IdeTypeSynonym = IdeTypeSynonym

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

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

54 , _ideSynonymType :: P.Type

55 , _ideSynonymType :: P.Type

55 } deriving (Show, Eq, Ord)

56 } deriving (Show, Eq, Ord)

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

60 , _ideDtorType :: P.Type

61 , _ideDtorType :: P.Type

61 } deriving (Show, Eq, Ord)

62 } deriving (Show, Eq, Ord)

62

63

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+

63data IdeValueOperator = IdeValueOperator

76data IdeValueOperator = IdeValueOperator

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

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

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

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

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

79makePrisms ''IdeDeclaration

92makePrisms ''IdeDeclaration

80makeLenses ''IdeValue

93makeLenses ''IdeValue

81makeLenses ''IdeType

94makeLenses ''IdeType

82−makeLenses ''IdeSynonym

95+makeLenses ''IdeTypeSynonym

83makeLenses ''IdeDataConstructor

96makeLenses ''IdeDataConstructor

97+makeLenses ''IdeTypeClass

98+makeLenses ''IdeInstance

84makeLenses ''IdeValueOperator

99makeLenses ''IdeValueOperator

85makeLenses ''IdeTypeOperator

100makeLenses ''IdeTypeOperator

86

101

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

101emptyAnn :: Annotation

116emptyAnn :: Annotation

102emptyAnn = Annotation Nothing Nothing Nothing

117emptyAnn = Annotation Nothing Nothing Nothing

103

118

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

105−

106type DefinitionSites a = Map IdeDeclNamespace a

119type DefinitionSites a = Map IdeDeclNamespace a

107type TypeAnnotations = Map P.Ident P.Type

120type 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))

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

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

110 -- annotations found in a module

123 -- annotations found in a module

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

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

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

147emptyStage3 = Stage3 M.empty Nothing

160emptyStage3 = Stage3 M.empty Nothing

148

161

149data Stage1 = Stage1

162data Stage1 = Stage1

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

163+ { s1Externs :: ModuleMap P.ExternsFile

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

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

152 }

165 }

153

166

154data Stage2 = Stage2

167data Stage2 = Stage2

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

156 }

169 }

157

170

158data Stage3 = Stage3

171data Stage3 = Stage3

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

172+ { s3Declarations :: ModuleMap [IdeDeclarationAnn]

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

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

161 }

174 }

162

175

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

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

33import Protolude hiding (decodeUtf8,

34 encodeUtf8)

35

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

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

37import Data.Aeson

38import qualified Data.Text as T

39+import qualified Data.Text.Lazy as TL

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

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

40import qualified Language.PureScript as P

41import qualified Language.PureScript as P

41import Language.PureScript.Ide.Logging

42import Language.PureScript.Ide.Logging

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

47 IdeDeclType t -> t ^. ideTypeName . properNameT

48 IdeDeclType t -> t ^. ideTypeName . properNameT

48 IdeDeclTypeSynonym s -> s ^. ideSynonymName . properNameT

49 IdeDeclTypeSynonym s -> s ^. ideSynonymName . properNameT

49 IdeDeclDataConstructor dtor -> dtor ^. ideDtorName . properNameT

50 IdeDeclDataConstructor dtor -> dtor ^. ideDtorName . properNameT

50− IdeDeclTypeClass name -> P.runProperName name

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

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

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

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

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

53 IdeDeclKind name -> P.runProperName name

54 IdeDeclKind name -> P.runProperName name

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

67 where

68 where

68 (complIdentifier, complExpandedType) = case decl of

69 (complIdentifier, complExpandedType) = case decl of

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

70 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)

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

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

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

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

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

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

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

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

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

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

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

77 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)

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

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

79

80

80 complModule = P.runModuleName m

81 complModule = P.runModuleName m

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

103 P.showQualified P.runProperName i

104 P.showQualified P.runProperName i

104

105

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

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

106−encodeT = toS . decodeUtf8 . encode

107+encodeT = TL.toStrict . decodeUtf8 . encode

107

108

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

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

109−decodeT = decode . encodeUtf8 . toS

110+decodeT = decode . encodeUtf8 . TL.fromStrict

110

111

111unwrapPositioned :: P.Declaration -> P.Declaration

112unwrapPositioned :: P.Declaration -> P.Declaration

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

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

src/Language/PureScript/PSString.hs+10

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

5 , toUTF16CodeUnits

6 , decodeString

7 , decodeStringEither

8+ , decodeStringWithReplacement

8 , prettyPrintString

9 , prettyPrintString

9 , prettyPrintStringJS

10 , prettyPrintStringJS

10 , mkString

11 , mkString

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

52instance Show PSString where

53instance Show PSString where

53 show = show . codePoints

54 show = show . codePoints

54

55

56+-- |

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

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

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

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

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

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

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

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

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

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

60-- we do not export it.

62-- we do not export it.

63+--

61codePoints :: PSString -> String

64codePoints :: PSString -> String

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

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

63

66

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+

64-- |

74-- |

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

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

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

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

src/Language/PureScript/Pretty/Cpp.hs+3

@@ -31,6 +31,7 @@ import Data.Maybe (fromMaybe)

31import Data.Text (Text)

32import qualified Data.Text as T

33import Data.Monoid ((<>))

34+import Numeric (showHex)

34

35

35#if __GLASGOW_HASKELL__ < 710

36#if __GLASGOW_HASKELL__ < 710

36import Control.Applicative

37import Control.Applicative

@@ -408,7 +409,9 @@ encodeChar '\v' = "\\v"

408encodeChar '\f' = "\\f"

409encodeChar '\f' = "\\f"

409encodeChar '\r' = "\\r"

410encodeChar '\r' = "\\r"

410encodeChar '"' = "\\\""

411encodeChar '"' = "\\\""

412+encodeChar '\'' = "\\'"

411encodeChar '\\' = "\\\\"

413encodeChar '\\' = "\\\\"

414+encodeChar c | isControl c = T.pack $ "\\x" ++ showHex (fromEnum c) ""

412encodeChar c = T.singleton c

415encodeChar c = T.singleton c

413

416

414-- Note: Any lone surrogates will be replaced with U+FFFD

417-- Note: Any lone surrogates will be replaced with U+FFFD

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

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

8import qualified Language.PureScript as P

9import Test.Hspec

10

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

12+

11value :: Text -> IdeDeclarationAnn

13value :: Text -> IdeDeclarationAnn

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

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

13

15

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

6import Data.Maybe (fromJust)

7

8import qualified Language.PureScript as P

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

10+import Language.PureScript.Ide.Error

9import Language.PureScript.Ide.Imports

11import Language.PureScript.Ide.Imports

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

10import Language.PureScript.Ide.Types

13import Language.PureScript.Ide.Types

14+import System.FilePath

11import Test.Hspec

15import Test.Hspec

12

16

13simpleFile :: [Text]

17simpleFile :: [Text]

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

22splitSimpleFile = fromRight (sliceImportSection simpleFile)

26splitSimpleFile = fromRight (sliceImportSection simpleFile)

23 where

27 where

24 fromRight = fromJust . rightToMaybe

28 fromRight = fromJust . rightToMaybe

29+

25withImports :: [Text] -> [Text]

30withImports :: [Text] -> [Text]

26withImports is =

31withImports is =

27 take 2 simpleFile ++ is ++ drop 2 simpleFile

32 take 2 simpleFile ++ is ++ drop 2 simpleFile

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

144 addImport imports import' = addExplicitImport' import' moduleName imports

149 addImport imports import' = addExplicitImport' import' moduleName imports

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

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

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

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

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

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

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

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

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

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

150 expectSorted imports expected = shouldBe

155 expectSorted imports expected = shouldBe

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

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

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

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

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

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

178 ["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

6import Protolude

7

8import qualified Language.PureScript as P

9−import Language.PureScript.Ide.Integration

10import Language.PureScript.Ide.Matcher

9import Language.PureScript.Ide.Matcher

11import Language.PureScript.Ide.Types

10import Language.PureScript.Ide.Types

12import Language.PureScript.Ide.Util

11import Language.PureScript.Ide.Util

@@ -26,9 +25,6 @@ completions = [firstResult, secondResult, fiult]

26runFlex :: Text -> [Match IdeDeclarationAnn]

25runFlex :: Text -> [Match IdeDeclarationAnn]

27runFlex s = runMatcher (flexMatcher s) completions

26runFlex s = runMatcher (flexMatcher s) completions

28

27

29−setup :: IO ()

30−setup = reset *> void loadAll

31−

32spec :: Spec

28spec :: Spec

33spec = do

29spec = do

34 describe "Flex Matcher" $ do

30 describe "Flex Matcher" $ do

@@ -38,12 +34,3 @@ spec = do

38 runFlex "firstResult" `shouldBe` [firstResult]

34 runFlex "firstResult" `shouldBe` [firstResult]

39 it "scores short matches higher and sorts accordingly" $

35 it "scores short matches higher and sorts accordingly" $

40 runFlex "filt" `shouldBe` [fiult, firstResult]

36 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

4

5import Protolude

6

7+import Language.PureScript.Ide.Command

8+import Language.PureScript.Ide.Matcher

9+import Language.PureScript.Ide.Types

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

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

8import System.FilePath

11import System.FilePath

9import Test.Hspec

12import Test.Hspec

10

13

11−shouldBeSuccess :: Text -> IO ()

14+load :: [Text] -> Command

12−shouldBeSuccess = shouldBe True . Integration.resultIsSuccess

15+load = LoadSync . map Test.mn

13

16

14−shouldBeFailure :: Text -> IO ()

17+rebuild :: FilePath -> Command

15−shouldBeFailure = shouldBe False . Integration.resultIsSuccess

18+rebuild fp = Rebuild ("src" </> fp)

19+

20+rebuildSync :: FilePath -> Command

21+rebuildSync fp = RebuildSync ("src" </> fp)

16

22

17spec :: Spec

23spec :: Spec

18−spec = before_ Integration.reset . describe "Rebuilding single modules" $ do

24+spec = describe "Rebuilding single modules" $ do

19 it "rebuilds a correct module without dependencies successfully" $ do

25 it "rebuilds a correct module without dependencies successfully" $ do

20− _ <- Integration.loadModule "RebuildSpecSingleModule"

26+ ([_, result], _) <- Test.inProject $

21− pdir <- Integration.projectDirectory

27+ Test.runIde [ load ["RebuildSpecSingleModule"]

22− let file = pdir </> "src" </> "RebuildSpecSingleModule.purs"

28+ , rebuild "RebuildSpecSingleModule.purs"

23− Integration.rebuildModule file >>= shouldBeSuccess

29+ ]

30+ result `shouldSatisfy` isRight

24 it "fails to rebuild an incorrect module without dependencies and returns the errors" $ do

31 it "fails to rebuild an incorrect module without dependencies and returns the errors" $ do

25− pdir <- Integration.projectDirectory

32+ ([result], _) <- Test.inProject $

26− let file = pdir </> "src" </> "RebuildSpecSingleModule.fail"

33+ Test.runIde [ rebuild "RebuildSpecSingleModule.fail" ]

27− Integration.rebuildModule file >>= shouldBeFailure

34+ result `shouldSatisfy` isLeft

28 it "rebuilds a correct module with its dependencies successfully" $ do

35 it "rebuilds a correct module with its dependencies successfully" $ do

36+ ([_, result], _) <- Test.inProject $

29− _ <- Integration.loadModules ["RebuildSpecWithDeps", "RebuildSpecDep"]

37+ Test.runIde [ load ["RebuildSpecWithDeps", "RebuildSpecDep"]

30− pdir <- Integration.projectDirectory

31− let file = pdir </> "src" </> "RebuildSpecWithDeps.purs"

38+ , rebuild "RebuildSpecWithDeps.purs"

32− Integration.rebuildModule file >>= shouldBeSuccess

39+ ]

40+ result `shouldSatisfy` isRight

33 it "rebuilds a correct module that has reverse dependencies" $ do

41 it "rebuilds a correct module that has reverse dependencies" $ do

34− _ <- Integration.loadModule "RebuildSpecWithDeps"

42+ ([_, result], _) <- Test.inProject $

35− pdir <- Integration.projectDirectory

36− let file = pdir </> "src" </> "RebuildSpecDep.purs"

43+ Test.runIde [ load ["RebuildSpecWithDeps"], rebuild "RebuildSpecDep.purs" ]

37− Integration.rebuildModule file >>= shouldBeSuccess

44+ result `shouldSatisfy` isRight

38 it "fails to rebuild a module if its dependencies are not loaded" $ do

45 it "fails to rebuild a module if its dependencies are not loaded" $ do

39− _ <- Integration.loadModule "RebuildSpecWithDeps"

46+ ([_, result], _) <- Test.inProject $

40− pdir <- Integration.projectDirectory

41− let file = pdir </> "src" </> "RebuildSpecWithDeps.purs"

47+ Test.runIde [ load ["RebuildSpecWithDeps"], rebuild "RebuildSpecWithDeps.purs" ]

42− Integration.rebuildModule file >>= shouldBeFailure

48+ result `shouldSatisfy` isLeft

43 it "rebuilds a correct module with a foreign file" $ do

49 it "rebuilds a correct module with a foreign file" $ do

44− _ <- Integration.loadModule "RebuildSpecWithForeign"

50+ ([_, result], _) <- Test.inProject $

45− pdir <- Integration.projectDirectory

46− let file = pdir </> "src" </> "RebuildSpecWithForeign.purs"

51+ Test.runIde [ load ["RebuildSpecWithForeign"], rebuild "RebuildSpecWithForeign.purs" ]

47− Integration.rebuildModule file >>= shouldBeSuccess

52+ result `shouldSatisfy` isRight

48 it "fails to rebuild a module with a foreign import but no file" $ do

53 it "fails to rebuild a module with a foreign import but no file" $ do

49− pdir <- Integration.projectDirectory

54+ ([result], _) <- Test.inProject $

50− let file = pdir </> "src" </> "RebuildSpecWithMissingForeign.fail"

55+ Test.runIde [ rebuild "RebuildSpecWithMissingForeign.fail" ]

51− Integration.rebuildModule file >>= shouldBeFailure

56+ result `shouldSatisfy` isLeft

52 it "completes a hidden identifier after rebuilding" $ do

57 it "completes a hidden identifier after rebuilding" $ do

53− pdir <- Integration.projectDirectory

58+ ([_, (Right (CompletionResult [ result ]))], _) <- Test.inProject $

54− let file = pdir </> "src" </> "RebuildSpecWithHiddenIdent.purs"

59+ Test.runIde [ rebuildSync "RebuildSpecWithHiddenIdent.purs"

55− Integration.rebuildModule file >>= shouldBeSuccess

56− res <- Integration.getFlexCompletionsInModule "hid" "RebuildSpecWithHiddenIdent"

60+ , Complete [] (flexMatcher "hid") (Just (Test.mn "RebuildSpecWithHiddenIdent"))]

57− shouldBe False (null res)

61+ complIdentifier result `shouldBe` "hidden"

tests/Language/PureScript/Ide/ReexportsSpec.hs+15−13

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

10import qualified Language.PureScript as P

11import Test.Hspec

12

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

14+

13m :: Text -> P.ModuleName

15m :: Text -> P.ModuleName

14m = P.moduleNameFromString

16m = P.moduleNameFromString

15

17

@@ -19,32 +21,32 @@ d = IdeDeclarationAnn emptyAnn

19valueA, typeA, classA, dtorA1, dtorA2 :: IdeDeclarationAnn

21valueA, typeA, classA, dtorA1, dtorA2 :: IdeDeclarationAnn

20valueA = d (IdeDeclValue (IdeValue (P.Ident "valueA") P.REmpty))

22valueA = d (IdeDeclValue (IdeValue (P.Ident "valueA") P.REmpty))

21typeA = d (IdeDeclType (IdeType(P.ProperName "TypeA") P.kindType))

23typeA = d (IdeDeclType (IdeType(P.ProperName "TypeA") P.kindType))

22−classA = d (IdeDeclTypeClass (P.ProperName "ClassA"))

24+classA = d (IdeDeclTypeClass (IdeTypeClass (P.ProperName "ClassA") []))

23dtorA1 = d (IdeDeclDataConstructor (IdeDataConstructor (P.ProperName "DtorA1") (P.ProperName "TypeA") P.REmpty))

25dtorA1 = d (IdeDeclDataConstructor (IdeDataConstructor (P.ProperName "DtorA1") (P.ProperName "TypeA") P.REmpty))

24dtorA2 = d (IdeDeclDataConstructor (IdeDataConstructor (P.ProperName "DtorA2") (P.ProperName "TypeA") P.REmpty))

26dtorA2 = d (IdeDeclDataConstructor (IdeDataConstructor (P.ProperName "DtorA2") (P.ProperName "TypeA") P.REmpty))

25

27

26−env :: Map P.ModuleName [IdeDeclarationAnn]

28+env :: ModuleMap [IdeDeclarationAnn]

27env = Map.fromList

29env = Map.fromList

28 [ (m "A", [valueA, typeA, classA, dtorA1, dtorA2])

30 [ (m "A", [valueA, typeA, classA, dtorA1, dtorA2])

29 ]

31 ]

30

32

31type Refs = [(P.ModuleName, P.DeclarationRef)]

33type Refs = [(P.ModuleName, P.DeclarationRef)]

32

34

33−succTestCases :: [(Text, Module, Refs, Module)]

35+succTestCases :: [(Text, [IdeDeclarationAnn], Refs, [IdeDeclarationAnn])]

34succTestCases =

36succTestCases =

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])

36 , ("resolves a type reexport with explicit data constructors"

38 , ("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])

38 , ("resolves a type reexport with implicit data constructors"

40 , ("resolves a type reexport with implicit data constructors"

39− , (m "C", []), [(m "A", P.TypeRef (P.ProperName "TypeA") Nothing)], (m "C", [typeA, dtorA1, dtorA2]))

41+ , [], [(m "A", P.TypeRef (P.ProperName "TypeA") Nothing)], [typeA, dtorA1, dtorA2])

40− , ("resolves a class reexport", (m "C", []), [(m "A", P.TypeClassRef (P.ProperName "ClassA"))], (m "C", [classA]))

42+ , ("resolves a class reexport", [], [(m "A", P.TypeClassRef (P.ProperName "ClassA"))], [classA])

41 ]

43 ]

42

44

43−failTestCases :: [(Text, Module, Refs)]

45+failTestCases :: [(Text, [IdeDeclarationAnn], Refs)]

44failTestCases =

46failTestCases =

45− [ ("fails to resolve a non existing value", (m "C", []), [(m "A", P.ValueRef (P.Ident "valueB"))])

47+ [ ("fails to resolve a non existing value", [], [(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)])

48+ , ("fails to resolve a non existing type reexport" , [], [(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"))])

49+ , ("fails to resolve a non existing class reexport", [], [(m "A", P.TypeClassRef (P.ProperName "ClassB"))])

48 ]

50 ]

49

51

50spec :: Spec

52spec :: Spec

@@ -52,12 +54,12 @@ spec = do

52 describe "Successful Reexports" $

54 describe "Successful Reexports" $

53 for_ succTestCases $ \(desc, initial, refs, result) ->

55 for_ succTestCases $ \(desc, initial, refs, result) ->

54 it (toS desc) $ do

56 it (toS desc) $ do

55− let reResult = resolveReexports env (initial, refs)

57+ let reResult = resolveReexports' env initial refs

56 reResolved reResult `shouldBe` result

58 reResolved reResult `shouldBe` result

57 reResult `shouldSatisfy` not . reexportHasFailures

59 reResult `shouldSatisfy` not . reexportHasFailures

58 describe "Failed Reexports" $

60 describe "Failed Reexports" $

59 for_ failTestCases $ \(desc, initial, refs) ->

61 for_ failTestCases $ \(desc, initial, refs) ->

60 it (toS desc) $ do

62 it (toS desc) $ do

61− let reResult = resolveReexports env (initial, refs)

63+ let reResult = resolveReexports' env initial refs

62 reFailed reResult `shouldBe` refs

64 reFailed reResult `shouldBe` refs

63 reResult `shouldSatisfy` reexportHasFailures

65 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

5import Protolude

6

7import qualified Language.PureScript as P

8+import Language.PureScript.Ide.Command

8import Language.PureScript.Ide.SourceFile

9import Language.PureScript.Ide.SourceFile

9import Language.PureScript.Ide.Types

10import Language.PureScript.Ide.Types

11+import Language.PureScript.Ide.Test

10import Test.Hspec

12import Test.Hspec

11

13

12span0, span1, span2 :: P.SourceSpan

14span0, span1, span2 :: P.SourceSpan

@@ -52,3 +54,43 @@ spec = do

52 describe "Type annotations" $ do

54 describe "Type annotations" $ do

53 it "extracts a type annotation" $

55 it "extracts a type annotation" $

54 extractTypeAnnotations [typeAnnotation1] `shouldBe` [(P.Ident "value1", P.REmpty)]

56 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 @@

3module Language.PureScript.Ide.StateSpec where

4

5import Protolude

6+import Control.Lens hiding ((&))

6import Language.PureScript.Ide.Types

7import Language.PureScript.Ide.Types

7import Language.PureScript.Ide.State

8import Language.PureScript.Ide.State

8import qualified Language.PureScript as P

9import qualified Language.PureScript as P

@@ -21,7 +22,7 @@ typeOperator :: Maybe P.Kind -> IdeDeclarationAnn

21typeOperator =

22typeOperator =

22 d . IdeDeclTypeOperator . IdeTypeOperator (P.OpName ":") (P.Qualified (Just (mn "Test")) (P.ProperName "List")) 2 P.Infix

23 d . IdeDeclTypeOperator . IdeTypeOperator (P.OpName ":") (P.Qualified (Just (mn "Test")) (P.ProperName "List")) 2 P.Infix

23

24

24−testModule :: Module

25+testModule :: (P.ModuleName, [IdeDeclarationAnn])

25testModule = (mn "Test", [ d (IdeDeclValue (IdeValue (P.Ident "function") P.REmpty))

26testModule = (mn "Test", [ d (IdeDeclValue (IdeValue (P.Ident "function") P.REmpty))

26 , d (IdeDeclDataConstructor (IdeDataConstructor (P.ProperName "Cons") (P.ProperName "List") (P.REmpty)))

27 , d (IdeDeclDataConstructor (IdeDataConstructor (P.ProperName "Cons") (P.ProperName "List") (P.REmpty)))

27 , d (IdeDeclType (IdeType (P.ProperName "List") P.kindType))

28 , d (IdeDeclType (IdeType (P.ProperName "List") P.kindType))

@@ -34,18 +35,57 @@ d :: IdeDeclaration -> IdeDeclarationAnn

34d = IdeDeclarationAnn emptyAnn

35d = IdeDeclarationAnn emptyAnn

35

36

36mn :: Text -> P.ModuleName

37mn :: Text -> P.ModuleName

37−mn = P.moduleNameFromString . toS

38+mn = P.moduleNameFromString

38

39

39−testState :: Map P.ModuleName [IdeDeclarationAnn]

40+testState :: ModuleMap [IdeDeclarationAnn]

40−testState = Map.fromList

41+testState = Map.fromList [testModule]

41− [ 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+ -- }

42− ]

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

43

77

44spec :: Spec

78spec :: Spec

79+spec = do

45−spec = describe "resolving operators" $ do

80+ describe "resolving operators" $ do

46− it "resolves the type for a value operator" $

81+ it "resolves the type for a value operator" $

47− resolveOperatorsForModule testState (snd testModule) `shouldSatisfy` elem (valueOperator (Just P.REmpty))

82+ resolveOperatorsForModule testState (snd testModule) `shouldSatisfy` elem (valueOperator (Just P.REmpty))

48− it "resolves the type for a constructor operator" $

83+ it "resolves the type for a constructor operator" $

49− resolveOperatorsForModule testState (snd testModule) `shouldSatisfy` elem (ctorOperator (Just P.REmpty))

84+ resolveOperatorsForModule testState (snd testModule) `shouldSatisfy` elem (ctorOperator (Just P.REmpty))

50− it "resolves the kind for a type operator" $

85+ it "resolves the kind for a type operator" $

51− resolveOperatorsForModule testState (snd testModule) `shouldSatisfy` elem (typeOperator (Just P.kindType))

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

5+

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 @@

1module TestPscIde where

2

3import Control.Monad (unless)

4−import Language.PureScript.Ide.Integration

5import qualified PscIdeSpec

4import qualified PscIdeSpec

5+import Language.PureScript.Ide.Test

6import Test.Hspec

7

8main :: IO ()

9main = do

10 deleteOutputFolder

11 s <- compileTestProject

12− unless s $ fail "Failed to compile .purs sources"

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)

13+ hspec PscIdeSpec.spec

tests/TestUtils.hs+1

@@ -78,6 +78,7 @@ supportModules =

78 , "Data.Array"

79 , "Data.Array.Partial"

80 , "Data.Array.ST"

81+ , "Data.Array.ST.Iterator"

81 , "Data.Bifoldable"

82 , "Data.Bifoldable"

82 , "Data.Bifunctor"

83 , "Data.Bifunctor"

83 , "Data.Bifunctor.Clown"

84 , "Data.Bifunctor.Clown"