4e33a7e · rowtype-yoga/purescript-native

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

Merge branch 'master' into pure11

commit4e33a7e317e8e435fd1bae347902b5b910299a97 authorAndy Arvanitis <andyarvanitis@gmail.com> dateMon 2 Jan 2017, 11:16 (10 years ago) parent812a9a7 488f8c2

97 files changed+3051−751

compare with golang

unifiedsplit

LICENSE+820−79

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

1616

1717 Glob

1818 SHA

19+ StateVar

20+ adjunctions

1921 aeson

2022 aeson-better-errors

2123 aeson-pretty

@@ -31,7 +33,9 @@ PureScript uses the following Haskell library packages. Their license files foll

3133 auto-update

3234 base

3335 base-compat

36+ base-orphans

3437 base64-bytestring

38+ bifunctors

3539 binary

3640 blaze-builder

3741 blaze-html

@@ -46,16 +50,19 @@ PureScript uses the following Haskell library packages. Their license files foll

4650 cereal

4751 clock

4852 cmdargs

53+ comonad

4954 conduit

5055 conduit-extra

5156 connection

5257 containers

58+ contravariant

5359 cookie

5460 cryptonite

5561 data-default-class

5662 data-ordlist

5763 deepseq

5864 directory

65+ distributive

5966 dlist

6067 easy-file

6168 edit-distance

@@ -65,12 +72,15 @@ PureScript uses the following Haskell library packages. Their license files foll

6572 fast-logger

6673 file-embed

6774 filepath

75+ foldl

76+ free

6877 fsnotify

6978 ghc-prim

7079 hashable

7180 haskeline

7281 hex

73− hfsevents

82+ hinotify

83+ hostname

7484 hourglass

7585 http-client

7686 http-client-tls

@@ -79,8 +89,11 @@ PureScript uses the following Haskell library packages. Their license files foll

7989 http2

8090 integer-gmp

8191 iproute

92+ kan-extensions

8293 language-javascript

94+ lens

8395 lifted-base

96+ managed

8497 memory

8598 mime-types

8699 mmorph

@@ -88,10 +101,12 @@ PureScript uses the following Haskell library packages. Their license files foll

88101 monad-logger

89102 monad-loops

90103 mtl

104+ mwc-random

91105 network

92106 network-uri

93107 old-locale

94108 old-time

109+ optional-args

95110 optparse-applicative

96111 parallel

97112 parsec

@@ -99,16 +114,20 @@ PureScript uses the following Haskell library packages. Their license files foll

99114 pem

100115 pipes

101116 pipes-http

117+ prelude-extras

102118 primitive

103119 process

120+ profunctors

104121 protolude

105122 psqueues

106123 random

124+ reflection

107125 regex-base

108126 regex-tdfa

109127 resourcet

110128 safe

111129 scientific

130+ semigroupoids

112131 semigroups

113132 simple-sendfile

114133 socks

@@ -120,16 +139,19 @@ PureScript uses the following Haskell library packages. Their license files foll

120139 streaming-commons

121140 stringsearch

122141 syb

142+ system-fileio

143+ system-filepath

123144 tagged

124145 template-haskell

146+ temporary

125147 terminfo

126148 text

127149 time

128− time-locale-compat

129150 tls

130151 transformers

131152 transformers-base

132153 transformers-compat

154+ turtle

133155 unix

134156 unix-compat

135157 unix-time

@@ -215,6 +237,67 @@ SHA LICENSE file:

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

216238 POSSIBILITY OF SUCH DAMAGE.

217239

240+StateVar LICENSE file:

241+

245+

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

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

248+

249+ 1. Redistributions of source code must retain the above copyright notice,

250+ this list of conditions and the following disclaimer.

251+

252+ 2. Redistributions in binary form must reproduce the above copyright

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

254+ documentation and/or other materials provided with the distribution.

255+

256+ 3. Neither the name of the author nor the names of its contributors may be

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

258+ specific prior written permission.

259+

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

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

262+ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE

263+ ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE

264+ LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR

265+ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF

266+ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS

267+ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN

268+ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)

269+ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE

270+ POSSIBILITY OF SUCH DAMAGE.

271+

272+adjunctions LICENSE file:

273+

275+

277+

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

279+ modification, are permitted provided that the following conditions

280+ are met:

281+

282+ 1. Redistributions of source code must retain the above copyright

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

284+

285+ 2. Redistributions in binary form must reproduce the above copyright

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

287+ documentation and/or other materials provided with the distribution.

288+

289+ THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR

290+ IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED

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

292+ DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR

293+ ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL

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

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

296+ HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,

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

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

299+ POSSIBILITY OF SUCH DAMAGE.

300+

218301aeson LICENSE file:

219302

@@ -762,6 +845,29 @@ base-compat LICENSE file:

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

763846 THE SOFTWARE.

764847

848+base-orphans LICENSE file:

849+

851+

852+ Permission is hereby granted, free of charge, to any person obtaining

853+ a copy of this software and associated documentation files (the

854+ "Software"), to deal in the Software without restriction, including

855+ without limitation the rights to use, copy, modify, merge, publish,

856+ distribute, sublicense, and/or sell copies of the Software, and to

857+ permit persons to whom the Software is furnished to do so, subject to

858+ the following conditions:

859+

860+ The above copyright notice and this permission notice shall be included

861+ in all copies or substantial portions of the Software.

862+

863+ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,

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

865+ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.

866+ IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY

867+ CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,

868+ TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE

869+ SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

870+

765871base64-bytestring LICENSE file:

766872

@@ -795,6 +901,35 @@ base64-bytestring LICENSE file:

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

796902 POSSIBILITY OF SUCH DAMAGE.

797903

904+bifunctors LICENSE file:

905+

907+

909+

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

911+ modification, are permitted provided that the following conditions

912+ are met:

913+

914+ 1. Redistributions of source code must retain the above copyright

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

916+

917+ 2. Redistributions in binary form must reproduce the above copyright

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

919+ documentation and/or other materials provided with the distribution.

920+

921+ THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR

922+ IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED

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

924+ DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR

925+ ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL

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

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

928+ HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,

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

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

931+ POSSIBILITY OF SUCH DAMAGE.

932+

798933binary LICENSE file:

799934

800935 Copyright (c) Lennart Kolmodin

@@ -1244,6 +1379,36 @@ cmdargs LICENSE file:

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

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

12461381

1382+comonad LICENSE file:

1383+

1386+

1388+

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

1390+ modification, are permitted provided that the following conditions

1391+ are met:

1392+

1393+ 1. Redistributions of source code must retain the above copyright

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

1395+

1396+ 2. Redistributions in binary form must reproduce the above copyright

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

1398+ documentation and/or other materials provided with the distribution.

1399+

1400+ THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR

1401+ IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED

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

1403+ DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR

1404+ ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL

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

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

1407+ HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,

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

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

1410+ POSSIBILITY OF SUCH DAMAGE.

1411+

12471412conduit LICENSE file:

12481413

@@ -1354,6 +1519,39 @@ containers LICENSE file:

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

13551520 DAMAGE.

13561521

1522+contravariant LICENSE file:

1523+

1525+

1527+

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

1529+ modification, are permitted provided that the following conditions

1530+ are met:

1531+

1532+ 1. Redistributions of source code must retain the above copyright

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

1534+

1535+ 2. Redistributions in binary form must reproduce the above copyright

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

1537+ documentation and/or other materials provided with the distribution.

1538+

1539+ 3. Neither the name of the author nor the names of his contributors

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

1541+ without specific prior written permission.

1542+

1543+ THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR

1544+ IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED

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

1546+ DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR

1547+ ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL

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

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

1550+ HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,

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

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

1553+ POSSIBILITY OF SUCH DAMAGE.

1554+

13571555cookie LICENSE file:

13581556

@@ -1426,16 +1624,16 @@ data-default-class LICENSE file:

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

14271625 without specific prior written permission.

14281626

1429− THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND

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

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

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

14311629 WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE

1432− DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE

1433− FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL

1434− DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR

1435− SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER

1436− CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,

1437− OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE

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

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

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

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

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

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

1635+ (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.

14391637

14401638data-ordlist LICENSE file:

14411639

@@ -1558,9 +1756,38 @@ directory LICENSE file:

15581756

15591757 -----------------------------------------------------------------------------

15601758

1759+distributive LICENSE file:

1760+

1762+

1764+

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

1766+ modification, are permitted provided that the following conditions

1767+ are met:

1768+

1769+ 1. Redistributions of source code must retain the above copyright

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

1771+

1772+ 2. Redistributions in binary form must reproduce the above copyright

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

1774+ documentation and/or other materials provided with the distribution.

1775+

1776+ THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR

1777+ IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED

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

1779+ DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR

1780+ ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL

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

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

1783+ HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,

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

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

1786+ POSSIBILITY OF SUCH DAMAGE.

1787+

15611788dlist LICENSE file:

15621789

15641791

15661793

@@ -1842,6 +2069,66 @@ filepath LICENSE file:

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

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

18442071

2072+foldl LICENSE file:

2073+

2076+

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

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

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

2080+ this list of conditions and the following disclaimer.

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

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

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

2084+ * Neither the name of Gabriel Gonzalez nor the names of other contributors

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

2086+ without specific prior written permission.

2087+

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

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

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

2091+ DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR

2092+ ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES

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

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

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

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

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

2098+

2099+free LICENSE file:

2100+

2102+

2104+

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

2106+ modification, are permitted provided that the following conditions

2107+ are met:

2108+

2109+ 1. Redistributions of source code must retain the above copyright

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

2111+

2112+ 2. Redistributions in binary form must reproduce the above copyright

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

2114+ documentation and/or other materials provided with the distribution.

2115+

2116+ 3. Neither the name of the author nor the names of his contributors

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

2118+ without specific prior written permission.

2119+

2120+ THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR

2121+ IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED

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

2123+ DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR

2124+ ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL

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

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

2127+ HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,

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

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

2130+ POSSIBILITY OF SUCH DAMAGE.

2131+

18452132fsnotify LICENSE file:

18462133

@@ -2001,40 +2288,93 @@ haskeline LICENSE file:

20012288

20022289hex LICENSE file:

20032290

2004− Page not found: Sorry, it's just not here.

20052293

2006−hfsevents LICENSE file:

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

2295+ modification, are permitted provided that the following conditions

2296+ are met:

2297+

2298+ Redistributions of source code must retain the above copyright

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

2300+

2301+ Redistributions in binary form must reproduce the above copyright

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

2303+ documentation and/or other materials provided with the distribution.

2304+

2305+ Neither the name of the Taru Karttunen; nor the names of its contributors

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

2307+ without specific prior written permission.

2308+

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

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

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

2312+ A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR

2313+ CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,

2314+ EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,

2315+ PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR

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

2317+ LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING

2318+ NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS

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

20072320

2321+hinotify LICENSE file:

2322+

2323+ Copyright (c) Lennart Kolmodin

20092324

20112326

20122327 Redistribution and use in source and binary forms, with or without

2013− modification, are permitted provided that the following conditions are met:

2328+ modification, are permitted provided that the following conditions

2329+ are met:

20142330

2015− * Redistributions of source code must retain the above copyright

2016− notice, this list of conditions and the following disclaimer.

2331+ 1. Redistributions of source code must retain the above copyright

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

20172333

2018− * Redistributions in binary form must reproduce the above

2019− copyright notice, this list of conditions and the following

2020− disclaimer in the documentation and/or other materials provided

2021− with the distribution.

2334+ 2. Redistributions in binary form must reproduce the above copyright

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

2336+ documentation and/or other materials provided with the distribution.

20222337

2023− * Neither the name of Luite Stegeman nor the names of other

2024− contributors may be used to endorse or promote products derived

2025− from this software without specific prior written permission.

2338+ 3. Neither the name of the author nor the names of his contributors

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

2340+ without specific prior written permission.

20262341

2027− THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS

2028− "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT

2029− LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR

2030− A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT

2031− OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,

2032− SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT

2033− LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,

2034− DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY

2035− THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT

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

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

2342+ THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS

2343+ OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED

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

2345+ DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR

2346+ ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL

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

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

2349+ HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,

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

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

2352+ POSSIBILITY OF SUCH DAMAGE.

2353+

2354+hostname LICENSE file:

2355+

2358+

2359+ Redistribution and use in source and binary forms, with or without modification, are permitted

2360+ provided that the following conditions are met:

2361+

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

2363+ conditions and the following disclaimer.

2364+ * Redistributions in binary form must reproduce the above copyright notice, this list of

2365+ conditions and the following disclaimer in the documentation and/or other materials

2366+ provided with the distribution.

2367+ * Neither the name of Maximilian Bolingbroke nor the names of other contributors may be used to

2368+ endorse or promote products derived from this software without specific prior written permission.

2369+

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

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

2372+ FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR

2373+ CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL

2374+ DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,

2375+ DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER

2376+ IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT

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

20382378

20392379hourglass LICENSE file:

20402380

@@ -2275,6 +2615,39 @@ iproute LICENSE file:

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

22762616 POSSIBILITY OF SUCH DAMAGE.

22772617

2618+kan-extensions LICENSE file:

2619+

2621+

2623+

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

2625+ modification, are permitted provided that the following conditions

2626+ are met:

2627+

2628+ 1. Redistributions of source code must retain the above copyright

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

2630+

2631+ 2. Redistributions in binary form must reproduce the above copyright

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

2633+ documentation and/or other materials provided with the distribution.

2634+

2635+ 3. Neither the name of the author nor the names of his contributors

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

2637+ without specific prior written permission.

2638+

2639+ THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR

2640+ IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED

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

2642+ DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR

2643+ ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL

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

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

2646+ HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,

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

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

2649+ POSSIBILITY OF SUCH DAMAGE.

2650+

22782651language-javascript LICENSE file:

22792652

@@ -2308,6 +2681,39 @@ language-javascript LICENSE file:

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

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

23102683

2684+lens LICENSE file:

2685+

2687+

2689+

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

2691+ modification, are permitted provided that the following conditions

2692+ are met:

2693+

2694+ 1. Redistributions of source code must retain the above copyright

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

2696+

2697+ 2. Redistributions in binary form must reproduce the above copyright

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

2699+ documentation and/or other materials provided with the distribution.

2700+

2701+ 3. Neither the name of the author nor the names of his contributors

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

2703+ without specific prior written permission.

2704+

2705+ THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR

2706+ IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED

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

2708+ DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR

2709+ ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL

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

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

2712+ HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,

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

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

2715+ POSSIBILITY OF SUCH DAMAGE.

2716+

23112717lifted-base LICENSE file:

23122718

@@ -2340,6 +2746,33 @@ lifted-base LICENSE file:

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

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

23422748

2749+managed LICENSE file:

2750+

2753+

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

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

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

2757+ this list of conditions and the following disclaimer.

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

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

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

2761+ * Neither the name of Gabriel Gonzalez nor the names of other contributors

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

2763+ without specific prior written permission.

2764+

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

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

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

2768+ DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR

2769+ ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES

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

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

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

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

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

2775+

23432776memory LICENSE file:

23442777

@@ -2477,10 +2910,6 @@ monad-logger LICENSE file:

24772910 OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION

24782911 WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

24792912

2480−monad-loops LICENSE file:

2481−

2482− Page not found: Sorry, it's just not here.

2483−

24842913mtl LICENSE file:

24852914

24862915 The Glasgow Haskell Compiler License

@@ -2515,6 +2944,35 @@ mtl LICENSE file:

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

25162945 DAMAGE.

25172946

2947+mwc-random LICENSE file:

2948+

2951+

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

2953+ modification, are permitted provided that the following conditions

2954+ are met:

2955+

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

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

2958+

2959+ * Redistributions in binary form must reproduce the above

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

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

2962+ with the distribution.

2963+

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

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

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

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

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

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

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

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

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

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

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

2975+

25182976network LICENSE file:

25192977

@@ -2711,6 +3169,33 @@ old-time LICENSE file:

27113169

27123170 -----------------------------------------------------------------------------

27133171

3172+optional-args LICENSE file:

3173+

3176+

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

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

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

3180+ this list of conditions and the following disclaimer.

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

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

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

3184+ * Neither the name of Gabriel Gonzalez nor the names of other contributors

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

3186+ without specific prior written permission.

3187+

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

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

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

3191+ DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR

3192+ ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES

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

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

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

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

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

3198+

27143199optparse-applicative LICENSE file:

27153200

@@ -2865,7 +3350,7 @@ pem LICENSE file:

28653350

28663351pipes LICENSE file:

28673352

28703355

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

@@ -2917,6 +3402,39 @@ pipes-http LICENSE file:

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

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

29193404

3405+prelude-extras LICENSE file:

3406+

3408+

3410+

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

3412+ modification, are permitted provided that the following conditions

3413+ are met:

3414+

3415+ 1. Redistributions of source code must retain the above copyright

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

3417+

3418+ 2. Redistributions in binary form must reproduce the above copyright

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

3420+ documentation and/or other materials provided with the distribution.

3421+

3422+ 3. Neither the name of the author nor the names of his contributors

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

3424+ without specific prior written permission.

3425+

3426+ THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR

3427+ IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED

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

3429+ DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR

3430+ ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL

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

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

3433+ HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,

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

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

3436+ POSSIBILITY OF SUCH DAMAGE.

3437+

29203438primitive LICENSE file:

29213439

@@ -3016,6 +3534,39 @@ process LICENSE file:

30163534

30173535 -----------------------------------------------------------------------------

30183536

3537+profunctors LICENSE file:

3538+

3540+

3542+

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

3544+ modification, are permitted provided that the following conditions

3545+ are met:

3546+

3547+ 1. Redistributions of source code must retain the above copyright

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

3549+

3550+ 2. Redistributions in binary form must reproduce the above copyright

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

3552+ documentation and/or other materials provided with the distribution.

3553+

3554+ 3. Neither the name of the author nor the names of his contributors

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

3556+ without specific prior written permission.

3557+

3558+ THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR

3559+ IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED

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

3561+ DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR

3562+ ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL

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

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

3565+ HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,

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

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

3568+ POSSIBILITY OF SUCH DAMAGE.

3569+

30193570protolude LICENSE file:

30203571

@@ -3138,6 +3689,40 @@ random LICENSE file:

31383689

31393690 -----------------------------------------------------------------------------

31403691

3692+reflection LICENSE file:

3693+

3697+

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

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

3700+ met:

3701+

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

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

3704+

3705+ * Redistributions in binary form must reproduce the above

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

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

3708+ with the distribution.

3709+

3710+ * Neither the name of Edward Kmett nor the names of other

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

3712+ from this software without specific prior written permission.

3713+

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

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

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

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

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

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

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

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

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

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

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

3725+

31413726regex-base LICENSE file:

31423727

31433728 This modile is under this "3 clause" BSD license:

@@ -3203,7 +3788,7 @@ resourcet LICENSE file:

32033788

32043789safe LICENSE file:

32053790

3206− Copyright Neil Mitchell 2007-2015.

3791+ Copyright Neil Mitchell 2007-2016.

32083793

32093794 Redistribution and use in source and binary forms, with or without

@@ -3267,6 +3852,35 @@ scientific LICENSE file:

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

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

32693854

3855+semigroupoids LICENSE file:

3856+

3858+

3860+

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

3862+ modification, are permitted provided that the following conditions

3863+ are met:

3864+

3865+ 1. Redistributions of source code must retain the above copyright

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

3867+

3868+ 2. Redistributions in binary form must reproduce the above copyright

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

3870+ documentation and/or other materials provided with the distribution.

3871+

3872+ THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR

3873+ IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED

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

3875+ DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR

3876+ ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL

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

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

3879+ HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,

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

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

3882+ POSSIBILITY OF SUCH DAMAGE.

3883+

32703884semigroups LICENSE file:

32713885

@@ -3552,7 +4166,36 @@ streaming-commons LICENSE file:

35524166

35534167stringsearch LICENSE file:

35544168

3555− Page not found: Sorry, it's just not here.

4170+

4172+

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

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

4175+

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

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

4178+

4179+ * Redistributions in binary form must reproduce the above

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

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

4182+ with the distribution.

4183+

4184+ * Neither the name of Daniel Fischer nor the names of other

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

4186+ from this software without specific prior written permission.

4187+

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

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

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

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

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

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

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

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

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

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

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

35564199

35574200syb LICENSE file:

35584201

@@ -3640,6 +4283,56 @@ syb LICENSE file:

36404283

36414284 -----------------------------------------------------------------------------

36424285

4286+system-fileio LICENSE file:

4287+

4289+

4290+ Permission is hereby granted, free of charge, to any person

4291+ obtaining a copy of this software and associated documentation

4292+ files (the "Software"), to deal in the Software without

4293+ restriction, including without limitation the rights to use,

4294+ copy, modify, merge, publish, distribute, sublicense, and/or sell

4295+ copies of the Software, and to permit persons to whom the

4296+ Software is furnished to do so, subject to the following

4297+ conditions:

4298+

4299+ The above copyright notice and this permission notice shall be

4300+ included in all copies or substantial portions of the Software.

4301+

4302+ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,

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

4304+ OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND

4305+ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT

4306+ HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,

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

4308+ FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR

4309+ OTHER DEALINGS IN THE SOFTWARE.

4310+

4311+system-filepath LICENSE file:

4312+

4314+

4315+ Permission is hereby granted, free of charge, to any person

4316+ obtaining a copy of this software and associated documentation

4317+ files (the "Software"), to deal in the Software without

4318+ restriction, including without limitation the rights to use,

4319+ copy, modify, merge, publish, distribute, sublicense, and/or sell

4320+ copies of the Software, and to permit persons to whom the

4321+ Software is furnished to do so, subject to the following

4322+ conditions:

4323+

4324+ The above copyright notice and this permission notice shall be

4325+ included in all copies or substantial portions of the Software.

4326+

4327+ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,

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

4329+ OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND

4330+ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT

4331+ HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,

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

4333+ FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR

4334+ OTHER DEALINGS IN THE SOFTWARE.

4335+

36434336tagged LICENSE file:

36444337

@@ -3709,6 +4402,31 @@ template-haskell LICENSE file:

37094402 DAMAGE.

37104403

37114404

4405+temporary LICENSE file:

4406+

4409+

4410+ Redistribution and use in source and binary forms, with or without modification, are permitted

4411+ provided that the following conditions are met:

4412+

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

4414+ conditions and the following disclaimer.

4415+ * Redistributions in binary form must reproduce the above copyright notice, this list of

4416+ conditions and the following disclaimer in the documentation and/or other materials

4417+ provided with the distribution.

4418+ * Neither the name of Maximilian Bolingbroke nor the names of other contributors may be used to

4419+ endorse or promote products derived from this software without specific prior written permission.

4420+

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

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

4423+ FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR

4424+ CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL

4425+ DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,

4426+ DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER

4427+ IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT

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

4429+

37124430terminfo LICENSE file:

37134431

@@ -3777,39 +4495,6 @@ time LICENSE file:

37774495

37784496 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

37794497

3780−time-locale-compat LICENSE file:

3781−

3783−

3785−

3786− Redistribution and use in source and binary forms, with or without

3787− modification, are permitted provided that the following conditions are met:

3788−

3789− * Redistributions of source code must retain the above copyright

3790− notice, this list of conditions and the following disclaimer.

3791−

3792− * Redistributions in binary form must reproduce the above

3793− copyright notice, this list of conditions and the following

3794− disclaimer in the documentation and/or other materials provided

3795− with the distribution.

3796−

3797− * Neither the name of Kei Hibino nor the names of other

3798− contributors may be used to endorse or promote products derived

3799− from this software without specific prior written permission.

3800−

3801− THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS

3802− "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT

3803− LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR

3804− A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT

3805− OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,

3806− SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT

3807− LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,

3808− DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY

3809− THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT

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

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

3812−

38134498tls LICENSE file:

38144499

@@ -3906,7 +4591,7 @@ transformers-base LICENSE file:

39064591

39074592transformers-compat LICENSE file:

39084593

39104595

39124597

@@ -3937,6 +4622,33 @@ transformers-compat LICENSE file:

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

39384623 POSSIBILITY OF SUCH DAMAGE.

39394624

4625+turtle LICENSE file:

4626+

4629+

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

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

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

4633+ this list of conditions and the following disclaimer.

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

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

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

4637+ * Neither the name of Gabriel Gonzalez nor the names of other contributors

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

4639+ without specific prior written permission.

4640+

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

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

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

4644+ DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR

4645+ ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES

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

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

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

4649+ (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.

4651+

39404652unix LICENSE file:

39414653

39424654 The Glasgow Haskell Compiler License

@@ -4343,7 +5055,36 @@ warp LICENSE file:

43435055

43445056websockets LICENSE file:

43455057

4346− Page not found: Sorry, it's just not here.

5058+ Copyright Jasper Van der Jeugt, 2011

5059+

5061+

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

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

5064+

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

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

5067+

5068+ * Redistributions in binary form must reproduce the above

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

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

5071+ with the distribution.

5072+

5073+ * Neither the name of Siniša Biđin nor the names of other

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

5075+ from this software without specific prior written permission.

5076+

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

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

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

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

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

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

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

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

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

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

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

43475088

43485089word8 LICENSE file:

43495090

@@ -4499,7 +5240,7 @@ x509-validation LICENSE file:

44995240

45005241zlib LICENSE file:

45015242

45045245

45055246 Redistribution and use in source and binary forms, with or without

README.md−4

@@ -4,10 +4,6 @@ A small strongly typed programming language with expressive types that compiles

55[![Hackage](https://img.shields.io/hackage/v/purescript.svg)](http://hackage.haskell.org/package/purescript) [![Build Status](https://api.travis-ci.org/purescript/purescript.svg?branch=master)](http://travis-ci.org/purescript/purescript)

7−[![Stackage LTS 2](http://stackage.org/package/purescript/badge/lts-2)](http://stackage.org/lts-2/package/purescript)

8−[![Stackage LTS 3](http://stackage.org/package/purescript/badge/lts-3)](http://stackage.org/lts-3/package/purescript)

9−[![Stackage Nightly](http://stackage.org/package/purescript/badge/nightly)](http://stackage.org/nightly/package/purescript)

10−

117## Language info

128

139- [PureScript home](http://purescript.org)

examples/docs/src/DocComments.pursnew file+11

@@ -0,0 +1,11 @@

1+module DocComments where

3+-- | This declaration has a code block:

4+-- |

5+-- | example == 0

6+-- |

7+-- | Here we are really testing that the leading whitespace is not stripped, as

8+-- | this ensures that we don't accidentally change code blocks into normal

9+-- | paragraphs.

10+example :: Int

11+example = 0

examples/failing/DiffKindsSameName.pursnew file+15

@@ -0,0 +1,15 @@

1+-- @shouldFailWith KindsDoNotUnify

2+module DiffKindsSameName where

4+import DiffKindsSameName.LibA as LibA

5+import DiffKindsSameName.LibB as LibB

7+-- both `LibA` and `LibB` define a kind locally called `DemoKind`

8+-- `LibB` defines `DemoData :: LibB.DemoKind`

9+-- if we try to use `DemoData` in a place where `LibA.DemoKind` is expected, it should fail with `KindsDoNotUnify`

10+

11+data AProxy (m :: LibA.DemoKind) = AProxy

12+

13+bProxy :: AProxy LibB.DemoData

14+bProxy = AProxy

15+

examples/failing/DiffKindsSameName/LibA.pursnew file+4

@@ -0,0 +1,4 @@

1+module DiffKindsSameName.LibA where

3+foreign import kind DemoKind

examples/failing/DiffKindsSameName/LibB.pursnew file+6

@@ -0,0 +1,6 @@

1+module DiffKindsSameName.LibB where

3+foreign import kind DemoKind

5+foreign import data DemoData :: DemoKind

examples/failing/OrphanInstanceFunDepCycle.pursnew file+5

@@ -0,0 +1,5 @@

1+-- @shouldFailWith OrphanInstance

2+module Main where

3+import Lib

4+data L

5+instance clr :: C L R

examples/failing/OrphanInstanceFunDepCycle/Lib.pursnew file+4

@@ -0,0 +1,4 @@

1+module Lib where

2+-- covering sets: {{l}, {r}}

3+class C l r | l -> r, r -> l

4+data R

examples/failing/OrphanInstanceNullary.pursnew file+4

@@ -0,0 +1,4 @@

1+-- @shouldFailWith OrphanInstance

2+module Test where

3+import Lib

4+instance c :: C

examples/failing/OrphanInstanceNullary/Lib.pursnew file+2

@@ -0,0 +1,2 @@

1+module Lib where

2+class C

examples/failing/OrphanInstanceWithDetermined.pursnew file+5

@@ -0,0 +1,5 @@

1+-- @shouldFailWith OrphanInstance

2+module Main where

3+import Lib

4+data R

5+instance cflr :: C F L R

examples/failing/OrphanInstanceWithDetermined/Lib.pursnew file+5

@@ -0,0 +1,5 @@

1+module Lib where

2+-- covering sets: {{f, l}}

3+class C f l r | l -> r

4+data F

5+data L

examples/passing/DeriveNewtype.purs+3−1

@@ -4,7 +4,9 @@ import Control.Monad.Eff.Console (log)

55import Data.Newtype

7−newtype Test = Test String

7+type MyString = String

9+newtype Test = Test MyString

810

911derive instance newtypeTest :: Newtype Test _

1012

examples/passing/DeriveWithNestedSynonyms.pursnew file+29

@@ -0,0 +1,29 @@

1+module Main where

3+import Prelude

4+import Control.Monad.Eff.Console (log)

6+type L = {}

7+data X = X L

8+derive instance eqX :: Eq X

10+type M = {}

11+data Y = Y {foo :: M}

12+derive instance eqY :: Eq Y

13+

14+type N = {}

15+data Z = Z N

16+derive instance eqZ :: Eq Z

17+

18+type Foo = String

19+

20+type Bar = { foo :: Foo }

21+

22+type Baz = { baz :: Bar }

23+

24+newtype T = T Baz

25+

26+derive instance eqT :: Eq T

27+derive instance ordT :: Ord T

28+

29+main = log "Done"

examples/passing/Deriving.purs+3−1

@@ -10,7 +10,9 @@ derive instance eqV :: Eq V

1010

1111derive instance ordV :: Ord V

1212

13−data X = X Int | Y String

13+type MyString = String

14+

15+data X = X Int | Y MyString

1416

1517derive instance eqX :: Eq X

1618

examples/passing/DerivingFunctor.pursnew file+28

@@ -0,0 +1,28 @@

1+module Main where

3+import Prelude

4+import Control.Monad.Eff.Console (log)

5+import Test.Assert

7+type MyRecord a = { myField :: a }

9+data M f a

10+ = M0 a (Array a)

11+ | M1 Int

12+ | M2 (f a)

13+ | M3 { foo :: Int, bar :: a, baz :: f a }

14+ | M4 (MyRecord a)

15+

16+derive instance eqM :: (Eq (f a), Eq a) => Eq (M f a)

17+

18+derive instance functorM :: Functor f => Functor (M f)

19+

20+type MA = M Array

21+

22+main = do

23+ assert $ map show (M0 0 [1, 2] :: MA Int) == M0 "0" ["1", "2"]

24+ assert $ map show (M1 0 :: MA Int) == M1 0

25+ assert $ map show (M2 [0, 1] :: MA Int) == M2 ["0", "1"]

26+ assert $ map show (M3 {foo: 0, bar: 1, baz: [2, 3]} :: MA Int) == M3 {foo: 0, bar: "1", baz: ["2", "3"]}

27+ assert $ map show (M4 { myField: 42 }) == M4 { myField: "42" } :: MA String

28+ log "Done"

examples/passing/EntailsKindedType.pursnew file+11

@@ -0,0 +1,11 @@

1+module Main where

3+import Prelude

4+import Control.Monad.Eff

5+import Control.Monad.Eff.Console

7+test x = show (x :: _ :: *)

9+main = do

10+ when (show (unit :: Unit :: *) == "unit") (log "Done")

11+ when (test unit == "unit") (log "Done")

examples/passing/ForeignKind.pursnew file+10

@@ -0,0 +1,10 @@

1+module Main where

3+import Prelude

4+import ForeignKinds.Lib (kind Nat, Zero, Succ, N3, NatProxy, class AddNat, addNat, proxy1, proxy2)

5+import Control.Monad.Eff.Console (log)

7+proxy1Add2Is3 :: NatProxy N3

8+proxy1Add2Is3 = addNat proxy1 proxy2

10+main = log "Done"

examples/passing/ForeignKind/Lib.pursnew file+60

@@ -0,0 +1,60 @@

1+module ForeignKinds.Lib (kind Nat, Kinded, Zero, Succ, N0, N1, N2, N3, NatProxy(..), class AddNat, addNat, proxy1, proxy2) where

3+-- declaration

5+foreign import kind Nat

7+-- use in foreign data

9+foreign import data Zero :: Nat

10+foreign import data Succ :: Nat -> Nat

11+

12+-- use in data

13+

14+data NatProxy (t :: Nat) = NatProxy

15+

16+-- use in type sig

17+

18+succProxy :: forall n. NatProxy n -> NatProxy (Succ n)

19+succProxy _ = NatProxy

20+

21+-- use in alias

22+

23+type Kinded f = f :: Nat

24+

25+type KindedZero = Kinded Zero

26+

27+type N0 = Zero

28+type N1 = Succ N0

29+type N2 = Succ N1

30+type N3 = Succ N2

31+

32+-- use of alias

33+

34+proxy0 :: NatProxy N0

35+proxy0 = NatProxy

36+

37+proxy1 :: NatProxy N1

38+proxy1 = NatProxy

39+

40+proxy2 :: NatProxy N2

41+proxy2 = NatProxy

42+

43+proxy3 :: NatProxy N3

44+proxy3 = NatProxy

45+

46+-- use in class

47+

48+class AddNat (l :: Nat) (r :: Nat) (o :: Nat) | l -> r o

49+

50+instance addNatZero

51+ :: AddNat Zero r r

52+

53+instance addNatSucc

54+ :: AddNat l r o

55+ => AddNat (Succ l) r (Succ o)

56+

57+-- use of class

58+

59+addNat :: forall l r o. AddNat l r o => NatProxy l -> NatProxy r -> NatProxy o

60+addNat _ _ = NatProxy

examples/passing/GenericsRep.purs+3−1

@@ -27,7 +27,9 @@ derive instance genericZ :: Generic Z _

2727instance eqZ :: Eq Z where

2828 eq x y = genericEq x y

2929

30−newtype W = W { x :: Int, y :: String }

30+type MyString = String

31+

32+newtype W = W { x :: Int, y :: MyString }

3133

3234derive instance genericW :: Generic W _

3335

examples/passing/HasOwnProperty.pursnew file+5

@@ -0,0 +1,5 @@

1+module Main where

3+import Control.Monad.Eff.Console (log)

5+main = log ({hasOwnProperty: "Hi"} {hasOwnProperty = "Done"}).hasOwnProperty

examples/passing/NewtypeInstance.purs+3−1

@@ -4,7 +4,9 @@ import Prelude

44import Control.Monad.Eff

55import Control.Monad.Eff.Console

7−newtype X = X String

7+type MyString = String

9+newtype X = X MyString

810

911derive newtype instance showX :: Show X

1012

examples/passing/NonOrphanInstanceFunDepExtra.pursnew file+8

@@ -0,0 +1,8 @@

1+-- Both f and l must be known, thus can be in separate modules

2+module Main where

3+import Control.Monad.Eff.Console (log)

4+import Lib

5+data F

6+data R

7+instance cflr :: C F L R

8+main = log "Done"

examples/passing/NonOrphanInstanceFunDepExtra/Lib.pursnew file+4

@@ -0,0 +1,4 @@

1+module Lib where

2+-- covering sets: {{f, l}}

3+class C f l r | l -> r

4+data L

examples/passing/NonOrphanInstanceMulti.pursnew file+7

@@ -0,0 +1,7 @@

1+-- Both l and r must be known, thus can be in separate modules

2+module Main where

3+import Control.Monad.Eff.Console (log)

4+import Lib

5+data L

6+instance clr :: C L R

7+main = log "Done"

examples/passing/NonOrphanInstanceMulti/Lib.pursnew file+4

@@ -0,0 +1,4 @@

1+module Lib where

2+-- covering sets: {{l, r}}

3+class C l r

4+data R

examples/passing/SolvingAppendSymbol.pursnew file+32

@@ -0,0 +1,32 @@

1+module Main where

3+import Prelude

4+import Control.Monad.Eff.Console (log)

5+import Type.Data.Symbol (SProxy(..), class AppendSymbol, appendSymbol, reflectSymbol)

7+sym :: SProxy ""

8+sym = SProxy

10+symA :: SProxy "A"

11+symA = SProxy

12+

13+symB :: SProxy "B"

14+symB = SProxy

15+

16+egAB :: SProxy "AB"

17+egAB = appendSymbol symA symB

18+

19+egBA :: SProxy "BA"

20+egBA = appendSymbol symB symA

21+

22+egA' :: SProxy "A"

23+egA' = appendSymbol sym (appendSymbol symA sym)

24+

25+main = do

26+ let gotAB = reflectSymbol egAB == "AB"

27+ gotBA = reflectSymbol egBA == "BA"

28+ gotA' = reflectSymbol egA' == "A"

29+ when (not gotAB) $ log "Did not get AB"

30+ when (not gotBA) $ log "Did not get BA"

31+ when (not gotA') $ log "Did not get A"

32+ when (gotAB && gotBA && gotA') $ log "Done"

examples/passing/SolvingCompareSymbol.pursnew file+30

@@ -0,0 +1,30 @@

1+module Main where

3+import Prelude

4+import Control.Monad.Eff.Console (log)

5+import Type.Data.Symbol (SProxy(..), class CompareSymbol, compareSymbol)

6+import Type.Data.Ordering (OProxy(..), kind Ordering, LT, EQ, GT, reflectOrdering)

8+symA :: SProxy "A"

9+symA = SProxy

10+

11+symB :: SProxy "B"

12+symB = SProxy

13+

14+egLT :: OProxy LT

15+egLT = compareSymbol symA symB

16+

17+egEQ :: OProxy EQ

18+egEQ = compareSymbol symA symA

19+

20+egGT :: OProxy GT

21+egGT = compareSymbol symB symA

22+

23+main = do

24+ let gotLT = reflectOrdering egLT == LT

25+ gotEQ = reflectOrdering egEQ == EQ

26+ gotGT = reflectOrdering egGT == GT

27+ when (not gotLT) $ log "Did not get LT"

28+ when (not gotEQ) $ log "Did not get EQ"

29+ when (not gotGT) $ log "Did not get GT"

30+ when (gotLT && gotEQ && gotGT) $ log "Done"

license-generator/generate.hs+154−28

@@ -1,3 +1,4 @@

1+{-# LANGUAGE TupleSections #-}

12-- |

23-- A small script which regenerates the LICENSE file with all

34-- dependencies' licenses, when the dependencies are provided via standard

@@ -5,42 +6,167 @@

56--

67-- It is recommended to run this as follows:

78--

8−-- stack list-dependencies | cut -f 1 -d ' ' | stack exec runhaskell license-generator/generate.hs > LICENSE

9+-- stack list-dependencies | stack exec runhaskell license-generator/generate.hs > LICENSE

910--

1011

1112module Main (main) where

1213

13−import Control.Monad (forM_)

14−import Data.Char (isSpace)

14+import Control.Monad (forM_, when)

15+import Data.Char (isSpace, toLower)

16+import Data.Maybe (mapMaybe)

1517import Data.List

16−import System.Process

18+import Data.List.Split (splitOn)

19+import Data.Foldable

20+import Data.Traversable

21+import qualified Data.ByteString.Lazy as LBS

22+import qualified Data.Text.Lazy as TL

23+import qualified Data.Text.Lazy.Encoding as TLE

24+import Network.HTTP.Types (ok200)

25+import Network.HTTP.Client (Manager, newManager, httpLbs, parseRequest, responseBody, responseStatus)

26+import Network.HTTP.Client.TLS (tlsManagerSettings)

1727import System.IO (hPutStrLn, stderr, getContents)

28+import System.Exit (exitFailure)

29+

30+main :: IO ()

31+main = do

32+ deps <- depsNamesAndVersions

33+ echoHeader

34+ putStrLn ""

35+ forM_ deps $ \(d, _) -> putStr " " >> putStrLn d

36+ putStrLn ""

37+ manager <- newManager tlsManagerSettings

38+ results <- traverse (\d -> (d,) <$> depsLicense manager d) deps

39+ let failures = filter (not . snd) results

40+ if not (null failures)

41+ then do

42+ hPutStrLn stderr "Licenses were not found for the following packages:"

43+ traverse_ (hPutStrLn stderr . showPair . fst) failures

44+ exitFailure

45+ else

46+ hPutStrLn stderr "Everything looks ok."

47+

48+ where

49+ showPair (pkg, version) = pkg ++ " " ++ version

1850

1951echoHeader :: IO ()

2052echoHeader =

21− readFile "license-generator/header.txt" >>= putStr

22−

23−depsNames :: IO [String]

24−depsNames =

25− fmap (filter (/= "purescript") . lines) getContents

26−

27−depsLicense :: String -> IO ()

28−depsLicense dep = do

29− let licenseFile = if dep == "Glob" then "LICENSE.txt" else "LICENSE"

30− hPutStrLn stderr dep

31− license <- readProcess "curl" ["--silent", "https://hackage.haskell.org/package/" ++ dep ++ "/src/" ++ licenseFile] ""

32− putStrLn $ dep ++ " LICENSE file:"

33− putStrLn ""

34− putStrLn $ f license

53+ readFile "license-generator/header.txt" >>= putStr

54+

55+depsNamesAndVersions :: IO [(String, String)]

56+depsNamesAndVersions = do

57+ contents <- lines <$> getContents

58+ deps <- traverse parse contents

59+ pure (filter ((/= "purescript") . fst) deps)

60+

3561 where

36− f = unlines . map (trimEnd . (" " ++)) . lines

37− trimEnd = reverse . dropWhile isSpace . reverse

62+ parse line =

63+ case splitOn " " line of

64+ [pkg, vers] -> pure (pkg, vers)

65+ _ -> fail $ "Unable to parse input line: " ++ line

3866

39−main :: IO ()

40−main = do

41− deps <-depsNames

42− echoHeader

43− putStrLn ""

44− forM_ deps $ \d -> putStr " " >> putStrLn d

45− putStrLn ""

46− forM_ deps depsLicense

67+-- Returns True on success, False on failure.

68+depsLicense :: Manager -> (String, String) -> IO Bool

69+depsLicense manager dep = do

70+ hPutStrLn stderr (fst dep)

71+ result <- downloadLicenseFromHackage manager dep

72+ case result of

73+ FoundLicense license -> do

74+ putStrLn $ fst dep ++ " LICENSE file:"

75+ putStrLn ""

76+ putStrLn $ f license

77+ pure True

78+ LicenseNotNeeded ->

79+ pure True

80+ Failed ->

81+ pure False

82+ where

83+ f = unlines . map (trimEnd . (" " ++)) . lines

84+ trimEnd = reverse . dropWhile isSpace . reverse

85+

86+data LicenseResult

87+ = FoundLicense String

88+ | LicenseNotNeeded

89+ | Failed

90+ deriving (Show, Eq, Ord)

91+

92+downloadLicenseFromHackage :: Manager -> (String, String) -> IO LicenseResult

93+downloadLicenseFromHackage manager dep = do

94+ mcabalFile <- downloadCabalFileFromHackage manager dep

95+ case mcabalFile of

96+ Nothing ->

97+ pure Failed

98+ Just cabalFile ->

99+ let

100+ field f = extractCabalField f cabalFile

101+ in

102+ case (field "license", field "license-file") of

103+ (_, Just licenseFile) -> do

104+ getLicense licenseFile

105+ (Just "PublicDomain", _) -> do

106+ pure LicenseNotNeeded

107+ _ -> do

108+ hPutStrLn stderr $

109+ "Unable to extract license information from cabal file for " ++

110+ fst dep

111+ pure Failed

112+

113+ where

114+ getLicense licenseFile = do

115+ r <- downloadFromHackage ("/src/" ++ licenseFile) manager dep

116+ pure $ maybe Failed FoundLicense r

117+

118+-- Attempt to extract a field from a cabal file. Note that this only works for

119+-- fields which are at the top level, not inside subsections such as

120+-- 'executable' or 'test-suite'.

121+extractCabalField :: String -> String -> Maybe String

122+extractCabalField fieldName cabalFile =

123+ case mapMaybe (stripPrefixCaseInsensitive fieldName) (lines cabalFile) of

124+ [line] ->

125+ Just $

126+ line

127+ |> dropWhile isSpace

128+ |> drop 1 -- colon

129+ |> trim

130+ _ ->

131+ Nothing

132+ where

133+ x |> f = f x

134+

135+ trim =

136+ reverse . dropWhile isSpace . reverse . dropWhile isSpace

137+

138+ stripPrefixCaseInsensitive prefix str =

139+ if map toLower prefix `isPrefixOf` map toLower str

140+ then Just (drop (length prefix) str)

141+ else Nothing

142+

143+downloadCabalFileFromHackage :: Manager -> (String, String) -> IO (Maybe String)

144+downloadCabalFileFromHackage manager dep = do

145+ downloadFromHackage ("/src/" ++ fst dep ++ ".cabal") manager dep

146+

147+downloadFromHackage :: String -> Manager -> (String, String) -> IO (Maybe String)

148+downloadFromHackage urlpath manager dep = do

149+ let url = hackageBaseUrl dep ++ urlpath

150+ req <- parseRequest url

151+ resp <- httpLbs req manager

152+

153+ let status = responseStatus resp

154+ if (status /= ok200)

155+ then do

156+ hPutStrLn stderr $ "Bad status code for " ++ url

157+ hPutStrLn stderr $ "Expected 200, got " ++ show status

158+ pure Nothing

159+ else

160+ pure (Just (toString (responseBody resp)))

161+

162+ where

163+ toString = TL.unpack . TLE.decodeUtf8

164+

165+hackageBaseUrl :: (String, String) -> String

166+hackageBaseUrl (dep, version) =

167+ concat

168+ [ "https://hackage.haskell.org/package/"

169+ , dep

170+ , "-"

171+ , version

172+ ]

psc-bundle/Main.hs+32−7

@@ -9,6 +9,8 @@ module Main (main) where

99import Data.Traversable (for)

1010import Data.Version (showVersion)

1111import Data.Monoid ((<>))

12+import Data.Aeson (encode)

13+import Data.Maybe (isNothing)

1214

1315import Control.Applicative

1416import Control.Monad

@@ -16,12 +18,15 @@ import Control.Monad.Error.Class

1618import Control.Monad.Trans.Except

1719import Control.Monad.IO.Class

1820

19−import System.FilePath (takeDirectory)

21+import System.FilePath (takeDirectory, (</>), (<.>), takeFileName)

2022import System.FilePath.Glob (glob)

2123import System.Exit (exitFailure)

2224import System.IO (stderr, stdout, hPutStrLn, hSetEncoding, utf8)

2325import System.IO.UTF8 (readUTF8File, writeUTF8File)

24−import System.Directory (createDirectoryIfMissing)

26+import System.Directory (createDirectoryIfMissing, getCurrentDirectory)

27+

28+import qualified Data.ByteString.Lazy as B

29+import qualified Data.ByteString.UTF8 as BU8

2530

2631import Language.PureScript.Bundle

2732

@@ -30,6 +35,9 @@ import qualified Options.Applicative as Opts

3035

3136import qualified Paths_purescript as Paths

3237

38+import SourceMap

39+import SourceMap.Types

40+

3341-- | Command line options.

3442data Options = Options

3543 { optionsInputFiles :: [FilePath]

@@ -37,25 +45,32 @@ data Options = Options

3745 , optionsEntryPoints :: [String]

3846 , optionsMainModule :: Maybe String

3947 , optionsNamespace :: String

48+ , optionsSourceMaps :: Bool

4049 } deriving Show

4150

4251-- | The main application function.

4352-- This function parses the input files, performs dead code elimination, filters empty modules

4453-- and generates and prints the final Javascript bundle.

45−app :: (MonadError ErrorMessage m, MonadIO m) => Options -> m String

54+app :: (MonadError ErrorMessage m, MonadIO m) => Options -> m (Maybe SourceMapping, String)

4655app Options{..} = do

4756 inputFiles <- concat <$> mapM (liftIO . glob) optionsInputFiles

4857 when (null inputFiles) . liftIO $ do

4958 hPutStrLn stderr "psc-bundle: No input files."

5059 exitFailure

60+ when (isNothing optionsOutputFile && optionsSourceMaps == True) . liftIO $ do

61+ hPutStrLn stderr "psc-bundle: Source maps only supported when output file specified."

62+ exitFailure

63+

5164 input <- for inputFiles $ \filename -> do

5265 js <- liftIO (readUTF8File filename)

5366 mid <- guessModuleIdentifier filename

54− length js `seq` return (mid, js) -- evaluate readFile till EOF before returning, not to exhaust file handles

67+ length js `seq` return (mid, Just filename, js) -- evaluate readFile till EOF before returning, not to exhaust file handles

5568

5669 let entryIds = map (`ModuleIdentifier` Regular) optionsEntryPoints

5770

58− bundle input entryIds optionsMainModule optionsNamespace

71+ currentDir <- liftIO getCurrentDirectory

72+ let outFile = if optionsSourceMaps then fmap (currentDir </>) optionsOutputFile else Nothing

73+ bundleSM input entryIds optionsMainModule optionsNamespace outFile

5974

6075-- | Command line options parser.

6176options :: Parser Options

@@ -64,6 +79,7 @@ options = Options <$> some inputFile

6479 <*> many entryPoint

6580 <*> optional mainModule

6681 <*> namespace

82+ <*> sourceMaps

6783 where

6884 inputFile :: Parser FilePath

6985 inputFile = Opts.strArgument $

@@ -95,6 +111,11 @@ options = Options <$> some inputFile

95111 <> Opts.showDefault

96112 <> Opts.help "Specify the namespace that PureScript modules will be exported to when running in the browser."

97113

114+ sourceMaps :: Parser Bool

115+ sourceMaps = Opts.switch $

116+ Opts.long "source-maps"

117+ <> Opts.help "Whether to generate source maps for the bundle (requires --output)."

118+

98119-- | Make it go.

99120main :: IO ()

100121main = do

@@ -106,11 +127,15 @@ main = do

106127 Left err -> do

107128 hPutStrLn stderr (unlines (printErrorMessage err))

108129 exitFailure

109− Right js ->

130+ Right (sourcemap, js) ->

110131 case optionsOutputFile opts of

111132 Just outputFile -> do

112133 createDirectoryIfMissing True (takeDirectory outputFile)

113− writeUTF8File outputFile js

134+ case sourcemap of

135+ Just sm -> do

136+ writeUTF8File outputFile $ js ++ "\n//# sourceMappingURL=" ++ (takeFileName outputFile <.> "map") ++ "\n"

137+ writeUTF8File (outputFile <.> "map") $ BU8.toString . B.toStrict . encode $ generate sm

138+ Nothing -> writeUTF8File outputFile js

114139 Nothing -> putStrLn js

115140 where

116141 infoModList = Opts.fullDesc <> headerInfo <> footerInfo

psc-docs/Main.hs+5−4

@@ -9,6 +9,7 @@ import Control.Category ((>>>))

99import Control.Monad.Writer

1010import Data.Text (Text)

1111import qualified Data.Text as T

12+import qualified Data.Text.IO as T

1213import Data.Function (on)

1314import Data.List

1415import Data.Maybe (fromMaybe)

@@ -22,7 +23,7 @@ import qualified Language.PureScript as P

2223import qualified Paths_purescript as Paths

2324import System.Exit (exitFailure)

2425import System.IO (hPutStrLn, hPrint, hSetEncoding, stderr, stdout, utf8)

25−import System.IO.UTF8 (readUTF8FileT)

26+import System.IO.UTF8 (readUTF8FileT, writeUTF8FileT)

2627import System.Directory (createDirectoryIfMissing)

2728import System.FilePath (takeDirectory)

2829import System.FilePath.Glob (glob)

@@ -65,11 +66,11 @@ docgen (PSCDocsOptions fmt inputGlob output) = do

6566

6667 case output of

6768 EverythingToStdOut ->

68− putStrLn (D.runDocs (D.modulesAsMarkdown ms))

69+ T.putStrLn (D.runDocs (D.modulesAsMarkdown ms))

6970 ToStdOut names -> do

7071 let (ms', missing) = takeByName ms names

7172 guardMissing missing

72− putStrLn (D.runDocs (D.modulesAsMarkdown ms'))

73+ T.putStrLn (D.runDocs (D.modulesAsMarkdown ms'))

7374 ToFiles names -> do

7475 let (ms', missing) = takeByName' ms names

7576 guardMissing missing

@@ -78,7 +79,7 @@ docgen (PSCDocsOptions fmt inputGlob output) = do

7879 forM_ ms'' $ \grp -> do

7980 let fp = fst (head grp)

8081 createDirectoryIfMissing True (takeDirectory fp)

81− writeFile fp (D.runDocs (D.modulesAsMarkdown (map snd grp)))

82+ writeUTF8FileT fp (D.runDocs (D.modulesAsMarkdown (map snd grp)))

8283

8384 where

8485 guardMissing [] = return ()

psc-docs/Tags.hs+1

@@ -17,4 +17,5 @@ tags = map (first T.unpack) . concatMap dtags . P.exportedDeclarations

1717 names (P.TypeSynonymDeclaration name _ _) = [P.runProperName name]

1818 names (P.TypeClassDeclaration name _ _ _ _) = [P.runProperName name]

1919 names (P.TypeInstanceDeclaration name _ _ _ _) = [P.showIdent name]

20+ names (P.ExternKindDeclaration name) = [P.runProperName name]

2021 names _ = []

psc-package/Main.hs+149−11

@@ -7,17 +7,20 @@

88module Main where

10+import qualified Control.Foldl as Foldl

1011import qualified Data.Aeson as Aeson

1112import Data.Aeson.Encode.Pretty

1213import Data.Foldable (fold, for_, traverse_)

1314import Data.List (nub)

1415import qualified Data.Map as Map

15−import Data.Maybe (mapMaybe)

16+import Data.Maybe (fromMaybe, mapMaybe)

1617import qualified Data.Set as Set

1718import Data.Text (pack)

19+import qualified Data.Text as T

20+import Data.Text.Encoding (encodeUtf8)

1821import qualified Data.Text.Lazy as TL

1922import qualified Data.Text.Lazy.Builder as TB

20−import Data.Text.Encoding (encodeUtf8)

23+import qualified Data.Text.Read as TR

2124import Data.Traversable (for)

2225import Data.Version (showVersion)

2326import qualified Filesystem.Path.CurrentOS as Path

@@ -25,7 +28,8 @@ import GHC.Generics (Generic)

2528import qualified Options.Applicative as Opts

2629import qualified Paths_purescript as Paths

2730import qualified System.IO as IO

28−import Turtle hiding (fold)

31+import Turtle hiding (fold, s, x)

32+import qualified Turtle

2933

3034packageFile :: Path.FilePath

3135packageFile = "psc-package.json"

@@ -61,8 +65,8 @@ readPackageFile = do

6165 exit (ExitFailure 1)

6266 Just pkg -> return pkg

6367

64−encodePrettyToText :: Aeson.ToJSON json => json -> Text

65−encodePrettyToText =

68+packageConfigToJSON :: PackageConfig -> Text

69+packageConfigToJSON =

6670 TL.toStrict

6771 . TB.toLazyText

6872 . encodePrettyToTextBuilder' config

@@ -76,10 +80,18 @@ encodePrettyToText =

7680 ]

7781 }

7882

83+packageSetToJSON :: PackageSet -> Text

84+packageSetToJSON =

85+ TL.toStrict

86+ . TB.toLazyText

87+ . encodePrettyToTextBuilder' config

88+ where

89+ config = defConfig { confCompare = compare }

90+

7991writePackageFile :: PackageConfig -> IO ()

8092writePackageFile =

8193 writeTextFile packageFile

82− . encodePrettyToText

94+ . packageConfigToJSON

8395

8496data PackageInfo = PackageInfo

8597 { repo :: Text

@@ -108,6 +120,18 @@ cloneShallow from ref into =

108120 , pathToTextUnsafe into

109121 ] empty .||. exit (ExitFailure 1)

110122

123+listRemoteTags

124+ :: Text

125+ -- ^ repo

126+ -> Turtle.Shell Text

127+listRemoteTags from =

128+ inproc "git"

129+ [ "ls-remote"

130+ , "-q"

131+ , "-t"

132+ , from

133+ ] empty

134+

111135getPackageSet :: PackageConfig -> IO ()

112136getPackageSet PackageConfig{ source, set } = do

113137 let pkgDir = ".psc-package" </> fromText set </> ".set"

@@ -128,11 +152,18 @@ readPackageSet PackageConfig{ set } = do

128152 exit (ExitFailure 1)

129153 Just db -> return db

130154

131−installOrUpdate :: PackageConfig -> Text -> PackageInfo -> IO ()

132−installOrUpdate PackageConfig{ set } pkgName PackageInfo{ repo, version } = do

155+writePackageSet :: PackageConfig -> PackageSet -> IO ()

156+writePackageSet PackageConfig{ set } =

157+ let dbFile = ".psc-package" </> fromText set </> ".set" </> "packages.json"

158+ in writeTextFile dbFile . packageSetToJSON

159+

160+installOrUpdate :: Text -> Text -> PackageInfo -> IO Turtle.FilePath

161+installOrUpdate set pkgName PackageInfo{ repo, version } = do

162+ echo ("Updating " <> pkgName)

133163 let pkgDir = ".psc-package" </> fromText set </> fromText pkgName </> fromText version

134164 exists <- testdir pkgDir

135165 unless exists . void $ cloneShallow repo version pkgDir

166+ pure pkgDir

136167

137168getTransitiveDeps :: PackageSet -> [Text] -> IO [(Text, PackageInfo)]

138169getTransitiveDeps db depends = do

@@ -151,9 +182,7 @@ updateImpl config@PackageConfig{ depends } = do

151182 db <- readPackageSet config

152183 trans <- getTransitiveDeps db depends

153184 echo ("Updating " <> pack (show (length trans)) <> " packages...")

154− for_ trans $ \(pkgName, pkg) -> do

155− echo ("Updating " <> pkgName)

156− installOrUpdate config pkgName pkg

185+ for_ trans $ \(pkgName, pkg) -> installOrUpdate (set config) pkgName pkg

157186

158187initialize :: IO ()

159188initialize = do

@@ -233,6 +262,101 @@ exec exeName = do

233262 (map pathToTextUnsafe ("src" </> "**" </> "*.purs" : paths))

234263 empty

235264

265+checkForUpdates :: Bool -> Bool -> IO ()

266+checkForUpdates applyMinorUpdates applyMajorUpdates = do

267+ pkg <- readPackageFile

268+ db <- readPackageSet pkg

269+

270+ echo ("Checking " <> pack (show (Map.size db)) <> " packages for updates.")

271+ echo "Warning: this could take some time!"

272+

273+ newDb <- Map.fromList <$> (for (Map.toList db) $ \(name, p@PackageInfo{ repo, version }) -> do

274+ echo ("Checking package " <> name)

275+ tagLines <- Turtle.fold (listRemoteTags repo) Foldl.list

276+ let tags = mapMaybe parseTag tagLines

277+ newVersion <- case parseVersion version of

278+ Just parts ->

279+ let applyMinor =

280+ case filter (isMinorReleaseFrom parts) tags of

281+ [] -> pure version

282+ minorReleases -> do

283+ echo ("New minor release available")

284+ case applyMinorUpdates of

285+ True -> do

286+ let latestMinorRelease = maximum minorReleases

287+ pure ("v" <> T.intercalate "." (map (pack . show) latestMinorRelease))

288+ False -> pure version

289+ applyMajor =

290+ case filter (isMajorReleaseFrom parts) tags of

291+ [] -> applyMinor

292+ newReleases -> do

293+ echo ("New major release available")

294+ case applyMajorUpdates of

295+ True -> do

296+ let latestRelease = maximum newReleases

297+ pure ("v" <> T.intercalate "." (map (pack . show) latestRelease))

298+ False -> applyMinor

299+ in applyMajor

300+ _ -> do

301+ echo "Unable to parse version string"

302+ pure version

303+ pure (name, p { version = newVersion }))

304+

305+ when (applyMinorUpdates || applyMajorUpdates)

306+ (writePackageSet pkg newDb)

307+ where

308+ parseTag :: Text -> Maybe [Int]

309+ parseTag line =

310+ case T.splitOn "\t" line of

311+ [_sha, ref] ->

312+ case T.stripPrefix "refs/tags/" ref of

313+ Just tag ->

314+ case parseVersion tag of

315+ Just parts -> pure parts

316+ _ -> Nothing

317+ _ -> Nothing

318+ _ -> Nothing

319+

320+ parseVersion :: Text -> Maybe [Int]

321+ parseVersion ref =

322+ case T.stripPrefix "v" ref of

323+ Just tag ->

324+ traverse parseDecimal (T.splitOn "." tag)

325+ _ -> Nothing

326+

327+ parseDecimal :: Text -> Maybe Int

328+ parseDecimal s =

329+ case TR.decimal s of

330+ Right (n, "") -> Just n

331+ _ -> Nothing

332+

333+ isMajorReleaseFrom :: [Int] -> [Int] -> Bool

334+ isMajorReleaseFrom (0 : xs) (0 : ys) = isMajorReleaseFrom xs ys

335+ isMajorReleaseFrom (x : _) (y : _) = y > x

336+ isMajorReleaseFrom _ _ = False

337+

338+ isMinorReleaseFrom :: [Int] -> [Int] -> Bool

339+ isMinorReleaseFrom (0 : xs) (0 : ys) = isMinorReleaseFrom xs ys

340+ isMinorReleaseFrom (x : xs) (y : ys) = y == x && ys > xs

341+ isMinorReleaseFrom _ _ = False

342+

343+verifyPackageSet :: IO ()

344+verifyPackageSet = do

345+ pkg <- readPackageFile

346+ db <- readPackageSet pkg

347+

348+ echo ("Verifying " <> pack (show (Map.size db)) <> " packages.")

349+ echo "Warning: this could take some time!"

350+

351+ let installOrUpdate' (name, pkgInfo) = (name, ) <$> installOrUpdate (set pkg) name pkgInfo

352+ paths <- Map.fromList <$> traverse installOrUpdate' (Map.toList db)

353+

354+ for_ (Map.toList db) $ \(name, PackageInfo{..}) -> do

355+ let dirFor = fromMaybe (error "verifyPackageSet: no directory") . (`Map.lookup` paths)

356+ echo ("Verifying package " <> name)

357+ let srcGlobs = map (pathToTextUnsafe . (</> ("src" </> "**" </> "*.purs")) . dirFor) (name : dependencies)

358+ procs "psc" srcGlobs empty

359+

236360main :: IO ()

237361main = do

238362 IO.hSetEncoding IO.stdout IO.utf8

@@ -275,8 +399,22 @@ main = do

275399 , Opts.command "available"

276400 (Opts.info (pure listPackages)

277401 (Opts.progDesc "List all packages available in the package set"))

402+ , Opts.command "updates"

403+ (Opts.info (checkForUpdates <$> apply <*> applyMajor)

404+ (Opts.progDesc "Check all packages in the package set for new releases"))

405+ , Opts.command "verify-set"

406+ (Opts.info (pure verifyPackageSet)

407+ (Opts.progDesc "Verify that the packages in the package set build correctly"))

278408 ]

279409 where

280410 pkg = Opts.strArgument $

281411 Opts.metavar "PACKAGE"

282412 <> Opts.help "The name of the package to install"

413+

414+ apply = Opts.switch $

415+ Opts.long "apply"

416+ <> Opts.help "Apply all minor package updates"

417+

418+ applyMajor = Opts.switch $

419+ Opts.long "apply-breaking"

420+ <> Opts.help "Apply all major package updates"

psc-publish/Main.hs+1

@@ -1,3 +1,4 @@

1+{-# LANGUAGE OverloadedStrings #-}

23module Main where

psci/Main.hs+16−10

@@ -72,10 +72,16 @@ inputFile = Opts.strArgument $

7272 Opts.metavar "FILE"

7373 <> Opts.help "Optional .purs files to load on start"

7474

75−nodeFlagsFlag :: Opts.Parser [String]

76−nodeFlagsFlag = Opts.option parser $

75+nodePathOption :: Opts.Parser (Maybe FilePath)

76+nodePathOption = Opts.optional . Opts.strOption $

77+ Opts.metavar "FILE"

78+ <> Opts.long "node-path"

79+ <> Opts.help "Path to the Node executable"

80+

81+nodeFlagsOption :: Opts.Parser [String]

82+nodeFlagsOption = Opts.option parser $

7783 Opts.long "node-opts"

78− <> Opts.metavar "NODE_OPTS"

84+ <> Opts.metavar "OPTS"

7985 <> Opts.value []

8086 <> Opts.help "Flags to pass to node, separated by spaces"

8187 where

@@ -90,7 +96,7 @@ port = Opts.option Opts.auto $

9096backend :: Opts.Parser Backend

9197backend =

9298 (browserBackend <$> port)

93− <|> (nodeBackend <$> nodeFlagsFlag)

99+ <|> (nodeBackend <$> nodePathOption <*> nodeFlagsOption)

94100

95101psciOptions :: Opts.Parser PSCiOptions

96102psciOptions = PSCiOptions <$> many inputFile

@@ -293,8 +299,8 @@ browserBackend serverPort = Backend setup evaluate reload shutdown

293299 result <- takeMVar resultVar

294300 putStrLn result

295301

296−nodeBackend :: [String] -> Backend

297−nodeBackend nodeArgs = Backend setup eval reload shutdown

302+nodeBackend :: Maybe FilePath -> [String] -> Backend

303+nodeBackend nodePath nodeArgs = Backend setup eval reload shutdown

298304 where

299305 setup :: IO ()

300306 setup = return ()

@@ -302,12 +308,12 @@ nodeBackend nodeArgs = Backend setup eval reload shutdown

302308 eval :: () -> String -> IO ()

303309 eval _ _ = do

304310 writeFile indexFile "require('$PSCI')['$main']();"

305− process <- findNodeProcess

311+ process <- maybe findNodeProcess (pure . pure) nodePath

306312 result <- traverse (\node -> readProcessWithExitCode node (nodeArgs ++ [indexFile]) "") process

307313 case result of

308− Just (ExitSuccess, out, _) -> putStrLn out

309− Just (ExitFailure _, _, err) -> putStrLn err

310− Nothing -> putStrLn "Couldn't find node.js"

314+ Just (ExitSuccess, out, _) -> putStrLn out

315+ Just (ExitFailure _, _, err) -> putStrLn err

316+ Nothing -> putStrLn "Couldn't find node.js"

311317

312318 reload :: () -> IO ()

313319 reload _ = return ()

purescript.cabal+18−3

@@ -1,5 +1,5 @@

11name: purescript

2−version: 0.10.3

2+version: 0.10.4

33cabal-version: >=1.8

44build-type: Simple

55license: BSD3

@@ -28,6 +28,7 @@ extra-source-files: examples/passing/*.purs

2828 , examples/passing/ExplicitImportReExport/*.purs

2929 , examples/passing/ExportExplicit/*.purs

3030 , examples/passing/ExportExplicit2/*.purs

31+ , examples/passing/ForeignKind/*.purs

3132 , examples/passing/Import/*.purs

3233 , examples/passing/ImportExplicit/*.purs

3334 , examples/passing/ImportQualified/*.purs

@@ -39,6 +40,8 @@ extra-source-files: examples/passing/*.purs

3940 , examples/passing/ModuleExportQualified/*.purs

4041 , examples/passing/ModuleExportSelf/*.purs

4142 , examples/passing/NonConflictingExports/*.purs

43+ , examples/passing/NonOrphanInstanceMulti/*.purs

44+ , examples/passing/NonOrphanInstanceFunDepExtra/*.purs

4245 , examples/passing/OperatorAliasElsewhere/*.purs

4346 , examples/passing/Operators/*.purs

4447 , examples/passing/PendingConflictingImports/*.purs

@@ -63,6 +66,7 @@ extra-source-files: examples/passing/*.purs

6366 , examples/failing/ConflictingImports2/*.purs

6467 , examples/failing/ConflictingQualifiedImports/*.purs

6568 , examples/failing/ConflictingQualifiedImports2/*.purs

69+ , examples/failing/DiffKindsSameName/*.purs

6670 , examples/failing/DuplicateModule/*.purs

6771 , examples/failing/ExportConflictClass/*.purs

6872 , examples/failing/ExportConflictCtor/*.purs

@@ -78,6 +82,9 @@ extra-source-files: examples/passing/*.purs

7882 , examples/failing/ImportModule/*.purs

7983 , examples/failing/InstanceExport/*.purs

8084 , examples/failing/OrphanInstance/*.purs

85+ , examples/failing/OrphanInstanceFunDepCycle/*.purs

86+ , examples/failing/OrphanInstanceWithDetermined/*.purs

87+ , examples/failing/OrphanInstanceNullary/*.purs

8188 , examples/warning/*.purs

8289 , examples/warning/*.js

8390 , examples/warning/UnusedExplicitImportTypeOp/*.purs

@@ -272,6 +279,7 @@ library

272279 Language.PureScript.Docs.Convert

273280 Language.PureScript.Docs.Convert.Single

274281 Language.PureScript.Docs.Convert.ReExports

282+ Language.PureScript.Docs.Prim

275283 Language.PureScript.Docs.Render

276284 Language.PureScript.Docs.Types

277285 Language.PureScript.Docs.RenderedCode

@@ -448,7 +456,7 @@ executable psc-package

448456 optparse-applicative -any,

449457 system-filepath -any,

450458 text -any,

451− turtle -any

459+ turtle <1.3

452460 main-is: Main.hs

453461 other-modules: Paths_purescript

454462 buildable: True

@@ -478,14 +486,19 @@ executable psc-bundle

478486 other-modules: Paths_purescript

479487 other-extensions:

480488 build-depends: base >=4 && <5,

489+ bytestring -any,

481490 purescript -any,

482491 directory -any,

492+ aeson >= 0.8 && < 1.0,

483493 filepath -any,

484494 Glob -any,

485495 mtl -any,

486496 optparse-applicative >= 0.12.1,

497+ sourcemap >= 0.1.6,

487498 transformers -any,

488− transformers-compat -any

499+ transformers-compat -any,

500+ utf8-string >= 1 && < 2

501+

489502 ghc-options: -Wall -O2

490503 hs-source-dirs: psc-bundle

491504

@@ -559,6 +572,7 @@ test-suite tests

559572 aeson -any,

560573 aeson-better-errors -any,

561574 base-compat -any,

575+ bower-json -any,

562576 boxes -any,

563577 bytestring -any,

564578 containers -any,

@@ -588,6 +602,7 @@ test-suite tests

588602 other-modules: TestUtils

589603 TestCompiler

590604 TestDocs

605+ TestPrimDocs

591606 TestPscPublish

592607 TestPsci

593608 TestPscIde

src/Language/PureScript/AST/Declarations.hs+25−1

@@ -240,6 +240,10 @@ data DeclarationRef

240240 --

241241 | ModuleRef ModuleName

242242 -- |

243+ -- A named kind

244+ --

245+ | KindRef (ProperName 'KindName)

246+ -- |

243247 -- A value re-exported from another module. These will be inserted during

244248 -- elaboration in name desugaring.

245249 --

@@ -258,6 +262,7 @@ instance Eq DeclarationRef where

258262 (TypeClassRef name) == (TypeClassRef name') = name == name'

259263 (TypeInstanceRef name) == (TypeInstanceRef name') = name == name'

260264 (ModuleRef name) == (ModuleRef name') = name == name'

265+ (KindRef name) == (KindRef name') = name == name'

261266 (ReExportRef mn ref) == (ReExportRef mn' ref') = mn == mn' && ref == ref'

262267 (PositionedDeclarationRef _ _ r) == r' = r == r'

263268 r == (PositionedDeclarationRef _ _ r') = r == r'

@@ -274,6 +279,7 @@ compDecRef (ValueOpRef name) (ValueOpRef name') = compare name name'

274279compDecRef (TypeClassRef name) (TypeClassRef name') = compare name name'

275280compDecRef (TypeInstanceRef ident) (TypeInstanceRef ident') = compare ident ident'

276281compDecRef (ModuleRef name) (ModuleRef name') = compare name name'

282+compDecRef (KindRef name) (KindRef name') = compare name name'

277283compDecRef (ReExportRef name _) (ReExportRef name' _) = compare name name'

278284compDecRef (PositionedDeclarationRef _ _ ref) ref' = compDecRef ref ref'

279285compDecRef ref (PositionedDeclarationRef _ _ ref') = compDecRef ref ref'

@@ -286,7 +292,8 @@ compDecRef ref ref' = compare

286292 orderOf (TypeRef _ _) = 2

287293 orderOf (ValueRef _) = 3

288294 orderOf (ValueOpRef _) = 4

289− orderOf _ = 5

295+ orderOf (KindRef _) = 5

296+ orderOf _ = 6

290297

291298getTypeRef :: DeclarationRef -> Maybe (ProperName 'TypeName, Maybe [ProperName 'ConstructorName])

292299getTypeRef (TypeRef name dctors) = Just (name, dctors)

@@ -313,6 +320,11 @@ getTypeClassRef (TypeClassRef name) = Just name

313320getTypeClassRef (PositionedDeclarationRef _ _ r) = getTypeClassRef r

314321getTypeClassRef _ = Nothing

315322

323+getKindRef :: DeclarationRef -> Maybe (ProperName 'KindName)

324+getKindRef (KindRef name) = Just name

325+getKindRef (PositionedDeclarationRef _ _ r) = getKindRef r

326+getKindRef _ = Nothing

327+

316328isModuleRef :: DeclarationRef -> Bool

317329isModuleRef (PositionedDeclarationRef _ _ r) = isModuleRef r

318330isModuleRef (ModuleRef _) = True

@@ -381,6 +393,10 @@ data Declaration

381393 --

382394 | ExternDataDeclaration (ProperName 'TypeName) Kind

383395 -- |

396+ -- A foreign kind import (name)

397+ --

398+ | ExternKindDeclaration (ProperName 'KindName)

399+ -- |

384400 -- A fixity declaration

385401 --

386402 | FixityDeclaration (Either ValueFixity TypeFixity)

@@ -469,6 +485,14 @@ isExternDataDecl ExternDataDeclaration{} = True

469485isExternDataDecl (PositionedDeclaration _ _ d) = isExternDataDecl d

470486isExternDataDecl _ = False

471487

488+-- |

489+-- Test if a declaration is a foreign kind import

490+--

491+isExternKindDecl :: Declaration -> Bool

492+isExternKindDecl ExternKindDeclaration{} = True

493+isExternKindDecl (PositionedDeclaration _ _ d) = isExternKindDecl d

494+isExternKindDecl _ = False

495+

472496-- |

473497-- Test if a declaration is a fixity declaration

474498--

src/Language/PureScript/AST/Exported.hs+1

@@ -132,6 +132,7 @@ isExported (Just exps) decl = any (matches decl) exps

132132 matches (ExternDeclaration ident _) (ValueRef ident') = ident == ident'

133133 matches (DataDeclaration _ ident _ _) (TypeRef ident' _) = ident == ident'

134134 matches (ExternDataDeclaration ident _) (TypeRef ident' _) = ident == ident'

135+ matches (ExternKindDeclaration ident) (KindRef ident') = ident == ident'

135136 matches (TypeSynonymDeclaration ident _ _) (TypeRef ident' _) = ident == ident'

136137 matches (TypeClassDeclaration ident _ _ _ _) (TypeClassRef ident') = ident == ident'

137138 matches (ValueFixityDeclaration _ _ op) (ValueOpRef op') = op == op'

src/Language/PureScript/AST/Traversals.hs+40−3

@@ -14,11 +14,12 @@ import Data.Maybe (mapMaybe)

1414import qualified Data.Set as S

1515

1616import Language.PureScript.AST.Binders

17−import Language.PureScript.AST.Literals

1817import Language.PureScript.AST.Declarations

19−import Language.PureScript.Types

20−import Language.PureScript.Traversals

18+import Language.PureScript.AST.Literals

19+import Language.PureScript.Kinds

2120import Language.PureScript.Names

21+import Language.PureScript.Traversals

22+import Language.PureScript.Types

2223

2324everywhereOnValues

2425 :: (Declaration -> Declaration)

@@ -588,6 +589,42 @@ accumTypes f = everythingOnValues mappend forDecls forValues (const mempty) (con

588589 forValues (TypedValue _ _ ty) = f ty

589590 forValues _ = mempty

590591

592+accumKinds

593+ :: (Monoid r)

594+ => (Kind -> r)

595+ -> ( Declaration -> r

596+ , Expr -> r

597+ , Binder -> r

598+ , CaseAlternative -> r

599+ , DoNotationElement -> r

600+ )

601+accumKinds f = everythingOnValues mappend forDecls forValues (const mempty) (const mempty) (const mempty)

602+ where

603+ forDecls (DataDeclaration _ _ args dctors) =

604+ foldMap (foldMap f . snd) args `mappend`

605+ foldMap (foldMap forTypes . snd) dctors

606+ forDecls (TypeClassDeclaration _ args implies _ _) =

607+ foldMap (foldMap f . snd) args `mappend`

608+ foldMap (foldMap forTypes . constraintArgs) implies

609+ forDecls (TypeInstanceDeclaration _ cs _ tys _) =

610+ foldMap (foldMap forTypes . constraintArgs) cs `mappend`

611+ foldMap forTypes tys

612+ forDecls (TypeSynonymDeclaration _ args ty) =

613+ foldMap (foldMap f . snd) args `mappend`

614+ forTypes ty

615+ forDecls (TypeDeclaration _ ty) = forTypes ty

616+ forDecls (ExternDeclaration _ ty) = forTypes ty

617+ forDecls (ExternDataDeclaration _ kn) = f kn

618+ forDecls _ = mempty

619+

620+ forValues (TypeClassDictionary c _ _) = foldMap forTypes (constraintArgs c)

621+ forValues (DeferredDictionary _ tys) = foldMap forTypes tys

622+ forValues (TypedValue _ _ ty) = forTypes ty

623+ forValues _ = mempty

624+

625+ forTypes (KindedType _ k) = f k

626+ forTypes _ = mempty

627+

591628-- |

592629-- Map a function over type annotations appearing inside a value

593630--

src/Language/PureScript/Bundle.hs+104−31

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

66-- and generates the final Javascript bundle.

77module Language.PureScript.Bundle

88 ( bundle

9+ , bundleSM

910 , guessModuleIdentifier

1011 , ModuleIdentifier(..)

1112 , moduleName

@@ -19,6 +20,7 @@ import Prelude.Compat

1920

2021import Control.Monad

2122import Control.Monad.Error.Class

23+import Control.Arrow ((&&&))

2224

2325import Data.Char (chr, digitToInt)

2426import Data.Generics (everything, everywhere, mkQ, mkT)

@@ -33,7 +35,9 @@ import Language.JavaScript.Parser.AST

3335

3436import qualified Paths_purescript as Paths

3537

36−import System.FilePath (takeFileName, takeDirectory)

38+import System.FilePath (takeFileName, takeDirectory, takeDirectory, makeRelative)

39+

40+import SourceMap.Types

3741

3842-- | The type of error messages. We separate generation and rendering of errors using a data

3943-- type, in case we need to match on error types later.

@@ -98,10 +102,11 @@ data ModuleElement

98102 | Member JSStatement Bool String JSExpression [Key]

99103 | ExportsList [(ExportType, String, JSExpression, [Key])]

100104 | Other JSStatement

105+ | Skip JSStatement

101106 deriving (Show)

102107

103108-- | A module is just a list of elements of the types listed above.

104−data Module = Module ModuleIdentifier [ModuleElement] deriving (Show)

109+data Module = Module ModuleIdentifier (Maybe FilePath) [ModuleElement] deriving (Show)

105110

106111-- | Prepare an error message for consumption by humans.

107112printErrorMessage :: ErrorMessage -> [String]

@@ -159,7 +164,7 @@ checkImportPath name _ _ = Left name

159164--

160165-- where name is the name of a member defined in the current module.

161166withDeps :: Module -> Module

162−withDeps (Module modulePath es) = Module modulePath (map expandDeps es)

167+withDeps (Module modulePath fn es) = Module modulePath fn (map expandDeps es)

163168 where

164169 -- | Collects all modules which are imported, so that we can identify dependencies of the first type.

165170 imports :: [(String, ModuleIdentifier)]

@@ -248,9 +253,9 @@ trailingCommaList (JSCTLNone l) = commaList l

248253--

249254-- Each type of module element is matched using pattern guards, and everything else is bundled into the

250255-- Other constructor.

251−toModule :: forall m. (MonadError ErrorMessage m) => S.Set String -> ModuleIdentifier -> JSAST -> m Module

252−toModule mids mid top

253− | JSAstProgram smts _ <- top = Module mid <$> traverse toModuleElement smts

256+toModule :: forall m. (MonadError ErrorMessage m) => S.Set String -> ModuleIdentifier -> Maybe FilePath -> JSAST -> m Module

257+toModule mids mid filename top

258+ | JSAstProgram smts _ <- top = Module mid filename <$> traverse toModuleElement smts

254259 | otherwise = err InvalidTopLevel

255260 where

256261 err = throwError . ErrorInModule mid

@@ -389,7 +394,7 @@ compile modules entryPoints = filteredModules

389394 -- | The vertex set

390395 verts :: [(ModuleElement, Key, [Key])]

391396 verts = do

392− Module mid els <- modules

397+ Module mid _ els <- modules

393398 concatMap (toVertices mid) els

394399 where

395400 -- | Create a set of vertices for a module element.

@@ -425,14 +430,21 @@ compile modules entryPoints = filteredModules

425430 filteredModules = map filterUsed modules

426431 where

427432 filterUsed :: Module -> Module

428− filterUsed (Module mid ds) = Module mid (map filterExports (go ds))

433+ filterUsed (Module mid fn ds) = Module mid fn (map filterExports (go ds))

429434 where

430435 go :: [ModuleElement] -> [ModuleElement]

431436 go [] = []

432437 go (d : rest)

433− | not (isDeclUsed d) = go rest

438+ | not (isDeclUsed d) = skipDecl d : go rest

434439 | otherwise = d : go rest

435440

441+ skipDecl :: ModuleElement -> ModuleElement

442+ skipDecl (Require s _ _) = Skip s

443+ skipDecl (Member s _ _ _ _) = Skip s

444+ skipDecl (ExportsList _) = Skip (JSEmptyStatement JSNoAnnot)

445+ skipDecl (Other s) = Skip s

446+ skipDecl (Skip s) = Skip s

447+

436448 -- | Filter out the exports for members which aren't used.

437449 filterExports :: ModuleElement -> ModuleElement

438450 filterExports (ExportsList exps) = ExportsList (filter (\(_, nm, _, _) -> isKeyUsed (mid, nm)) exps)

@@ -453,7 +465,7 @@ sortModules :: [Module] -> [Module]

453465sortModules modules = map (\v -> case nodeFor v of (n, _, _) -> n) (reverse (topSort graph))

454466 where

455467 (graph, nodeFor, _) = graphFromEdges $ do

456− m@(Module mid els) <- modules

468+ m@(Module mid _ els) <- modules

457469 return (m, mid, mapMaybe getKey els)

458470

459471 getKey :: ModuleElement -> Maybe ModuleIdentifier

@@ -466,12 +478,13 @@ sortModules modules = map (\v -> case nodeFor v of (n, _, _) -> n) (reverse (top

466478--

467479-- If a module is empty, we don't want to generate code for it.

468480isModuleEmpty :: Module -> Bool

469−isModuleEmpty (Module _ els) = all isElementEmpty els

481+isModuleEmpty (Module _ _ els) = all isElementEmpty els

470482 where

471483 isElementEmpty :: ModuleElement -> Bool

472484 isElementEmpty (ExportsList exps) = null exps

473485 isElementEmpty Require{} = True

474486 isElementEmpty (Other _) = True

487+ isElementEmpty (Skip _) = True

475488 isElementEmpty _ = False

476489

477490-- | Generate code for a set of modules, including a call to main().

@@ -490,16 +503,62 @@ isModuleEmpty (Module _ els) = all isElementEmpty els

490503codeGen :: Maybe String -- ^ main module

491504 -> String -- ^ namespace

492505 -> [Module] -- ^ input modules

493− -> String

494−codeGen optionsMainModule optionsNamespace ms = renderToString (JSAstProgram (prelude : concatMap moduleToJS ms ++ maybe [] runMain optionsMainModule) JSNoAnnot)

506+ -> Maybe String -- ^ output filename

507+ -> (Maybe SourceMapping, String)

508+codeGen optionsMainModule optionsNamespace ms outFileOpt = (fmap sourceMapping outFileOpt, rendered)

495509 where

496− moduleToJS :: Module -> [JSStatement]

497− moduleToJS (Module mn ds) = wrap (moduleName mn) (indent (concatMap declToJS ds))

510+ rendered = renderToString (JSAstProgram (prelude : concatMap fst modulesJS ++ maybe [] runMain optionsMainModule) JSNoAnnot)

511+

512+ sourceMapping :: String -> SourceMapping

513+ sourceMapping outFile = SourceMapping {

514+ smFile = outFile,

515+ smSourceRoot = Nothing,

516+ smMappings = concat $

517+ zipWith3 (\file (pos :: Int) positions ->

518+ map (\(porig, pgen) -> Mapping {

519+ mapOriginal = Just (Pos (fromIntegral $ porig + 1) 0)

520+ , mapSourceFile = pathToFile <$> file

521+ , mapGenerated = (Pos (fromIntegral $ pos + pgen) 0)

522+ , mapName = Nothing

523+ })

524+ (offsets (0,0) (Right 1 : positions)))

525+ moduleFns

526+ (scanl (+) (3 + moduleLength [prelude]) (map (3+) moduleLengths)) -- 3 lines between each module & at top

527+ (map snd modulesJS)

528+ }

498529 where

499− declToJS :: ModuleElement -> [JSStatement]

500− declToJS (Member n _ _ _ _) = [n]

501− declToJS (Other n) = [n]

502− declToJS (Require _ nm req) =

530+ pathToFile = makeRelative (takeDirectory outFile)

531+

532+ offsets (m, n) (Left d:rest) = offsets (m+d, n) rest

533+ offsets (m, n) (Right d:rest) = map ((m+) &&& (n+)) [0 .. d - 1] ++ offsets (m+d, n+d) rest

534+ offsets _ _ = []

535+

536+ moduleLength :: [JSStatement] -> Int

537+ moduleLength = everything (+) (mkQ 0 countw)

538+ where

539+ countw :: CommentAnnotation -> Int

540+ countw (WhiteSpace _ s) = length (filter (== '\n') s)

541+ countw _ = 0

542+

543+ moduleLengths :: [Int]

544+ moduleLengths = map (sum . map (either (const 0) id) . snd) modulesJS

545+ moduleFns = map (\(Module _ fn _) -> fn) ms

546+

547+ modulesJS = map moduleToJS ms

548+

549+ moduleToJS :: Module -> ([JSStatement], [Either Int Int])

550+ moduleToJS (Module mn _ ds) = (wrap (moduleName mn) (indent (concat jsDecls)), lengths)

551+ where

552+ (jsDecls, lengths) = unzip $ map declToJS ds

553+

554+ withLength :: [JSStatement] -> ([JSStatement], Either Int Int)

555+ withLength n = (n, Right $ moduleLength n)

556+

557+ declToJS :: ModuleElement -> ([JSStatement], Either Int Int)

558+ declToJS (Member n _ _ _ _) = withLength [n]

559+ declToJS (Other n) = withLength [n]

560+ declToJS (Skip n) = ([], Left $ moduleLength [n])

561+ declToJS (Require _ nm req) = withLength

503562 [

504563 JSVariable lfsp

505564 (cList [

@@ -507,9 +566,10 @@ codeGen optionsMainModule optionsNamespace ms = renderToString (JSAstProgram (p

507566 (JSVarInit sp $ either require (moduleReference sp . moduleName) req )

508567 ]) (JSSemi JSNoAnnot)

509568 ]

510− declToJS (ExportsList exps) = map toExport exps

569+ declToJS (ExportsList exps) = withLength $ map toExport exps

511570

512571 where

572+

513573 toExport :: (ExportType, String, JSExpression, [Key]) -> JSStatement

514574 toExport (_, nm, val, _) =

515575 JSAssignStatement

@@ -612,26 +672,39 @@ codeGen optionsMainModule optionsNamespace ms = renderToString (JSAstProgram (p

612672-- | The bundling function.

613673-- This function performs dead code elimination, filters empty modules

614674-- and generates and prints the final Javascript bundle.

615−bundle :: (MonadError ErrorMessage m)

616− => [(ModuleIdentifier, String)] -- ^ The input modules. Each module should be javascript rendered from 'Language.PureScript.Make' or @psc@.

675+bundleSM :: (MonadError ErrorMessage m)

676+ => [(ModuleIdentifier, Maybe FilePath, String)] -- ^ The input modules. Each module should be javascript rendered from 'Language.PureScript.Make' or @psc@.

617677 -> [ModuleIdentifier] -- ^ Entry points. These module identifiers are used as the roots for dead-code elimination

618678 -> Maybe String -- ^ An optional main module.

619679 -> String -- ^ The namespace (e.g. PS).

620− -> m String

621−bundle inputStrs entryPoints mainModule namespace = do

680+ -> Maybe FilePath -- ^ The output file name (if there is one - in which case generate source map)

681+ -> m (Maybe SourceMapping, String)

682+bundleSM inputStrs entryPoints mainModule namespace outFilename = do

683+ let mid (a,_,_) = a

622684 forM_ mainModule $ \mname ->

623− when (mname `notElem` map (moduleName . fst) inputStrs) (throwError (MissingMainModule mname))

685+ when (mname `notElem` map (moduleName . mid) inputStrs) (throwError (MissingMainModule mname))

624686 forM_ entryPoints $ \mIdent ->

625− when (mIdent `notElem` map fst inputStrs) (throwError (MissingEntryPoint (moduleName mIdent)))

626− input <- forM inputStrs $ \(ident, js) -> do

687+ when (mIdent `notElem` map mid inputStrs) (throwError (MissingEntryPoint (moduleName mIdent)))

688+ input <- forM inputStrs $ \(ident, filename, js) -> do

627689 ast <- either (throwError . ErrorInModule ident . UnableToParseModule) pure $ parse js (moduleName ident)

628− return (ident, ast)

690+ return (ident, filename, ast)

629691

630− let mids = S.fromList (map (moduleName . fst) input)

692+ let mids = S.fromList (map (moduleName . mid) input)

631693

632− modules <- traverse (fmap withDeps . uncurry (toModule mids)) input

694+ modules <- traverse (fmap withDeps . (\(a,fn,c) -> toModule mids a fn c)) input

633695

634696 let compiled = compile modules entryPoints

635697 sorted = sortModules (filter (not . isModuleEmpty) compiled)

636698

637− return (codeGen mainModule namespace sorted)

699+ return (codeGen mainModule namespace sorted outFilename)

700+

701+-- | The bundling function.

702+-- This function performs dead code elimination, filters empty modules

703+-- and generates and prints the final Javascript bundle.

704+bundle :: (MonadError ErrorMessage m)

705+ => [(ModuleIdentifier, String)] -- ^ The input modules. Each module should be javascript rendered from 'Language.PureScript.Make' or @psc@.

706+ -> [ModuleIdentifier] -- ^ Entry points. These module identifiers are used as the roots for dead-code elimination

707+ -> Maybe String -- ^ An optional main module.

708+ -> String -- ^ The namespace (e.g. PS).

709+ -> m String

710+bundle inputStrs entryPoints mainModule namespace = snd <$> bundleSM (map (\(a,b) -> (a,Nothing,b)) inputStrs) entryPoints mainModule namespace Nothing

src/Language/PureScript/CodeGen/JS.hs+1−1

@@ -293,7 +293,7 @@ moduleToJs (Module coms mn imps exps foreigns decls) foreign_ =

293293 evaluate = JSVariableIntroduction Nothing evaluatedObj (Just obj)

294294 objAssign = JSVariableIntroduction Nothing newObj (Just $ JSObjectLiteral Nothing [])

295295 copy = JSForIn Nothing key jsEvaluatedObj $ JSBlock Nothing [JSIfElse Nothing cond assign Nothing]

296− cond = JSApp Nothing (JSAccessor Nothing "hasOwnProperty" jsEvaluatedObj) [jsKey]

296+ cond = JSApp Nothing (JSAccessor Nothing "call" (JSAccessor Nothing "hasOwnProperty" (JSObjectLiteral Nothing []))) [jsEvaluatedObj, jsKey]

297297 assign = JSBlock Nothing [JSAssignment Nothing (JSIndexer Nothing jsKey jsNewObj) (JSIndexer Nothing jsKey jsEvaluatedObj)]

298298 stToAssign (s, js) = JSAssignment Nothing (accessorString s jsNewObj) js

299299 extend = map stToAssign sts

src/Language/PureScript/Constants.hs+47−4

@@ -139,6 +139,9 @@ compose = "compose"

139139composeFlipped :: Text

140140composeFlipped = "composeFlipped"

141141

142+map :: Text

143+map = "map"

144+

142145-- Functions

143146

144147negate :: Text

@@ -314,10 +317,38 @@ fromSpine = "fromSpine"

314317toSignature :: Text

315318toSignature = "toSignature"

316319

317−-- IsSymbol class

320+-- Data.Symbol

321+

322+pattern DataSymbol :: ModuleName

323+pattern DataSymbol = ModuleName [ProperName "Data", ProperName "Symbol"]

318324

319325pattern IsSymbol :: Qualified (ProperName 'ClassName)

320−pattern IsSymbol = Qualified (Just (ModuleName [ProperName "Data", ProperName "Symbol"])) (ProperName "IsSymbol")

326+pattern IsSymbol = Qualified (Just DataSymbol) (ProperName "IsSymbol")

327+

328+-- Type.Data.Symbol

329+

330+pattern TypeDataSymbol :: ModuleName

331+pattern TypeDataSymbol = ModuleName [ProperName "Type", ProperName "Data", ProperName "Symbol"]

332+

333+pattern CompareSymbol :: Qualified (ProperName 'ClassName)

334+pattern CompareSymbol = Qualified (Just TypeDataSymbol) (ProperName "CompareSymbol")

335+

336+pattern AppendSymbol :: Qualified (ProperName 'ClassName)

337+pattern AppendSymbol = Qualified (Just TypeDataSymbol) (ProperName "AppendSymbol")

338+

339+-- Type.Data.Ordering

340+

341+typeDataOrdering :: ModuleName

342+typeDataOrdering = ModuleName [ProperName "Type", ProperName "Data", ProperName "Ordering"]

343+

344+orderingLT :: Qualified (ProperName 'TypeName)

345+orderingLT = Qualified (Just typeDataOrdering) (ProperName "LT")

346+

347+orderingEQ :: Qualified (ProperName 'TypeName)

348+orderingEQ = Qualified (Just typeDataOrdering) (ProperName "EQ")

349+

350+orderingGT :: Qualified (ProperName 'TypeName)

351+orderingGT = Qualified (Just typeDataOrdering) (ProperName "GT")

321352

322353-- Main module

323354

@@ -329,11 +360,23 @@ main = "main"

329360partial :: Text

330361partial = "Partial"

331362

363+pattern Prim :: ModuleName

364+pattern Prim = ModuleName [ProperName "Prim"]

365+

332366pattern Partial :: Qualified (ProperName 'ClassName)

333−pattern Partial = Qualified (Just (ModuleName [ProperName "Prim"])) (ProperName "Partial")

367+pattern Partial = Qualified (Just Prim) (ProperName "Partial")

334368

335369pattern Fail :: Qualified (ProperName 'ClassName)

336−pattern Fail = Qualified (Just (ModuleName [ProperName "Prim"])) (ProperName "Fail")

370+pattern Fail = Qualified (Just Prim) (ProperName "Fail")

371+

372+typ :: Text

373+typ = "Type"

374+

375+effect :: Text

376+effect = "Effect"

377+

378+symbol :: Text

379+symbol = "Symbol"

337380

338381-- Code Generation

339382

src/Language/PureScript/Docs.hs+1

@@ -7,6 +7,7 @@ module Language.PureScript.Docs (

77) where

99import Language.PureScript.Docs.Convert as Docs

10+import Language.PureScript.Docs.Prim as Docs

1011import Language.PureScript.Docs.ParseAndBookmark as Docs

1112import Language.PureScript.Docs.Render as Docs

1213import Language.PureScript.Docs.RenderedCode.Render as Docs

src/Language/PureScript/Docs/AsMarkdown.hs+21−18

@@ -13,7 +13,9 @@ import Control.Monad.Error.Class (MonadError)

1313import Control.Monad.Writer (Writer, tell, execWriter)

1414

1515import Data.Foldable (for_)

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

1617import Data.List (partition)

18+import Data.Text (Text)

1719import qualified Data.Text as T

1820

1921import Language.PureScript.Docs.RenderedCode

@@ -24,27 +26,28 @@ import qualified Language.PureScript.Docs.Render as Render

2426

2527-- |

2628-- Take a list of modules and render them all in order, returning a single

27−-- Markdown-formatted String.

29+-- Markdown-formatted Text.

2830--

2931renderModulesAsMarkdown ::

3032 (MonadError P.MultipleErrors m) =>

3133 [P.Module] ->

32− m String

34+ m Text

3335renderModulesAsMarkdown =

34− fmap (runDocs . modulesAsMarkdown) . Convert.convertModules

36+ fmap (runDocs . modulesAsMarkdown) . Convert.convertModules Local

3537

3638modulesAsMarkdown :: [Module] -> Docs

3739modulesAsMarkdown = mapM_ moduleAsMarkdown

3840

3941moduleAsMarkdown :: Module -> Docs

4042moduleAsMarkdown Module{..} = do

41− headerLevel 2 $ "Module " ++ T.unpack (P.runModuleName modName)

43+ headerLevel 2 $ "Module " <> P.runModuleName modName

4244 spacer

4345 for_ modComments tell'

4446 mapM_ (declAsMarkdown modName) modDeclarations

4547 spacer

46− for_ modReExports $ \(mn, decls) -> do

47− headerLevel 3 $ "Re-exported from " ++ T.unpack (P.runModuleName mn) ++ ":"

48+ for_ modReExports $ \(mn', decls) -> do

49+ let mn = ignorePackage mn'

50+ headerLevel 3 $ "Re-exported from " <> P.runModuleName mn <> ":"

4851 spacer

4952 mapM_ (declAsMarkdown mn) decls

5053

@@ -71,7 +74,7 @@ declAsMarkdown mn decl@Declaration{..} = do

7174 isChildInstance (ChildInstance _ _) = True

7275 isChildInstance _ = False

7376

74−codeToString :: RenderedCode -> String

77+codeToString :: RenderedCode -> Text

7578codeToString = outputWith elemAsMarkdown

7679 where

7780 elemAsMarkdown (Syntax x) = x

@@ -95,14 +98,14 @@ codeToString = outputWith elemAsMarkdown

9598-- P.Infixr -> "right-associative"

9699-- P.Infix -> "non-associative"

97100

98−childToString :: First -> ChildDeclaration -> String

101+childToString :: First -> ChildDeclaration -> Text

99102childToString f decl@ChildDeclaration{..} =

100103 case cdeclInfo of

101104 ChildDataConstructor _ ->

102105 let c = if f == First then "=" else "|"

103− in " " ++ c ++ " " ++ str

106+ in " " <> c <> " " <> str

104107 ChildTypeClassMember _ ->

105− " " ++ str

108+ " " <> str

106109 ChildInstance _ _ ->

107110 str

108111 where

@@ -113,19 +116,19 @@ data First

113116 | NotFirst

114117 deriving (Show, Eq, Ord)

115118

116−type Docs = Writer [String] ()

119+type Docs = Writer [Text] ()

117120

118−runDocs :: Docs -> String

119−runDocs = unlines . execWriter

121+runDocs :: Docs -> Text

122+runDocs = T.unlines . execWriter

120123

121−tell' :: String -> Docs

124+tell' :: Text -> Docs

122125tell' = tell . (:[])

123126

124127spacer :: Docs

125128spacer = tell' ""

126129

127−headerLevel :: Int -> String -> Docs

128−headerLevel level hdr = tell' (replicate level '#' ++ ' ' : hdr)

130+headerLevel :: Int -> Text -> Docs

131+headerLevel level hdr = tell' (T.replicate level "#" <> " " <> hdr)

129132

130133fencedBlock :: Docs -> Docs

131134fencedBlock inner = do

@@ -133,5 +136,5 @@ fencedBlock inner = do

133136 inner

134137 tell' "```"

135138

136−ticks :: String -> String

137−ticks = ("`" ++) . (++ "`")

139+ticks :: Text -> Text

140+ticks = ("`" <>) . (<> "`")

src/Language/PureScript/Docs/Convert.hs+20−8

@@ -15,8 +15,9 @@ import Control.Monad

1515import Control.Monad.Error.Class (MonadError)

1616import Control.Monad.State (runStateT)

1717import Control.Monad.Writer.Strict (runWriterT)

18+import Data.List (find)

1819import qualified Data.Map as Map

19−import qualified Data.Text as T

20+import Data.Text (Text)

2021

2122import Language.PureScript.Docs.Convert.ReExports (updateReExports)

2223import Language.PureScript.Docs.Convert.Single (convertSingleModule, collectBookmarks)

@@ -42,9 +43,18 @@ convertModulesInPackage modules =

4243 map P.getModuleName (takeLocals modules)

4344 go =

4445 map ignorePackage

45− >>> convertModules

46+ >>> convertModules withPackage

4647 >>> fmap (filter ((`elem` localNames) . modName))

4748

49+ withPackage :: P.ModuleName -> InPackage P.ModuleName

50+ withPackage mn =

51+ case find ((== mn) . P.getModuleName . ignorePackage) modules of

52+ Just m ->

53+ fmap P.getModuleName m

54+ Nothing ->

55+ P.internalError $ "withPackage: missing module:" ++

56+ show (P.runModuleName mn)

57+

4858-- |

4959-- Convert a group of modules to the intermediate format, designed for

5060-- producing documentation from. It is also necessary to pass an Env containing

@@ -61,12 +71,13 @@ convertModulesInPackage modules =

6171--

6272convertModules ::

6373 (MonadError P.MultipleErrors m) =>

74+ (P.ModuleName -> InPackage P.ModuleName) ->

6475 [P.Module] ->

6576 m [Module]

66−convertModules =

77+convertModules withPackage =

6778 P.sortModules

6879 >>> fmap (fst >>> map importPrim)

69− >=> convertSorted

80+ >=> convertSorted withPackage

7081

7182importPrim :: P.Module -> P.Module

7283importPrim = P.addDefaultImport (P.ModuleName [P.ProperName C.prim])

@@ -76,16 +87,17 @@ importPrim = P.addDefaultImport (P.ModuleName [P.ProperName C.prim])

7687--

7788convertSorted ::

7889 (MonadError P.MultipleErrors m) =>

90+ (P.ModuleName -> InPackage P.ModuleName) ->

7991 [P.Module] ->

8092 m [Module]

81−convertSorted modules = do

93+convertSorted withPackage modules = do

8294 (env, convertedModules) <- second (map convertSingleModule) <$> partiallyDesugar modules

8395

8496 modulesWithTypes <- typeCheckIfNecessary modules convertedModules

8597 let moduleMap = Map.fromList (map (modName &&& id) modulesWithTypes)

8698

8799 let traversalOrder = map P.getModuleName modules

88− pure (Map.elems (updateReExports env traversalOrder moduleMap))

100+ pure (Map.elems (updateReExports env traversalOrder withPackage moduleMap))

89101

90102-- |

91103-- If any exported value declarations have either wildcard type signatures, or

@@ -167,9 +179,9 @@ insertValueTypes env m =

167179 err msg =

168180 P.internalError ("Docs.Convert.insertValueTypes: " ++ msg)

169181

170−runParser :: P.TokenParser a -> String -> Either String a

182+runParser :: P.TokenParser a -> Text -> Either String a

171183runParser p s = either (Left . show) Right $ do

172− ts <- P.lex "" (T.pack s)

184+ ts <- P.lex "" s

173185 P.runTokenParser "" (p <* eof) ts

174186

175187-- |

src/Language/PureScript/Docs/Convert/ReExports.hs+43−19

@@ -16,6 +16,7 @@ import Data.Map (Map)

1616import Data.Maybe (mapMaybe)

1717import Data.Monoid ((<>))

1818import qualified Data.Map as Map

19+import Data.Text (Text)

1920import qualified Data.Text as T

2021

2122import Language.PureScript.Docs.Types

@@ -34,9 +35,10 @@ import qualified Language.PureScript as P

3435updateReExports ::

3536 P.Env ->

3637 [P.ModuleName] ->

38+ (P.ModuleName -> InPackage P.ModuleName) ->

3739 Map P.ModuleName Module ->

3840 Map P.ModuleName Module

39−updateReExports env order = execState action

41+updateReExports env order withPackage = execState action

4042 where

4143 action =

4244 void (traverse go order)

@@ -44,7 +46,7 @@ updateReExports env order = execState action

4446 go mn = do

4547 mdl <- lookup' mn

4648 reExports <- getReExports env mn

47− let mdl' = mdl { modReExports = reExports }

49+ let mdl' = mdl { modReExports = map (first withPackage) reExports }

4850 modify (Map.insert mn mdl')

4951

5052 lookup' mn = do

@@ -108,13 +110,14 @@ collectDeclarations imports exports = do

108110 typeClasses <- collect lookupTypeClassDeclaration impTCs expTCs

109111 types <- collect lookupTypeDeclaration impTypes expTypes

110112 typeOps <- collect lookupTypeOpDeclaration impTypeOps expTypeOps

113+ kinds <- collect lookupKindDeclaration impKinds expKinds

111114

112115 (vals, classes) <- handleTypeClassMembers valsAndMembers typeClasses

113116

114117 let filteredTypes = filterDataConstructors expCtors types

115118 let filteredClasses = filterTypeClassMembers (Map.keys expVals) classes

116119

117− pure (Map.toList (Map.unionsWith (<>) [filteredTypes, filteredClasses, vals, valOps, typeOps]))

120+ pure (Map.toList (Map.unionsWith (<>) [filteredTypes, filteredClasses, vals, valOps, typeOps, kinds]))

118121

119122 where

120123

@@ -145,6 +148,9 @@ collectDeclarations imports exports = do

145148 expTCs = P.exportedTypeClasses exports

146149 impTCs = concat (Map.elems (P.importedTypeClasses imports))

147150

151+ expKinds = P.exportedKinds exports

152+ impKinds = concat (Map.elems (P.importedKinds imports))

153+

148154-- |

149155-- Given a list of imported declarations (of a particular kind, ie. type, data,

150156-- class, value, etc), and the name of an exported declaration of the same

@@ -184,12 +190,12 @@ lookupValueDeclaration ::

184190 MonadReader P.ModuleName m) =>

185191 P.ModuleName ->

186192 P.Ident ->

187− m (P.ModuleName, [Either (String, P.Constraint, ChildDeclaration) Declaration])

193+ m (P.ModuleName, [Either (Text, P.Constraint, ChildDeclaration) Declaration])

188194lookupValueDeclaration importedFrom ident = do

189195 decls <- lookupModuleDeclarations "lookupValueDeclaration" importedFrom

190196 let

191197 rs =

192− filter (\d -> declTitle d == T.unpack (P.showIdent ident)

198+ filter (\d -> declTitle d == P.showIdent ident

193199 && (isValue d || isValueAlias d)) decls

194200 errOther other =

195201 internalErrorInModule

@@ -215,7 +221,7 @@ lookupValueDeclaration importedFrom ident = do

215221 (declChildren d))

216222

217223 matchesIdent cdecl =

218− cdeclTitle cdecl == T.unpack (P.showIdent ident)

224+ cdeclTitle cdecl == P.showIdent ident

219225

220226 matchesAndIsTypeClassMember =

221227 uncurry (&&) . (matchesIdent &&& isTypeClassMember)

@@ -239,7 +245,7 @@ lookupValueOpDeclaration

239245 -> m (P.ModuleName, [Declaration])

240246lookupValueOpDeclaration importedFrom op = do

241247 decls <- lookupModuleDeclarations "lookupValueOpDeclaration" importedFrom

242− case filter (\d -> declTitle d == T.unpack (P.showOp op) && isValueAlias d) decls of

248+ case filter (\d -> declTitle d == P.showOp op && isValueAlias d) decls of

243249 [d] ->

244250 pure (importedFrom, [d])

245251 other ->

@@ -259,7 +265,7 @@ lookupTypeDeclaration ::

259265lookupTypeDeclaration importedFrom ty = do

260266 decls <- lookupModuleDeclarations "lookupTypeDeclaration" importedFrom

261267 let

262− ds = filter (\d -> declTitle d == T.unpack (P.runProperName ty) && isType d) decls

268+ ds = filter (\d -> declTitle d == P.runProperName ty && isType d) decls

263269 case ds of

264270 [d] ->

265271 pure (importedFrom, [d])

@@ -275,7 +281,7 @@ lookupTypeOpDeclaration

275281lookupTypeOpDeclaration importedFrom tyOp = do

276282 decls <- lookupModuleDeclarations "lookupTypeOpDeclaration" importedFrom

277283 let

278− ds = filter (\d -> declTitle d == ("type " ++ T.unpack (P.showOp tyOp)) && isTypeAlias d) decls

284+ ds = filter (\d -> declTitle d == ("type " <> P.showOp tyOp) && isTypeAlias d) decls

279285 case ds of

280286 [d] ->

281287 pure (importedFrom, [d])

@@ -291,7 +297,7 @@ lookupTypeClassDeclaration

291297lookupTypeClassDeclaration importedFrom tyClass = do

292298 decls <- lookupModuleDeclarations "lookupTypeClassDeclaration" importedFrom

293299 let

294− ds = filter (\d -> declTitle d == T.unpack (P.runProperName tyClass)

300+ ds = filter (\d -> declTitle d == P.runProperName tyClass

295301 && isTypeClass d)

296302 decls

297303 case ds of

@@ -302,6 +308,24 @@ lookupTypeClassDeclaration importedFrom tyClass = do

302308 ("lookupTypeClassDeclaration: unexpected result: "

303309 ++ (unlines . map show) other)

304310

311+lookupKindDeclaration

312+ :: (MonadState (Map P.ModuleName Module) m, MonadReader P.ModuleName m)

313+ => P.ModuleName

314+ -> P.ProperName 'P.KindName

315+ -> m (P.ModuleName, [Declaration])

316+lookupKindDeclaration importedFrom kind = do

317+ decls <- lookupModuleDeclarations "lookupKindDeclaration" importedFrom

318+ let

319+ ds = filter (\d -> declTitle d == P.runProperName kind

320+ && isKind d)

321+ decls

322+ case ds of

323+ [d] ->

324+ pure (importedFrom, [d])

325+ other ->

326+ internalErrorInModule

327+ ("lookupKindDeclaration: unexpected result: " ++ show other)

328+

305329-- |

306330-- Get the full list of declarations for a particular module out of the

307331-- state, or raise an internal error if it is not there.

@@ -324,7 +348,7 @@ lookupModuleDeclarations definedIn moduleName = do

324348

325349handleTypeClassMembers ::

326350 (MonadReader P.ModuleName m) =>

327− Map P.ModuleName [Either (String, P.Constraint, ChildDeclaration) Declaration] ->

351+ Map P.ModuleName [Either (Text, P.Constraint, ChildDeclaration) Declaration] ->

328352 Map P.ModuleName [Declaration] ->

329353 m (Map P.ModuleName [Declaration], Map P.ModuleName [Declaration])

330354handleTypeClassMembers valsAndMembers typeClasses =

@@ -339,7 +363,7 @@ handleTypeClassMembers valsAndMembers typeClasses =

339363 |> fmap splitMap

340364

341365valsAndMembersToEnv ::

342− [Either (String, P.Constraint, ChildDeclaration) Declaration] -> TypeClassEnv

366+ [Either (Text, P.Constraint, ChildDeclaration) Declaration] -> TypeClassEnv

343367valsAndMembersToEnv xs =

344368 let (envUnhandledMembers, envValues) = partitionEithers xs

345369 envTypeClasses = []

@@ -360,11 +384,11 @@ typeClassesToEnv classes =

360384--

361385data TypeClassEnv = TypeClassEnv

362386 { -- |

363− -- Type class members which have not yet been dealt with. The String is the

387+ -- Type class members which have not yet been dealt with. The Text is the

364388 -- name of the type class they belong to, and the constraint is used to

365389 -- make sure that they have the correct type if they get promoted.

366390 --

367− envUnhandledMembers :: [(String, P.Constraint, ChildDeclaration)]

391+ envUnhandledMembers :: [(Text, P.Constraint, ChildDeclaration)]

368392 -- |

369393 -- A list of normal value declarations. Type class members will be added to

370394 -- this list if their parent type class is not available.

@@ -428,7 +452,7 @@ handleEnv TypeClassEnv{..} =

428452 _ ->

429453 internalErrorInModule

430454 ("handleEnv: Bad child declaration passed to promoteChild: "

431− ++ cdeclTitle)

455+ ++ T.unpack cdeclTitle)

432456

433457 addConstraint constraint =

434458 P.quantify . P.moveQuantifiersToFront . P.ConstrainedType [constraint]

@@ -448,7 +472,7 @@ filterDataConstructors

448472 -> Map P.ModuleName [Declaration]

449473 -> Map P.ModuleName [Declaration]

450474filterDataConstructors =

451− filterExportedChildren isDataConstructor (T.unpack . P.runProperName)

475+ filterExportedChildren isDataConstructor P.runProperName

452476

453477-- |

454478-- Given a list of exported type class member names, remove any data

@@ -460,12 +484,12 @@ filterTypeClassMembers

460484 -> Map P.ModuleName [Declaration]

461485 -> Map P.ModuleName [Declaration]

462486filterTypeClassMembers =

463− filterExportedChildren isTypeClassMember (T.unpack . P.showIdent)

487+ filterExportedChildren isTypeClassMember P.showIdent

464488

465489filterExportedChildren

466490 :: (Functor f)

467491 => (ChildDeclaration -> Bool)

468− -> (name -> String)

492+ -> (name -> Text)

469493 -> [name]

470494 -> f [Declaration]

471495 -> f [Declaration]

@@ -504,7 +528,7 @@ typeClassConstraintFor :: Declaration -> Maybe P.Constraint

504528typeClassConstraintFor Declaration{..} =

505529 case declInfo of

506530 TypeClassDeclaration tyArgs _ _ ->

507− Just (P.Constraint (P.Qualified Nothing (P.ProperName (T.pack declTitle))) (mkConstraint (map (first T.pack) tyArgs)) Nothing)

531+ Just (P.Constraint (P.Qualified Nothing (P.ProperName declTitle)) (mkConstraint tyArgs) Nothing)

508532 _ ->

509533 Nothing

510534 where

src/Language/PureScript/Docs/Convert/Single.hs+29−48

@@ -5,24 +5,19 @@ module Language.PureScript.Docs.Convert.Single

66import Prelude.Compat

8−import Control.Arrow (first)

98import Control.Category ((>>>))

109import Control.Monad

1110

12−import Data.Bifunctor (bimap)

1311import Data.Either

1412import Data.List (nub)

15−import Data.Maybe (mapMaybe)

13+import Data.Maybe (mapMaybe, fromMaybe)

1614import Data.Monoid ((<>))

1715import Data.Text (Text)

1816import qualified Data.Text as T

19−import qualified Data.Vector as V

2017

2118import Language.PureScript.Docs.Types

2219import qualified Language.PureScript as P

2320

24−-- TODO (Christoph): Get rid of the T.unpack s

25−

2621-- |

2722-- Convert a single Module, but ignore re-exports; any re-exported types or

2823-- values will not appear in the result.

@@ -48,14 +43,14 @@ convertSingleModule m@(P.Module _ coms moduleName _ _) =

4843-- In the second pass, we go over all of the Left values and augment the

4944-- relevant declarations, leaving only the augmented Right values.

5045--

51−-- Note that in the Left case, we provide a [String] as well as augment

52−-- information. The [String] value should be a list of titles of declarations

46+-- Note that in the Left case, we provide a [Text] as well as augment

47+-- information. The [Text] value should be a list of titles of declarations

5348-- that the augmentation should apply to. For example, for a type instance

5449-- declaration, that would be any types or type classes mentioned in the

5550-- instance. For a fixity declaration, it would be just the relevant operator's

5651-- name.

5752type IntermediateDeclaration

58− = Either ([String], DeclarationAugment) Declaration

53+ = Either ([Text], DeclarationAugment) Declaration

5954

6055-- | Some data which will be used to augment a Declaration in the

6156-- output.

@@ -88,6 +83,7 @@ getDeclarationTitle (P.ValueDeclaration name _ _ _) = Just (P.showIdent name)

8883getDeclarationTitle (P.ExternDeclaration name _) = Just (P.showIdent name)

8984getDeclarationTitle (P.DataDeclaration _ name _ _) = Just (P.runProperName name)

9085getDeclarationTitle (P.ExternDataDeclaration name _) = Just (P.runProperName name)

86+getDeclarationTitle (P.ExternKindDeclaration name) = Just (P.runProperName name)

9187getDeclarationTitle (P.TypeSynonymDeclaration name _ _) = Just (P.runProperName name)

9288getDeclarationTitle (P.TypeClassDeclaration name _ _ _ _) = Just (P.runProperName name)

9389getDeclarationTitle (P.TypeInstanceDeclaration name _ _ _ _) = Just (P.showIdent name)

@@ -99,7 +95,7 @@ getDeclarationTitle _ = Nothing

9995-- | Create a basic Declaration value.

10096mkDeclaration :: Text -> DeclarationInfo -> Declaration

10197mkDeclaration title info =

102− Declaration { declTitle = T.unpack title

98+ Declaration { declTitle = title

10399 , declComments = Nothing

104100 , declSourceSpan = Nothing

105101 , declChildren = []

@@ -121,42 +117,29 @@ convertDeclaration (P.ExternDeclaration _ ty) title =

121117convertDeclaration (P.DataDeclaration dtype _ args ctors) title =

122118 Just (Right (mkDeclaration title info) { declChildren = children })

123119 where

124− info = DataDeclaration dtype (map (first T.unpack) args)

120+ info = DataDeclaration dtype args

125121 children = map convertCtor ctors

126122 convertCtor (ctor', tys) =

127− ChildDeclaration (T.unpack (P.runProperName ctor')) Nothing Nothing (ChildDataConstructor tys)

123+ ChildDeclaration (P.runProperName ctor') Nothing Nothing (ChildDataConstructor tys)

128124convertDeclaration (P.ExternDataDeclaration _ kind') title =

129125 basicDeclaration title (ExternDataDeclaration kind')

126+convertDeclaration (P.ExternKindDeclaration _) title =

127+ basicDeclaration title ExternKindDeclaration

130128convertDeclaration (P.TypeSynonymDeclaration _ args ty) title =

131− basicDeclaration title (TypeSynonymDeclaration (map (first T.unpack) args) ty)

129+ basicDeclaration title (TypeSynonymDeclaration args ty)

132130convertDeclaration (P.TypeClassDeclaration _ args implies fundeps ds) title =

133131 Just (Right (mkDeclaration title info) { declChildren = children })

134132 where

135− info = TypeClassDeclaration (map (first T.unpack) args) implies (map (bimap (map T.unpack) (map T.unpack)) fundeps')

133+ info = TypeClassDeclaration args implies (convertFundepsToStrings args fundeps)

136134 children = map convertClassMember ds

137135 convertClassMember (P.PositionedDeclaration _ _ d) =

138136 convertClassMember d

139137 convertClassMember (P.TypeDeclaration ident' ty) =

140− ChildDeclaration (T.unpack (P.showIdent ident')) Nothing Nothing (ChildTypeClassMember ty)

138+ ChildDeclaration (P.showIdent ident') Nothing Nothing (ChildTypeClassMember ty)

141139 convertClassMember _ =

142140 P.internalError "convertDeclaration: Invalid argument to convertClassMember."

143− fundeps' = map (\(P.FunctionalDependency from to) -> toArgs from to) fundeps

144− where

145− argsVec = V.fromList (map fst args)

146− getArg i =

147− maybe

148− (P.internalError $ unlines

149− [ "convertDeclaration: Functional dependency index"

150− , show i

151− , "is bigger than arguments list"

152− , show (map fst args)

153− , "Functional dependencies are"

154− , show fundeps

155− ]

156− ) id $ argsVec V.!? i

157− toArgs from to = (map getArg from, map getArg to)

158141convertDeclaration (P.TypeInstanceDeclaration _ constraints className tys _) title =

159− Just (Left (T.unpack classNameString : map T.unpack typeNameStrings, AugmentChild childDecl))

142+ Just (Left (classNameString : typeNameStrings, AugmentChild childDecl))

160143 where

161144 classNameString = unQual className

162145 typeNameStrings = nub (concatMap (P.everythingOnTypes (++) extractProperNames) tys)

@@ -165,7 +148,7 @@ convertDeclaration (P.TypeInstanceDeclaration _ constraints className tys _) tit

165148 extractProperNames (P.TypeConstructor n) = [unQual n]

166149 extractProperNames _ = []

167150

168− childDecl = ChildDeclaration (T.unpack title) Nothing Nothing (ChildInstance constraints classApp)

151+ childDecl = ChildDeclaration title Nothing Nothing (ChildInstance constraints classApp)

169152 classApp = foldl P.TypeApp (P.TypeConstructor (fmap P.coerceProperName className)) tys

170153convertDeclaration (P.ValueFixityDeclaration fixity (P.Qualified mn alias) _) title =

171154 Just $ Right $ mkDeclaration title (AliasDeclaration fixity (P.Qualified mn (Right alias)))

@@ -189,25 +172,24 @@ convertDeclaration (P.PositionedDeclaration srcSpan com d') title =

189172 withAugmentChild f (t, AugmentChild d) = (t, AugmentChild (f d))

190173convertDeclaration _ _ = Nothing

191174

192−convertComments :: [P.Comment] -> Maybe String

175+convertComments :: [P.Comment] -> Maybe Text

193176convertComments cs = do

194177 let raw = concatMap toLines cs

195178 let docs = mapMaybe stripPipe raw

196179 guard (not (null docs))

197− pure (unlines docs)

180+ pure (T.unlines docs)

198181

199182 where

200− toLines (P.LineComment s) = [T.unpack s]

201− toLines (P.BlockComment s) = lines (T.unpack s)

202−

203− stripPipe s' =

204− case dropWhile (== ' ') s' of

205− ('|':' ':s) ->

206− Just s

207− ('|':s) ->

208− Just s

209− _ ->

210− Nothing

183+ toLines (P.LineComment s) = [s]

184+ toLines (P.BlockComment s) = T.lines s

185+

186+ stripPipe =

187+ T.dropWhile (== ' ')

188+ >>> T.stripPrefix "|"

189+ >>> fmap (dropPrefix " ")

190+

191+ dropPrefix prefix str =

192+ fromMaybe str (T.stripPrefix prefix str)

211193

212194-- | Go through a PureScript module and extract a list of Bookmarks; references

213195-- to data types or values, to be used as a kind of index. These are used for

@@ -216,8 +198,7 @@ collectBookmarks :: InPackage P.Module -> [Bookmark]

216198collectBookmarks (Local m) = map Local (collectBookmarks' m)

217199collectBookmarks (FromDep pkg m) = map (FromDep pkg) (collectBookmarks' m)

218200

219−collectBookmarks' :: P.Module -> [(P.ModuleName, String)]

201+collectBookmarks' :: P.Module -> [(P.ModuleName, Text)]

220202collectBookmarks' m =

221203 map (P.getModuleName m, )

222− (mapMaybe (fmap T.unpack . getDeclarationTitle)

223− (P.exportedDeclarations m))

204+ (mapMaybe getDeclarationTitle (P.exportedDeclarations m))

src/Language/PureScript/Docs/Prim.hsnew file+244

@@ -0,0 +1,244 @@

1+-- | This module provides documentation for the builtin Prim module.

2+module Language.PureScript.Docs.Prim (primDocsModule) where

4+import Prelude.Compat hiding (fail)

5+import Data.Text (Text)

6+import qualified Data.Text as T

7+import qualified Data.Map as Map

8+import qualified Data.Set as Set

9+import Language.PureScript.Docs.Types

10+import qualified Language.PureScript as P

11+

12+primDocsModule :: Module

13+primDocsModule = Module

14+ { modName = P.moduleNameFromString "Prim"

15+ , modComments = Just "The Prim module is embedded in the PureScript compiler in order to provide compiler support for certain types — for example, value literals, or syntax sugar."

16+ , modDeclarations =

17+ [ function

18+ , array

19+ , record

20+ , number

21+ , int

22+ , string

23+ , char

24+ , boolean

25+ , partial

26+ , fail

27+ , typeConcat

28+ , typeString

29+ , kindType

30+ , kindEffect

31+ , kindSymbol

32+ ]

33+ , modReExports = []

34+ }

35+

36+unsafeLookup :: forall v (a :: P.ProperNameType).

37+ Map.Map (P.Qualified (P.ProperName a)) v -> String -> Text -> v

38+unsafeLookup m errorMsg name = go name

39+ where

40+ go = fromJust' . flip Map.lookup m . P.primName

41+

42+ fromJust' (Just x) = x

43+ fromJust' _ = P.internalError $ errorMsg ++ show name

44+

45+primKind :: Text -> Text -> Declaration

46+primKind title comments =

47+ if Set.member (P.primName title) P.primKinds

48+ then Declaration

49+ { declTitle = title

50+ , declComments = Just comments

51+ , declSourceSpan = Nothing

52+ , declChildren = []

53+ , declInfo = ExternKindDeclaration

54+ }

55+ else P.internalError $ "Docs.Prim: No such Prim kind: " ++ T.unpack title

56+

57+lookupPrimTypeKind :: Text -> P.Kind

58+lookupPrimTypeKind = fst . unsafeLookup P.primTypes "Docs.Prim: No such Prim type: "

59+

60+primType :: Text -> Text -> Declaration

61+primType title comments = Declaration

62+ { declTitle = title

63+ , declComments = Just comments

64+ , declSourceSpan = Nothing

65+ , declChildren = []

66+ , declInfo = ExternDataDeclaration (lookupPrimTypeKind title)

67+ }

68+

69+-- | Lookup the TypeClassData of a Prim class. This function is specifically

70+-- not exported because it is partial.

71+lookupPrimClass :: Text -> P.TypeClassData

72+lookupPrimClass = unsafeLookup P.primClasses "Docs.Prim: No such Prim class: "

73+

74+primClass :: Text -> Text -> Declaration

75+primClass title comments = Declaration

76+ { declTitle = title

77+ , declComments = Just comments

78+ , declSourceSpan = Nothing

79+ , declChildren = []

80+ , declInfo =

81+ let

82+ tcd = lookupPrimClass title

83+ args = P.typeClassArguments tcd

84+ superclasses = P.typeClassSuperclasses tcd

85+ fundeps = convertFundepsToStrings args (P.typeClassDependencies tcd)

86+ in

87+ TypeClassDeclaration args superclasses fundeps

88+ }

89+

90+kindType :: Declaration

91+kindType = primKind "Type" $ T.unlines

92+ [ "`Type` (also known as `*`) is the kind of all proper types: those that"

93+ , "classify value-level terms."

94+ , "For example the type `Boolean` has kind `Type`; denoted by `Boolean :: Type`."

95+ ]

96+

97+kindEffect :: Declaration

98+kindEffect = primKind "Effect" $ T.unlines

99+ [ "`Effect` (also known as `!`) is the kind of all effect types."

100+ ]

101+

102+kindSymbol :: Declaration

103+kindSymbol = primKind "Symbol" $ T.unlines

104+ [ "`Symbol` is the kind of type-level strings."

105+ , ""

106+ , "Construct types of this kind using the same literal syntax as documented"

107+ , "for strings."

108+ ]

109+

110+function :: Declaration

111+function = primType "Function" $ T.unlines

112+ [ "A function, which takes values of the type specified by the first type"

113+ , "parameter, and returns values of the type specified by the second."

114+ , "In the JavaScript backend, this is a standard JavaScript Function."

115+ , ""

116+ , "The type constructor `(->)` is syntactic sugar for this type constructor."

117+ , "It is recommended to use `(->)` rather than `Function`, where possible."

118+ , ""

119+ , "That is, prefer this:"

120+ , ""

121+ , " f :: Number -> Number"

122+ , ""

123+ , "to either of these:"

124+ , ""

125+ , " f :: Function Number Number"

126+ , " f :: (->) Number Number"

127+ ]

128+

129+array :: Declaration

130+array = primType "Array" $ T.unlines

131+ [ "An Array: a data structure supporting efficient random access. In"

132+ , "the JavaScript backend, values of this type are represented as JavaScript"

133+ , "Arrays at runtime."

134+ , ""

135+ , "Construct values using literals:"

136+ , ""

137+ , " x = [1,2,3,4,5] :: Array Int"

138+ ]

139+

140+record :: Declaration

141+record = primType "Record" $ T.unlines

142+ [ "The type of records whose fields are known at compile time. In the"

143+ , "JavaScript backend, values of this type are represented as JavaScript"

144+ , "Objects at runtime."

145+ , ""

146+ , "The type signature here means that the `Record` type constructor takes"

147+ , "a row of concrete types. For example:"

148+ , ""

149+ , " type Person = Record (name :: String, age :: Number)"

150+ , ""

151+ , "The syntactic sugar with curly braces `{ }` is generally preferred, though:"

152+ , ""

153+ , " type Person = { name :: String, age :: Number }"

154+ ]

155+

156+number :: Declaration

157+number = primType "Number" $ T.unlines

158+ [ "A double precision floating point number (IEEE 754)."

159+ , ""

160+ , "Construct values of this type with literals:"

161+ , ""

162+ , " y = 35.23 :: Number"

163+ , " z = 1.224e6 :: Number"

164+ ]

165+

166+int :: Declaration

167+int = primType "Int" $ T.unlines

168+ [ "A 32-bit signed integer. See the purescript-integers package for details"

169+ , "of how this is accomplished when compiling to JavaScript."

170+ , ""

171+ , "Construct values of this type with literals:"

172+ , ""

173+ , " x = 23 :: Int"

174+ ]

175+

176+string :: Declaration

177+string = primType "String" $ T.unlines

178+ [ "A String. As in JavaScript, String values represent sequences of UTF-16"

179+ , "code units, which are not required to form a valid encoding of Unicode"

180+ , "text (for example, lone surrogates are permitted)."

181+ , ""

182+ , "Construct values of this type with literals, using double quotes `\"`:"

183+ , ""

184+ , " x = \"hello, world\" :: String"

185+ , ""

186+ , "Multi-line string literals are also supported with triple quotes (`\"\"\"`)."

187+ ]

188+

189+char :: Declaration

190+char = primType "Char" $ T.unlines

191+ [ "A single character (UTF-16 code unit). The JavaScript representation is a"

192+ , "normal String, which is guaranteed to contain one code unit. This means"

193+ , "that astral plane characters (i.e. those with code point values greater"

194+ , "than 0xFFFF) cannot be represented as Char values."

195+ , ""

196+ , "Construct values of this type with literals, using single quotes `'`:"

197+ , ""

198+ , " x = 'a' :: Char"

199+ ]

200+

201+boolean :: Declaration

202+boolean = primType "Boolean" $ T.unlines

203+ [ "A JavaScript Boolean value."

204+ , ""

205+ , "Construct values of this type with the literals `true` and `false`."

206+ ]

207+

208+partial :: Declaration

209+partial = primClass "Partial" $ T.unlines

210+ [ "The Partial type class is used to indicate that a function is *partial,*"

211+ , "that is, it is not defined for all inputs. In practice, attempting to use"

212+ , "a partial function with a bad input will usually cause an error to be"

213+ , "thrown, although it is not safe to assume that this will happen in all"

214+ , "cases. For more information, see"

215+ , "[the Partial type class guide](https://github.com/purescript/documentation/blob/master/guides/The-Partial-type-class.md)."

216+ ]

217+

218+fail :: Declaration

219+fail = primClass "Fail" $ T.unlines

220+ [ "The Fail type class is part of the custom type errors feature. To provide"

221+ , "a custom type error when someone tries to use a particular instance,"

222+ , "write that instance out with a Fail constraint."

223+ , ""

224+ , "For more information, see"

225+ , "[the Custom Type Errors guide](https://github.com/purescript/documentation/blob/master/guides/Custom-Type-Errors.md)."

226+ ]

227+

228+typeConcat :: Declaration

229+typeConcat = primType "TypeConcat" $ T.unlines

230+ [ "The TypeConcat type constructor concatenates two Symbols in a custom type"

231+ , "error."

232+ , ""

233+ , "For more information, see"

234+ , "[the Custom Type Errors guide](https://github.com/purescript/documentation/blob/master/guides/Custom-Type-Errors.md)."

235+ ]

236+

237+typeString :: Declaration

238+typeString = primType "TypeString" $ T.unlines

239+ [ "The TypeString type constructor renders any concrete type into a Symbol"

240+ , "in a custom type error."

241+ , ""

242+ , "For more information, see"

243+ , "[the Custom Type Errors guide](https://github.com/purescript/documentation/blob/master/guides/Custom-Type-Errors.md)."

244+ ]

src/Language/PureScript/Docs/Render.hs+18−16

@@ -13,16 +13,14 @@ import Prelude.Compat

1313

1414import Data.Maybe (maybeToList)

1515import Data.Monoid ((<>))

16−import qualified Data.Text as T

1716import Data.Text (Text)

17+import qualified Data.Text as T

1818

1919import Language.PureScript.Docs.RenderedCode

2020import Language.PureScript.Docs.Types

2121import Language.PureScript.Docs.Utils.MonoidExtras

2222import qualified Language.PureScript as P

2323

24−-- TODO (Christoph): get rid of T.unpack's

25−

2624renderDeclaration :: Declaration -> RenderedCode

2725renderDeclaration = renderDeclarationWithOptions defaultRenderTypeOptions

2826

@@ -35,7 +33,7 @@ renderDeclarationWithOptions opts Declaration{..} =

3533 , renderType' ty

3634 ]

3735 DataDeclaration dtype args ->

38− [ keyword (T.unpack (P.showDataDeclType dtype))

36+ [ keyword (P.showDataDeclType dtype)

3937 , renderType' (typeApp declTitle args)

4038 ]

4139 ExternDataDeclaration kind' ->

@@ -76,20 +74,25 @@ renderDeclarationWithOptions opts Declaration{..} =

7674

7775 AliasDeclaration (P.Fixity associativity precedence) for@(P.Qualified _ alias) ->

7876 [ keywordFixity associativity

79− , syntax $ show precedence

77+ , syntax $ T.pack $ show precedence

8078 , ident $ renderQualAlias for

8179 , keyword "as"

8280 , ident $ adjustAliasName alias declTitle

8381 ]

8482

83+ ExternKindDeclaration ->

84+ [ keywordKind

85+ , renderKind (P.NamedKind (notQualified declTitle))

86+ ]

87+

8588 where

8689 renderType' :: P.Type -> RenderedCode

8790 renderType' = renderTypeWithOptions opts

8891

89− renderQualAlias :: FixityAlias -> String

92+ renderQualAlias :: FixityAlias -> Text

9093 renderQualAlias (P.Qualified mn alias)

91− | mn == currentModule opts = T.unpack (renderAlias id alias)

92− | otherwise = T.unpack (renderAlias (\f -> P.showQualified f . P.Qualified mn) alias)

94+ | mn == currentModule opts = renderAlias id alias

95+ | otherwise = renderAlias (\f -> P.showQualified f . P.Qualified mn) alias

9396

9497 renderAlias

9598 :: (forall a. (a -> Text) -> a -> Text)

@@ -99,8 +102,7 @@ renderDeclarationWithOptions opts Declaration{..} =

99102 = either (("type " <>) . f P.runProperName)

100103 $ either (f P.runIdent) (f P.runProperName)

101104

102− -- adjustAliasName (P.AliasType{}) title = drop 6 (init title)

103− adjustAliasName _ title = tail (init title)

105+ adjustAliasName _ title = T.tail (T.init title)

104106

105107renderChildDeclaration :: ChildDeclaration -> RenderedCode

106108renderChildDeclaration = renderChildDeclarationWithOptions defaultRenderTypeOptions

@@ -146,15 +148,15 @@ renderConstraintsWithOptions opts constraints

146148 mintersperse (syntax "," <> sp)

147149 (map (renderConstraintWithOptions opts) constraints)

148150

149−notQualified :: String -> P.Qualified (P.ProperName a)

150−notQualified = P.Qualified Nothing . P.ProperName . T.pack

151+notQualified :: Text -> P.Qualified (P.ProperName a)

152+notQualified = P.Qualified Nothing . P.ProperName

151153

152−typeApp :: String -> [(String, Maybe P.Kind)] -> P.Type

154+typeApp :: Text -> [(Text, Maybe P.Kind)] -> P.Type

153155typeApp title typeArgs =

154156 foldl P.TypeApp

155157 (P.TypeConstructor (notQualified title))

156158 (map toTypeVar typeArgs)

157159

158−toTypeVar :: (String, Maybe P.Kind) -> P.Type

159−toTypeVar (s, Nothing) = P.TypeVar (T.pack s)

160−toTypeVar (s, Just k) = P.KindedType (P.TypeVar (T.pack s)) k

160+toTypeVar :: (Text, Maybe P.Kind) -> P.Type

161+toTypeVar (s, Nothing) = P.TypeVar s

162+toTypeVar (s, Just k) = P.KindedType (P.TypeVar s) k

src/Language/PureScript/Docs/RenderedCode/Render.hs+10−13

@@ -14,10 +14,9 @@ import Prelude.Compat

1414

1515import Data.Maybe (fromMaybe)

1616import Data.Monoid ((<>))

17−import qualified Data.Text as T

1817import Data.Text (Text)

1918

20−import Control.Arrow ((<+>), first)

19+import Control.Arrow ((<+>))

2120import Control.PatternArrows as PA

2221

2322import Language.PureScript.Crash

@@ -35,7 +34,7 @@ typeLiterals = mkPattern match

3534 match TypeWildcard{} =

3635 Just (syntax "_")

3736 match (TypeVar var) =

38− Just (ident (T.unpack var))

37+ Just (ident var)

3938 match (PrettyPrintObject row) =

4039 Just $ mintersperse sp

4140 [ syntax "{"

@@ -43,7 +42,7 @@ typeLiterals = mkPattern match

4342 , syntax "}"

4443 ]

4544 match (TypeConstructor (Qualified mn name)) =

46− Just (ctor (T.unpack (runProperName name)) (maybeToContainingModule mn))

45+ Just (ctor (runProperName name) (maybeToContainingModule mn))

4746 match REmpty =

4847 Just (syntax "()")

4948 match row@RCons{} =

@@ -51,7 +50,7 @@ typeLiterals = mkPattern match

5150 match (BinaryNoParensType op l r) =

5251 Just $ renderTypeAtom l <> sp <> renderTypeAtom op <> sp <> renderTypeAtom r

5352 match (TypeOp (Qualified mn op)) =

54− Just (ident' (T.unpack (runOpName op)) (maybeToContainingModule mn))

53+ Just (ident' (runOpName op) (maybeToContainingModule mn))

5554 match _ =

5655 Nothing

5756

@@ -76,16 +75,14 @@ renderConstraints deps ty =

7675-- Render code representing a Row

7776--

7877renderRow :: Type -> RenderedCode

79−renderRow = uncurry renderRow' . convertString . rowToList

78+renderRow = uncurry renderRow' . rowToList

8079 where

81− convertString :: ([(Text, Type)], Type) -> ([(String, Type)], Type)

82− convertString = first (map (first T.unpack))

8380 renderRow' h t = renderHead h <> renderTail t

8481

85−renderHead :: [(String, Type)] -> RenderedCode

82+renderHead :: [(Text, Type)] -> RenderedCode

8683renderHead = mintersperse (syntax "," <> sp) . map renderLabel

8784

88−renderLabel :: (String, Type) -> RenderedCode

85+renderLabel :: (Text, Type) -> RenderedCode

8986renderLabel (label, ty) =

9087 mintersperse sp

9188 [ ident label

@@ -145,10 +142,10 @@ matchType = buildPrettyPrinter operators matchTypeAtom

145142 , [ Wrap explicitParens $ \_ ty -> ty ]

146143 ]

147144

148−forall_ :: Pattern () Type ([String], Type)

145+forall_ :: Pattern () Type ([Text], Type)

149146forall_ = mkPattern match

150147 where

151− match (PrettyPrintForAll idents ty) = Just (map T.unpack idents, ty)

148+ match (PrettyPrintForAll idents ty) = Just (idents, ty)

152149 match _ = Nothing

153150

154151insertPlaceholders :: RenderTypeOptions -> Type -> Type

@@ -180,7 +177,7 @@ preprocessType opts = dePrim . insertPlaceholders opts

180177-- Render code representing a Kind

181178--

182179renderKind :: Kind -> RenderedCode

183−renderKind = kind . T.unpack . prettyPrintKind

180+renderKind = kind . prettyPrintKind

184181

185182-- |

186183-- Render code representing a Type, as it should appear inside parentheses

src/Language/PureScript/Docs/RenderedCode/Types.hs+25−21

@@ -29,6 +29,7 @@ module Language.PureScript.Docs.RenderedCode.Types

2929 , keywordInstance

3030 , keywordWhere

3131 , keywordFixity

32+ , keywordKind

3233 ) where

3334

3435import Prelude.Compat

@@ -37,7 +38,7 @@ import Control.Monad.Error.Class (MonadError(..))

3738

3839import Data.Aeson.BetterErrors

3940import qualified Data.Aeson as A

40−import qualified Data.Text as T

41+import Data.Text (Text)

4142

4243import qualified Language.PureScript as P

4344

@@ -46,11 +47,11 @@ import qualified Language.PureScript as P

4647-- multiple output formats. For example, plain text, or highlighted HTML.

4748--

4849data RenderedCodeElement

49− = Syntax String

50− | Ident String ContainingModule

51− | Ctor String ContainingModule

52− | Kind String

53− | Keyword String

50+ = Syntax Text

51+ | Ident Text ContainingModule

52+ | Ctor Text ContainingModule

53+ | Kind Text

54+ | Keyword Text

5455 | Space

5556 deriving (Show, Eq, Ord)

5657

@@ -66,9 +67,9 @@ instance A.ToJSON RenderedCodeElement where

6667 toJSON (Keyword str) =

6768 A.toJSON ["keyword", str]

6869 toJSON Space =

69− A.toJSON ["space" :: String]

70+ A.toJSON ["space" :: Text]

7071

71−asRenderedCodeElement :: Parse String RenderedCodeElement

72+asRenderedCodeElement :: Parse Text RenderedCodeElement

7273asRenderedCodeElement =

7374 a Syntax "syntax" <|>

7475 asIdent <|>

@@ -80,14 +81,14 @@ asRenderedCodeElement =

8081 where

8182 p <|> q = catchError p (const q)

8283

83− a ctor' ctorStr = ctor' <$> (nth 0 (withString (eq ctorStr)) *> nth 1 asString)

84− asIdent = nth 0 (withString (eq "ident")) *> (Ident <$> nth 1 asString <*> nth 2 asContainingModule)

85− asCtor = nth 0 (withString (eq "ctor")) *> (Ctor <$> nth 1 asString <*> nth 2 asContainingModule)

86− asSpace = nth 0 (withString (eq "space")) *> pure Space

84+ a ctor' ctorStr = ctor' <$> (nth 0 (withText (eq ctorStr)) *> nth 1 asText)

85+ asIdent = nth 0 (withText (eq "ident")) *> (Ident <$> nth 1 asText <*> nth 2 asContainingModule)

86+ asCtor = nth 0 (withText (eq "ctor")) *> (Ctor <$> nth 1 asText <*> nth 2 asContainingModule)

87+ asSpace = nth 0 (withText (eq "space")) *> pure Space

8788

8889 eq s s' = if s == s' then Right () else Left ""

8990

90− unableToParse = withString (Left . show)

91+ unableToParse = withText Left

9192

9293-- |

9394-- This type is isomorphic to 'Maybe' 'P.ModuleName'. It makes code a bit easier

@@ -103,7 +104,7 @@ instance A.ToJSON ContainingModule where

103104

104105asContainingModule :: Parse e ContainingModule

105106asContainingModule =

106− maybeToContainingModule <$> perhaps (P.moduleNameFromString . T.pack <$> asString)

107+ maybeToContainingModule <$> perhaps (P.moduleNameFromString <$> asText)

107108

108109-- |

109110-- Convert a 'Maybe' 'P.ModuleName' to a 'ContainingModule', using the obvious

@@ -139,7 +140,7 @@ newtype RenderedCode

139140instance A.ToJSON RenderedCode where

140141 toJSON (RC elems) = A.toJSON elems

141142

142−asRenderedCode :: Parse String RenderedCode

143+asRenderedCode :: Parse Text RenderedCode

143144asRenderedCode = RC <$> eachInArray asRenderedCodeElement

144145

145146-- |

@@ -157,22 +158,22 @@ outputWith f = foldMap f . unRC

157158sp :: RenderedCode

158159sp = RC [Space]

159160

160−syntax :: String -> RenderedCode

161+syntax :: Text -> RenderedCode

161162syntax x = RC [Syntax x]

162163

163−ident :: String -> RenderedCode

164+ident :: Text -> RenderedCode

164165ident x = RC [Ident x ThisModule]

165166

166−ident' :: String -> ContainingModule -> RenderedCode

167+ident' :: Text -> ContainingModule -> RenderedCode

167168ident' x m = RC [Ident x m]

168169

169−ctor :: String -> ContainingModule -> RenderedCode

170+ctor :: Text -> ContainingModule -> RenderedCode

170171ctor x m = RC [Ctor x m]

171172

172−kind :: String -> RenderedCode

173+kind :: Text -> RenderedCode

173174kind x = RC [Kind x]

174175

175−keyword :: String -> RenderedCode

176+keyword :: Text -> RenderedCode

176177keyword kw = RC [Keyword kw]

177178

178179keywordForall :: RenderedCode

@@ -200,3 +201,6 @@ keywordFixity :: P.Associativity -> RenderedCode

200201keywordFixity P.Infixl = keyword "infixl"

201202keywordFixity P.Infixr = keyword "infixr"

202203keywordFixity P.Infix = keyword "infix"

204+

205+keywordKind :: RenderedCode

206+keywordKind = keyword "kind"

src/Language/PureScript/Docs/Types.hs+89−43

@@ -8,14 +8,16 @@ import Prelude.Compat

99import Control.Arrow (first, (***))

1010import Control.Monad (when)

11+import Control.Monad.Error.Class (catchError)

1112

1213import Data.Aeson ((.=))

1314import Data.Aeson.BetterErrors

1415import Data.ByteString.Lazy (ByteString)

1516import Data.Either (isLeft, isRight)

16−import Data.Maybe (mapMaybe)

17+import Data.Maybe (mapMaybe, fromMaybe)

1718import Data.Text (Text)

1819import Data.Version

20+import qualified Data.Vector as V

1921import qualified Data.Aeson as A

2022import qualified Data.Text as T

2123

@@ -36,7 +38,7 @@ import Language.PureScript.Docs.RenderedCode as ReExports

3638data Package a = Package

3739 { pkgMeta :: PackageMeta

3840 , pkgVersion :: Version

39− , pkgVersionTag :: String

41+ , pkgVersionTag :: Text

4042 , pkgModules :: [Module]

4143 , pkgBookmarks :: [Bookmark]

4244 , pkgResolvedDependencies :: [(PackageName, Version)]

@@ -71,16 +73,16 @@ packageName = bowerName . pkgMeta

7173

7274data Module = Module

7375 { modName :: P.ModuleName

74− , modComments :: Maybe String

76+ , modComments :: Maybe Text

7577 , modDeclarations :: [Declaration]

7678 -- Re-exported values from other modules

77− , modReExports :: [(P.ModuleName, [Declaration])]

79+ , modReExports :: [(InPackage P.ModuleName, [Declaration])]

7880 }

7981 deriving (Show, Eq, Ord)

8082

8183data Declaration = Declaration

82− { declTitle :: String

83− , declComments :: Maybe String

84+ { declTitle :: Text

85+ , declComments :: Maybe Text

8486 , declSourceSpan :: Maybe P.SourceSpan

8587 , declChildren :: [ChildDeclaration]

8688 , declInfo :: DeclarationInfo

@@ -107,7 +109,7 @@ data DeclarationInfo

107109 -- newtype) and its type arguments. Constructors are represented as child

108110 -- declarations.

109111 --

110− | DataDeclaration P.DataDeclType [(String, Maybe P.Kind)]

112+ | DataDeclaration P.DataDeclType [(Text, Maybe P.Kind)]

111113

112114 -- |

113115 -- A data type foreign import, with its kind.

@@ -117,30 +119,54 @@ data DeclarationInfo

117119 -- |

118120 -- A type synonym, with its type arguments and its type.

119121 --

120− | TypeSynonymDeclaration [(String, Maybe P.Kind)] P.Type

122+ | TypeSynonymDeclaration [(Text, Maybe P.Kind)] P.Type

121123

122124 -- |

123125 -- A type class, with its type arguments, its superclasses and functional

124126 -- dependencies. Instances and members are represented as child declarations.

125127 --

126− | TypeClassDeclaration [(String, Maybe P.Kind)] [P.Constraint] [([String], [String])]

128+ | TypeClassDeclaration [(Text, Maybe P.Kind)] [P.Constraint] [([Text], [Text])]

127129

128130 -- |

129131 -- An operator alias declaration, with the member the alias is for and the

130132 -- operator's fixity.

131133 --

132134 | AliasDeclaration P.Fixity FixityAlias

135+

136+ -- |

137+ -- A kind declaration

138+ --

139+ | ExternKindDeclaration

133140 deriving (Show, Eq, Ord)

134141

142+convertFundepsToStrings :: [(Text, Maybe P.Kind)] -> [P.FunctionalDependency] -> [([Text], [Text])]

143+convertFundepsToStrings args fundeps =

144+ map (\(P.FunctionalDependency from to) -> toArgs from to) fundeps

145+ where

146+ argsVec = V.fromList (map fst args)

147+ getArg i =

148+ fromMaybe

149+ (P.internalError $ unlines

150+ [ "convertDeclaration: Functional dependency index"

151+ , show i

152+ , "is bigger than arguments list"

153+ , show (map fst args)

154+ , "Functional dependencies are"

155+ , show fundeps

156+ ]

157+ ) $ argsVec V.!? i

158+ toArgs from to = (map getArg from, map getArg to)

159+

135160type FixityAlias = P.Qualified (Either (P.ProperName 'P.TypeName) (Either P.Ident (P.ProperName 'P.ConstructorName)))

136161

137−declInfoToString :: DeclarationInfo -> String

162+declInfoToString :: DeclarationInfo -> Text

138163declInfoToString (ValueDeclaration _) = "value"

139164declInfoToString (DataDeclaration _ _) = "data"

140165declInfoToString (ExternDataDeclaration _) = "externData"

141166declInfoToString (TypeSynonymDeclaration _ _) = "typeSynonym"

142167declInfoToString (TypeClassDeclaration _ _ _) = "typeClass"

143168declInfoToString (AliasDeclaration _ _) = "alias"

169+declInfoToString ExternKindDeclaration = "kind"

144170

145171isTypeClass :: Declaration -> Bool

146172isTypeClass Declaration{..} =

@@ -174,14 +200,20 @@ isTypeAlias Declaration{..} =

174200 AliasDeclaration _ (P.Qualified _ d) -> isLeft d

175201 _ -> False

176202

203+isKind :: Declaration -> Bool

204+isKind Declaration{..} =

205+ case declInfo of

206+ ExternKindDeclaration{} -> True

207+ _ -> False

208+

177209-- | Discard any children which do not satisfy the given predicate.

178210filterChildren :: (ChildDeclaration -> Bool) -> Declaration -> Declaration

179211filterChildren p decl =

180212 decl { declChildren = filter p (declChildren decl) }

181213

182214data ChildDeclaration = ChildDeclaration

183− { cdeclTitle :: String

184− , cdeclComments :: Maybe String

215+ { cdeclTitle :: Text

216+ , cdeclComments :: Maybe Text

185217 , cdeclSourceSpan :: Maybe P.SourceSpan

186218 , cdeclInfo :: ChildDeclarationInfo

187219 }

@@ -206,7 +238,7 @@ data ChildDeclarationInfo

206238 | ChildTypeClassMember P.Type

207239 deriving (Show, Eq, Ord)

208240

209−childDeclInfoToString :: ChildDeclarationInfo -> String

241+childDeclInfoToString :: ChildDeclarationInfo -> Text

210242childDeclInfoToString (ChildInstance _ _) = "instance"

211243childDeclInfoToString (ChildDataConstructor _) = "dataConstructor"

212244childDeclInfoToString (ChildTypeClassMember _) = "typeClassMember"

@@ -224,11 +256,11 @@ isDataConstructor ChildDeclaration{..} =

224256 _ -> False

225257

226258newtype GithubUser

227− = GithubUser { runGithubUser :: String }

259+ = GithubUser { runGithubUser :: Text }

228260 deriving (Show, Eq, Ord)

229261

230262newtype GithubRepo

231− = GithubRepo { runGithubRepo :: String }

263+ = GithubRepo { runGithubRepo :: Text }

232264 deriving (Show, Eq, Ord)

233265

234266data PackageError

@@ -237,14 +269,14 @@ data PackageError

237269 -- parser, and actual version used.

238270 | ErrorInPackageMeta BowerError

239271 | InvalidVersion

240− | InvalidDeclarationType String

241− | InvalidChildDeclarationType String

272+ | InvalidDeclarationType Text

273+ | InvalidChildDeclarationType Text

242274 | InvalidFixity

243− | InvalidKind String

244− | InvalidDataDeclType String

275+ | InvalidKind Text

276+ | InvalidDataDeclType Text

245277 deriving (Show, Eq, Ord)

246278

247−type Bookmark = InPackage (P.ModuleName, String)

279+type Bookmark = InPackage (P.ModuleName, Text)

248280

249281data InPackage a

250282 = Local a

@@ -286,7 +318,7 @@ asPackage minimumVersion uploader = do

286318

287319 Package <$> key "packageMeta" asPackageMeta .! ErrorInPackageMeta

288320 <*> key "version" asVersion

289− <*> key "versionTag" asString

321+ <*> key "versionTag" asText

290322 <*> key "modules" (eachInArray asModule)

291323 <*> key "bookmarks" asBookmarks .! ErrorInPackageMeta

292324 <*> key "resolvedDependencies" asResolvedDependencies

@@ -317,15 +349,15 @@ displayPackageError e = case e of

317349 InvalidVersion ->

318350 "Invalid version"

319351 InvalidDeclarationType str ->

320− "Invalid declaration type: \"" <> T.pack str <> "\""

352+ "Invalid declaration type: \"" <> str <> "\""

321353 InvalidChildDeclarationType str ->

322− "Invalid child declaration type: \"" <> T.pack str <> "\""

354+ "Invalid child declaration type: \"" <> str <> "\""

323355 InvalidFixity ->

324356 "Invalid fixity"

325357 InvalidKind str ->

326− "Invalid kind: \"" <> T.pack str <> "\""

358+ "Invalid kind: \"" <> str <> "\""

327359 InvalidDataDeclType str ->

328− "Invalid data declaration type: \"" <> T.pack str <> "\""

360+ "Invalid data declaration type: \"" <> str <> "\""

329361 where

330362 (<>) = T.append

331363

@@ -334,7 +366,7 @@ instance A.FromJSON a => A.FromJSON (Package a) where

334366 (asPackage (Version [0,0,0,0] []) fromAesonParser)

335367

336368asGithubUser :: Parse e GithubUser

337−asGithubUser = GithubUser <$> asString

369+asGithubUser = GithubUser <$> asText

338370

339371instance A.FromJSON GithubUser where

340372 parseJSON = toAesonParser' asGithubUser

@@ -351,22 +383,33 @@ parseVersion' str =

351383asModule :: Parse PackageError Module

352384asModule =

353385 Module <$> key "name" (P.moduleNameFromString <$> asText)

354− <*> key "comments" (perhaps asString)

386+ <*> key "comments" (perhaps asText)

355387 <*> key "declarations" (eachInArray asDeclaration)

356388 <*> key "reExports" (eachInArray asReExport)

357389

358390asDeclaration :: Parse PackageError Declaration

359391asDeclaration =

360− Declaration <$> key "title" asString

361− <*> key "comments" (perhaps asString)

392+ Declaration <$> key "title" asText

393+ <*> key "comments" (perhaps asText)

362394 <*> key "sourceSpan" (perhaps asSourceSpan)

363395 <*> key "children" (eachInArray asChildDeclaration)

364396 <*> key "info" asDeclarationInfo

365397

366−asReExport :: Parse PackageError (P.ModuleName, [Declaration])

398+asReExport :: Parse PackageError (InPackage P.ModuleName, [Declaration])

367399asReExport =

368− (,) <$> key "moduleName" fromAesonParser

400+ (,) <$> key "moduleName" asReExportModuleName

369401 <*> key "declarations" (eachInArray asDeclaration)

402+ where

403+ -- This is to preserve backwards compatibility with 0.10.3 and earlier versions

404+ -- of the compiler, where the modReExports field had the type

405+ -- [(P.ModuleName, [Declaration])]. This should eventually be removed,

406+ -- possibly at the same time as the next breaking change to this JSON format.

407+ asReExportModuleName :: Parse PackageError (InPackage P.ModuleName)

408+ asReExportModuleName =

409+ asInPackage fromAesonParser .! ErrorInPackageMeta

410+ <|> fmap Local fromAesonParser

411+

412+ (<|>) p q = catchError p (const q)

370413

371414asInPackage :: Parse BowerError a -> Parse BowerError (InPackage a)

372415asInPackage inner =

@@ -396,7 +439,7 @@ asAssociativity = withString (maybe (Left InvalidFixity) Right . parseAssociativ

396439

397440asDeclarationInfo :: Parse PackageError DeclarationInfo

398441asDeclarationInfo = do

399− ty <- key "declType" asString

442+ ty <- key "declType" asText

400443 case ty of

401444 "value" ->

402445 ValueDeclaration <$> key "type" asType

@@ -415,13 +458,15 @@ asDeclarationInfo = do

415458 "alias" ->

416459 AliasDeclaration <$> key "fixity" asFixity

417460 <*> key "alias" asFixityAlias

461+ "kind" ->

462+ pure ExternKindDeclaration

418463 other ->

419464 throwCustomError (InvalidDeclarationType other)

420465

421−asTypeArguments :: Parse PackageError [(String, Maybe P.Kind)]

466+asTypeArguments :: Parse PackageError [(Text, Maybe P.Kind)]

422467asTypeArguments = eachInArray asTypeArgument

423468 where

424− asTypeArgument = (,) <$> nth 0 asString <*> nth 1 (perhaps asKind)

469+ asTypeArgument = (,) <$> nth 0 asText <*> nth 1 (perhaps asKind)

425470

426471asKind :: Parse e P.Kind

427472asKind = fromAesonParser

@@ -429,28 +474,28 @@ asKind = fromAesonParser

429474asType :: Parse e P.Type

430475asType = fromAesonParser

431476

432−asFunDeps :: Parse PackageError [([String], [String])]

477+asFunDeps :: Parse PackageError [([Text], [Text])]

433478asFunDeps = eachInArray asFunDep

434479 where

435− asFunDep = (,) <$> nth 0 (eachInArray asString) <*> nth 1 (eachInArray asString)

480+ asFunDep = (,) <$> nth 0 (eachInArray asText) <*> nth 1 (eachInArray asText)

436481

437482asDataDeclType :: Parse PackageError P.DataDeclType

438483asDataDeclType =

439− withString $ \s -> case s of

484+ withText $ \s -> case s of

440485 "data" -> Right P.Data

441486 "newtype" -> Right P.Newtype

442487 other -> Left (InvalidDataDeclType other)

443488

444489asChildDeclaration :: Parse PackageError ChildDeclaration

445490asChildDeclaration =

446− ChildDeclaration <$> key "title" asString

447− <*> key "comments" (perhaps asString)

491+ ChildDeclaration <$> key "title" asText

492+ <*> key "comments" (perhaps asText)

448493 <*> key "sourceSpan" (perhaps asSourceSpan)

449494 <*> key "info" asChildDeclarationInfo

450495

451496asChildDeclarationInfo :: Parse PackageError ChildDeclarationInfo

452497asChildDeclarationInfo = do

453− ty <- key "declType" asString

498+ ty <- key "declType" asText

454499 case ty of

455500 "instance" ->

456501 ChildInstance <$> key "dependencies" (eachInArray asConstraint)

@@ -483,7 +528,7 @@ asBookmarks = eachInArray asBookmark

483528asBookmark :: Parse BowerError Bookmark

484529asBookmark =

485530 asInPackage ((,) <$> nth 0 (P.moduleNameFromString <$> asText)

486− <*> nth 1 asString)

531+ <*> nth 1 asText)

487532

488533asResolvedDependencies :: Parse PackageError [(PackageName, Version)]

489534asResolvedDependencies =

@@ -493,8 +538,8 @@ asResolvedDependencies =

493538 mapLeft _ (Right x) = Right x

494539

495540asGithub :: Parse e (GithubUser, GithubRepo)

496−asGithub = (,) <$> nth 0 (GithubUser <$> asString)

497− <*> nth 1 (GithubRepo <$> asString)

541+asGithub = (,) <$> nth 0 (GithubUser <$> asText)

542+ <*> nth 1 (GithubRepo <$> asText)

498543

499544asSourceSpan :: Parse e P.SourceSpan

500545asSourceSpan = P.SourceSpan <$> key "name" asString

@@ -562,6 +607,7 @@ instance A.ToJSON DeclarationInfo where

562607 TypeSynonymDeclaration args ty -> ["arguments" .= args, "type" .= ty]

563608 TypeClassDeclaration args super fundeps -> ["arguments" .= args, "superclasses" .= super, "fundeps" .= fundeps]

564609 AliasDeclaration fixity alias -> ["fixity" .= fixity, "alias" .= alias]

610+ ExternKindDeclaration -> []

565611

566612instance A.ToJSON ChildDeclarationInfo where

567613 toJSON info = A.object $ "declType" .= childDeclInfoToString info : props

src/Language/PureScript/Environment.hs+83−23

@@ -8,11 +8,13 @@ import Data.Aeson.TH

88import qualified Data.Aeson as A

99import qualified Data.Map as M

1010import qualified Data.Set as S

11−import Data.Maybe (fromMaybe)

11+import Data.Maybe (fromMaybe, mapMaybe)

1212import Data.Text (Text)

1313import qualified Data.Text as T

1414import Data.List (nub)

15+import Data.Tree (Tree, rootLabel)

1516import qualified Data.Graph as G

17+import Data.Foldable (toList)

1618

1719import Language.PureScript.Crash

1820import Language.PureScript.Kinds

@@ -36,6 +38,8 @@ data Environment = Environment

3638 -- ^ Available type class dictionaries

3739 , typeClasses :: M.Map (Qualified (ProperName 'ClassName)) TypeClassData

3840 -- ^ Type classes

41+ , kinds :: S.Set (Qualified (ProperName 'KindName))

42+ -- ^ Kinds in scope

3943 } deriving Show

4044

4145-- | Information about a type class

@@ -55,6 +59,8 @@ data TypeClassData = TypeClassData

5559 -- ^ A set of indexes of type argument that are fully determined by other

5660 -- arguments via functional dependencies. This can be computed from both

5761 -- typeClassArguments and typeClassDependencies.

62+ , typeClassCoveringSets :: S.Set (S.Set Int)

63+ -- ^ A sets of arguments that can be used to infer all other arguments.

5864 } deriving Show

5965

6066-- | A functional dependency indicates a relationship between two sets of

@@ -70,11 +76,14 @@ data FunctionalDependency = FunctionalDependency

7076-- The initial environment with no values and only the default javascript types defined

7177--

7278initEnvironment :: Environment

73−initEnvironment = Environment M.empty primTypes M.empty M.empty M.empty primClasses

79+initEnvironment = Environment M.empty primTypes M.empty M.empty M.empty primClasses primKinds

7480

7581-- |

76−-- A constructor for TypeClassData that computes which type class arguments are fully determined.

82+-- A constructor for TypeClassData that computes which type class arguments are fully determined

83+-- and argument covering sets.

7784-- Fully determined means that this argument cannot be used when selecting a type class instance.

85+-- A covering set is a minimal collection of arguments that can be used to find an instance and

86+-- therefore determine all other type arguments.

7887--

7988-- An example of the difference between determined and fully determined would be with the class:

8089-- ```class C a b c | a -> b, b -> a, b -> c```

@@ -82,7 +91,8 @@ initEnvironment = Environment M.empty primTypes M.empty M.empty M.empty primClas

8291-- Both `a` and `b` can be used in selecting a type class instance. However, `c` cannot - it is

8392-- fully determined by `a` and `b`.

8493--

85−-- Define a graph of type class arguments with edges being fundep determiners to determined.

94+-- Define a graph of type class arguments with edges being fundep determiners to determined. Each

95+-- argument also has a self looping edge.

8696-- An argument is fully determined if doesn't appear at the start of a path of strongly connected components.

8797-- An argument is not fully determined otherwise.

8898--

@@ -95,26 +105,51 @@ makeTypeClassData

95105 -> [Constraint]

96106 -> [FunctionalDependency]

97107 -> TypeClassData

98−makeTypeClassData args m s deps = TypeClassData args m s deps determinedArgs

108+makeTypeClassData args m s deps = TypeClassData args m s deps determinedArgs coveringSets

99109 where

110+ argumentIndicies = [0 .. length args - 1]

111+

112+ -- each argument determines themselves

113+ identities = (\i -> (i, [i])) <$> argumentIndicies

114+

100115 -- list all the edges in the graph: for each fundep an edge exists for each determiner to each determined

101− contributingDeps = M.fromListWith (++) $ do

116+ contributingDeps = M.fromListWith (++) $ identities ++ do

102117 fd <- deps

103118 src <- fdDeterminers fd

104119 (src, fdDetermined fd) : map (, []) (fdDetermined fd)

105120

106− -- here we build a graph of which arguments determine other arguments

107− (depGraph, _, fromKey) = G.graphFromEdges ((\(n, v) -> (n, n, nub v)) <$> M.toList contributingDeps)

121+ -- build a graph of which arguments determine other arguments

122+ (depGraph, fromVertex, fromKey) = G.graphFromEdges ((\(n, v) -> (n, n, nub v)) <$> M.toList contributingDeps)

108123

109124 -- do there exist any arguments that contribute to `arg` that `arg` doesn't contribute to

125+ isFunDepDetermined :: Int -> Bool

110126 isFunDepDetermined arg = case fromKey arg of

111− Nothing -> False -- not mentioned in fundeps

127+ Nothing -> internalError "Unknown argument index in makeTypeClassData"

112128 Just v -> let contributesToVar = G.reachable (G.transposeG depGraph) v

113129 varContributesTo = G.reachable depGraph v

114130 in any (\r -> not (r `elem` varContributesTo)) contributesToVar

115131

116132 -- find all the arguments that are determined

117− determinedArgs = S.fromList $ filter isFunDepDetermined [0 .. length args - 1]

133+ determinedArgs :: S.Set Int

134+ determinedArgs = S.fromList $ filter isFunDepDetermined argumentIndicies

135+

136+ argFromVertex :: G.Vertex -> Int

137+ argFromVertex index = let (_, arg, _) = fromVertex index in arg

138+

139+ isVertexDetermined :: G.Vertex -> Bool

140+ isVertexDetermined = isFunDepDetermined . argFromVertex

141+

142+ -- from an scc find the non-determined args

143+ sccNonDetermined :: Tree G.Vertex -> Maybe [Int]

144+ sccNonDetermined tree

145+ -- if any arg in an scc is determined then all of them are

146+ | isVertexDetermined (rootLabel tree) = Nothing

147+ | otherwise = Just (argFromVertex <$> toList tree)

148+

149+ -- find the covering sets

150+ coveringSets :: S.Set (S.Set Int)

151+ coveringSets = let funDepSets = sequence (mapMaybe sccNonDetermined (G.scc depGraph))

152+ in S.fromList (S.fromList <$> funDepSets)

118153

119154-- |

120155-- The visibility of a name in scope

@@ -209,6 +244,21 @@ instance A.FromJSON DataDeclType where

209244primName :: Text -> Qualified (ProperName a)

210245primName = Qualified (Just $ ModuleName [ProperName C.prim]) . ProperName

211246

247+primKind :: Text -> Kind

248+primKind = NamedKind . primName

249+

250+-- |

251+-- Kinds in prim

252+--

253+kindType :: Kind

254+kindType = primKind C.typ

255+

256+kindEffect :: Kind

257+kindEffect = primKind C.effect

258+

259+kindSymbol :: Kind

260+kindSymbol = primKind C.symbol

261+

212262-- |

213263-- Construct a type in the Prim module

214264--

@@ -285,6 +335,16 @@ isTypeOrApplied t1 t2 = t1 == t2

285335function :: Type -> Type -> Type

286336function t1 = TypeApp (TypeApp tyFunction t1)

287337

338+-- |

339+-- The primitive kinds

340+primKinds :: S.Set (Qualified (ProperName 'KindName))

341+primKinds =

342+ S.fromList

343+ [ primName C.typ

344+ , primName C.effect

345+ , primName C.symbol

346+ ]

347+

288348-- |

289349-- The primitive types in the external javascript environment with their

290350-- associated kinds. There are also pseudo `Fail` and `Partial` types

@@ -293,18 +353,18 @@ function t1 = TypeApp (TypeApp tyFunction t1)

293353primTypes :: M.Map (Qualified (ProperName 'TypeName)) (Kind, TypeKind)

294354primTypes =

295355 M.fromList

296− [ (primName "Function", (FunKind Star (FunKind Star Star), ExternData))

297− , (primName "Array", (FunKind Star Star, ExternData))

298− , (primName "Record", (FunKind (Row Star) Star, ExternData))

299− , (primName "String", (Star, ExternData))

300− , (primName "Char", (Star, ExternData))

301− , (primName "Number", (Star, ExternData))

302− , (primName "Int", (Star, ExternData))

303− , (primName "Boolean", (Star, ExternData))

304− , (primName "Partial", (Star, ExternData))

305− , (primName "Fail", (FunKind Symbol Star, ExternData))

306− , (primName "TypeString", (FunKind Star Symbol, ExternData))

307− , (primName "TypeConcat", (FunKind Symbol (FunKind Symbol Symbol), ExternData))

356+ [ (primName "Function", (FunKind kindType (FunKind kindType kindType), ExternData))

357+ , (primName "Array", (FunKind kindType kindType, ExternData))

358+ , (primName "Record", (FunKind (Row kindType) kindType, ExternData))

359+ , (primName "String", (kindType, ExternData))

360+ , (primName "Char", (kindType, ExternData))

361+ , (primName "Number", (kindType, ExternData))

362+ , (primName "Int", (kindType, ExternData))

363+ , (primName "Boolean", (kindType, ExternData))

364+ , (primName "Partial", (kindType, ExternData))

365+ , (primName "Fail", (FunKind kindSymbol kindType, ExternData))

366+ , (primName "TypeString", (FunKind kindType kindSymbol, ExternData))

367+ , (primName "TypeConcat", (FunKind kindSymbol (FunKind kindSymbol kindSymbol), ExternData))

308368 ]

309369

310370-- |

@@ -316,7 +376,7 @@ primClasses :: M.Map (Qualified (ProperName 'ClassName)) TypeClassData

316376primClasses =

317377 M.fromList

318378 [ (primName "Partial", (makeTypeClassData [] [] [] []))

319− , (primName "Fail", (makeTypeClassData [("message", Just Symbol)] [] [] []))

379+ , (primName "Fail", (makeTypeClassData [("message", Just kindSymbol)] [] [] []))

320380 ]

321381

322382-- |

src/Language/PureScript/Errors.hs+13−8

@@ -289,8 +289,8 @@ onTypesInErrorMessageM f (ErrorMessage hints simple) = ErrorMessage <$> traverse

289289 gTypeSearch (TSBefore env) = pure (TSBefore env)

290290 gTypeSearch (TSAfter result) = TSAfter <$> traverse (traverse f) result

291291

292−wikiUri :: ErrorMessage -> Text

293−wikiUri e = "https://github.com/purescript/purescript/wiki/Error-Code-" <> errorCode e

292+errorDocUri :: ErrorMessage -> Text

293+errorDocUri e = "https://github.com/purescript/documentation/blob/master/errors/" <> errorCode e <> ".md"

294294

295295-- TODO Other possible suggestions:

296296-- WildcardInferredType - source span not small enough

@@ -373,7 +373,7 @@ data PPEOptions = PPEOptions

373373 { ppeCodeColor :: Maybe (ANSI.ColorIntensity, ANSI.Color) -- ^ Color code with this color... or not

374374 , ppeFull :: Bool -- ^ Should write a full error message?

375375 , ppeLevel :: Level -- ^ Should this report an error or a warning?

376− , ppeShowWiki :: Bool -- ^ Should show a link to error message's wiki page?

376+ , ppeShowDocs :: Bool -- ^ Should show a link to error message's doc page?

377377 }

378378

379379-- | Default options for PPEOptions

@@ -382,7 +382,7 @@ defaultPPEOptions = PPEOptions

382382 { ppeCodeColor = Just defaultCodeColor

383383 , ppeFull = False

384384 , ppeLevel = Error

385− , ppeShowWiki = True

385+ , ppeShowDocs = True

386386 }

387387

388388

@@ -390,7 +390,7 @@ defaultPPEOptions = PPEOptions

390390-- Pretty print a single error, simplifying if necessary

391391--

392392prettyPrintSingleError :: PPEOptions -> ErrorMessage -> Box.Box

393−prettyPrintSingleError (PPEOptions codeColor full level showWiki) e = flip evalState defaultUnknownMap $ do

393+prettyPrintSingleError (PPEOptions codeColor full level showDocs) e = flip evalState defaultUnknownMap $ do

394394 em <- onTypesInErrorMessageM replaceUnknowns (if full then e else simplifyErrorMessage e)

395395 um <- get

396396 return (prettyPrintErrorMessage um em)

@@ -405,10 +405,10 @@ prettyPrintSingleError (PPEOptions codeColor full level showWiki) e = flip evalS

405405 ] ++

406406 maybe [] (return . Box.moveDown 1) typeInformation ++

407407 [ Box.moveDown 1 $ paras

408− [ line $ "See " <> wikiUri e <> " for more information, "

408+ [ line $ "See " <> errorDocUri e <> " for more information, "

409409 , line $ "or to contribute content related to this " <> levelText <> "."

410410 ]

411− | showWiki

411+ | showDocs

412412 ]

413413 where

414414 typeInformation :: Maybe Box.Box

@@ -716,7 +716,7 @@ prettyPrintSingleError (PPEOptions codeColor full level showWiki) e = flip evalS

716716 , Box.vcat Box.left (map typeAtomAsBox ts)

717717 ]

718718 , line "is an orphan instance."

719− , line "An orphan instance is an instance which is defined in neither the class module nor the data type module."

719+ , line "An orphan instance is one which is defined in a module that is unrelated to either the class or the collection of data types that the instance is defined for."

720720 , line "Consider moving the instance, if possible, or using a newtype wrapper."

721721 ]

722722 renderSimpleErrorMessage (InvalidNewtype name) =

@@ -1030,6 +1030,7 @@ prettyPrintSingleError (PPEOptions codeColor full level showWiki) e = flip evalS

10301030 nameType (DctorName _) = "data constructor"

10311031 nameType (TyClassName _) = "type class"

10321032 nameType (ModName _) = "module"

1033+ nameType (KiName _) = "kind"

10331034

10341035 runName :: Qualified Name -> Text

10351036 runName (Qualified mn (IdentName name)) =

@@ -1044,6 +1045,8 @@ prettyPrintSingleError (PPEOptions codeColor full level showWiki) e = flip evalS

10441045 showQualified runProperName (Qualified mn name)

10451046 runName (Qualified mn (TyClassName name)) =

10461047 showQualified runProperName (Qualified mn name)

1048+ runName (Qualified mn (KiName name)) =

1049+ showQualified runProperName (Qualified mn name)

10471050 runName (Qualified Nothing (ModName name)) =

10481051 runModuleName name

10491052 runName (Qualified _ ModName{}) =

@@ -1148,6 +1151,8 @@ prettyPrintRef (TypeInstanceRef ident) =

11481151 Just $ showIdent ident

11491152prettyPrintRef (ModuleRef name) =

11501153 Just $ "module " <> runModuleName name

1154+prettyPrintRef (KindRef pn) =

1155+ Just $ "kind " <> runProperName pn

11511156prettyPrintRef (ReExportRef _ _) =

11521157 Nothing

11531158prettyPrintRef (PositionedDeclarationRef _ _ ref) =

src/Language/PureScript/Errors/JSON.hs+1−1

@@ -52,7 +52,7 @@ toJSONError verbose level e =

5252 JSONError (toErrorPosition <$> sspan)

5353 (P.renderBox (P.prettyPrintSingleError (P.PPEOptions Nothing verbose level False) (P.stripModuleAndSpan e)))

5454 (P.errorCode e)

55− (P.wikiUri e)

55+ (P.errorDocUri e)

5656 (P.spanName <$> sspan)

5757 (P.runModuleName <$> P.errorModule e)

5858 (toSuggestion e)

src/Language/PureScript/Externs.hs+9

@@ -24,6 +24,7 @@ import Data.Text (Text)

2424import qualified Data.Text as T

2525import Data.Version (showVersion)

2626import qualified Data.Map as M

27+import qualified Data.Set as S

2728

2829import Language.PureScript.AST

2930import Language.PureScript.Crash

@@ -133,6 +134,10 @@ data ExternsDeclaration =

133134 , edInstanceTypes :: [Type]

134135 , edInstanceConstraints :: Maybe [Constraint]

135136 }

137+ -- | A kind declaration

138+ | EDKind

139+ { edKindName :: ProperName 'KindName

140+ }

136141 deriving Show

137142

138143-- | Convert an externs file back into a module

@@ -145,6 +150,7 @@ applyExternsFileToEnvironment ExternsFile{..} = flip (foldl' applyDecl) efDeclar

145150 applyDecl env (EDDataConstructor pn dTy tNm ty nms) = env { dataConstructors = M.insert (qual pn) (dTy, tNm, ty, nms) (dataConstructors env) }

146151 applyDecl env (EDValue ident ty) = env { names = M.insert (Qualified (Just efModuleName) ident) (ty, External, Defined) (names env) }

147152 applyDecl env (EDClass pn args members cs deps) = env { typeClasses = M.insert (qual pn) (makeTypeClassData args members cs deps) (typeClasses env) }

153+ applyDecl env (EDKind pn) = env { kinds = S.insert (qual pn) (kinds env) }

148154 applyDecl env (EDInstance className ident tys cs) = env { typeClassDictionaries = updateMap (updateMap (M.insert (qual ident) dict) className) (Just efModuleName) (typeClassDictionaries env) }

149155 where

150156 dict :: NamedDict

@@ -220,6 +226,9 @@ moduleToExternsFile (Module _ _ mn ds (Just exps)) env = ExternsFile{..}

220226 , m2 <- M.elems m1

221227 , TypeClassDictionaryInScope{..} <- maybeToList (M.lookup (Qualified (Just mn) ident) m2)

222228 ]

229+ toExternsDeclaration (KindRef pn)

230+ | Qualified (Just mn) pn `S.member` kinds env

231+ = [ EDKind pn ]

223232 toExternsDeclaration _ = []

224233

225234$(deriveJSON (defaultOptions { sumEncoding = ObjectWithSingleField }) ''ExternsImport)

src/Language/PureScript/Ide/Externs.hs+7−3

@@ -94,6 +94,7 @@ convertDecl P.EDDataConstructor{..} = Just $ IdeDeclDataConstructor $

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

9595 IdeValue edValueName edValueType

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

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

9798convertDecl P.EDInstance{} = Nothing

9899

99100convertOperator :: P.ExternsFixity -> IdeDeclaration

@@ -137,9 +138,12 @@ annotateModule (defs, types) (moduleName, decls) =

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

138139 IdeDeclTypeOperator op ->

139140 annotateType (op ^. ideTypeOpAlias & typeOperatorAliasT) (IdeDeclTypeOperator op)

141+ IdeDeclKind i ->

142+ annotateKind (i ^. properNameT) (IdeDeclKind i)

140143 where

141− annotateFunction x = IdeDeclarationAnn (ann { annLocation = Map.lookup (Left (P.runIdent x)) defs

144+ annotateFunction x = IdeDeclarationAnn (ann { annLocation = Map.lookup (IdeNSValue (P.runIdent x)) defs

142145 , annTypeAnnotation = Map.lookup x types

143146 })

144− annotateValue x = IdeDeclarationAnn (ann {annLocation = Map.lookup (Left x) defs})

145− annotateType x = IdeDeclarationAnn (ann {annLocation = Map.lookup (Right x) defs})

147+ annotateValue x = IdeDeclarationAnn (ann {annLocation = Map.lookup (IdeNSValue x) defs})

148+ annotateType x = IdeDeclarationAnn (ann {annLocation = Map.lookup (IdeNSType x) defs})

149+ annotateKind x = IdeDeclarationAnn (ann {annLocation = Map.lookup (IdeNSKind x) defs})

src/Language/PureScript/Ide/SourceFile.hs+12−11

@@ -92,25 +92,26 @@ extractSpans

9292 -- ^ The surrounding span

9393 -> P.Declaration

9494 -- ^ The declaration to extract spans from

95− -> [(Either Text Text, P.SourceSpan)]

96− -- ^ A @Right@ corresponds to a type level declaration, and a @Left@ to a

97− -- value level one

95+ -> [(IdeDeclNamespace, P.SourceSpan)]

96+ -- ^ Declarations and their source locations

9897extractSpans ss d = case d of

9998 P.PositionedDeclaration ss' _ d' ->

10099 extractSpans ss' d'

101100 P.ValueDeclaration i _ _ _ ->

102− [(Left (P.runIdent i), ss)]

101+ [(IdeNSValue (P.runIdent i), ss)]

103102 P.TypeSynonymDeclaration name _ _ ->

104− [(Right (P.runProperName name), ss)]

103+ [(IdeNSType (P.runProperName name), ss)]

105104 P.TypeClassDeclaration name _ _ _ members ->

106− (Right (P.runProperName name), ss) : concatMap (extractSpans' ss) members

105+ (IdeNSType (P.runProperName name), ss) : concatMap (extractSpans' ss) members

107106 P.DataDeclaration _ name _ ctors ->

108− (Right (P.runProperName name), ss)

109− : map (\(cname, _) -> (Left (P.runProperName cname), ss)) ctors

107+ (IdeNSType (P.runProperName name), ss)

108+ : map (\(cname, _) -> (IdeNSValue (P.runProperName cname), ss)) ctors

110109 P.ExternDeclaration ident _ ->

111− [(Left (P.runIdent ident), ss)]

110+ [(IdeNSValue (P.runIdent ident), ss)]

112111 P.ExternDataDeclaration name _ ->

113− [(Right (P.runProperName name), ss)]

112+ [(IdeNSType (P.runProperName name), ss)]

113+ P.ExternKindDeclaration name ->

114+ [(IdeNSKind (P.runProperName name), ss)]

114115 _ -> []

115116 where

116117 -- We need this special case to be able to also get the position info for

@@ -121,5 +122,5 @@ extractSpans ss d = case d of

121122 P.PositionedDeclaration ssP' _ dP' ->

122123 extractSpans' ssP' dP'

123124 P.TypeDeclaration ident _ ->

124− [(Left (P.runIdent ident), ssP)]

125+ [(IdeNSValue (P.runIdent ident), ssP)]

125126 _ -> []

src/Language/PureScript/Ide/Types.hs+12−1

@@ -36,6 +36,7 @@ data IdeDeclaration

3636 | IdeDeclTypeClass (P.ProperName 'P.ClassName)

3737 | IdeDeclValueOperator IdeValueOperator

3838 | IdeDeclTypeOperator IdeTypeOperator

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

3940 deriving (Show, Eq, Ord)

4041

4142data IdeValue = IdeValue

@@ -102,7 +103,7 @@ emptyAnn = Annotation Nothing Nothing Nothing

102103

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

104105

105−type DefinitionSites a = Map (Either Text Text) a

106+type DefinitionSites a = Map IdeDeclNamespace a

106107type TypeAnnotations = Map P.Ident P.Type

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

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

@@ -214,6 +215,7 @@ identifierFromDeclarationRef :: P.DeclarationRef -> Text

214215identifierFromDeclarationRef (P.TypeRef name _) = P.runProperName name

215216identifierFromDeclarationRef (P.ValueRef ident) = P.runIdent ident

216217identifierFromDeclarationRef (P.TypeClassRef name) = P.runProperName name

218+identifierFromDeclarationRef (P.KindRef name) = P.runProperName name

217219identifierFromDeclarationRef _ = ""

218220

219221data Success =

@@ -293,3 +295,12 @@ instance ToJSON PursuitResponse where

293295 , "package" .= package

294296 , "text" .= text

295297 ]

298+

299+data IdeDeclNamespace =

300+ -- | An identifier in the value namespace

301+ IdeNSValue Text

302+ -- | An identifier in the type namespace

303+ | IdeNSType Text

304+ -- | An identifier in the kind namespace

305+ | IdeNSKind Text

306+ deriving (Show, Eq, Ord)

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

@@ -49,6 +49,7 @@ identifierFromIdeDeclaration d = case d of

4949 IdeDeclTypeClass name -> P.runProperName name

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

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

52+ IdeDeclKind name -> P.runProperName name

5253

5354discardAnn :: IdeDeclarationAnn -> IdeDeclaration

5455discardAnn (IdeDeclarationAnn _ d) = d

@@ -73,6 +74,7 @@ completionFromMatch (Match (m, IdeDeclarationAnn ann decl)) =

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

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

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

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

7678

7779 complModule = P.runModuleName m

7880

src/Language/PureScript/Interactive.hs+2

@@ -200,6 +200,8 @@ handleShowImportedModules = do

200200 Just $ N.runIdent ident

201201 showRef (P.ModuleRef name) =

202202 Just $ "module " <> N.runModuleName name

203+ showRef (P.KindRef pn) =

204+ Just $ "kind " <> N.runProperName pn

203205 showRef (P.ReExportRef _ _) =

204206 Nothing

205207 showRef (P.PositionedDeclarationRef _ _ ref) =

src/Language/PureScript/Interactive/Message.hs+3−3

@@ -27,8 +27,8 @@ helpMessage = "The following commands are available:\n\n " ++

2727 ]

2828

2929 extraHelp =

30− "Further information is available on the PureScript wiki:\n" ++

31− " --> https://github.com/purescript/purescript/wiki/psci"

30+ "Further information is available on the PureScript documentation repository:\n" ++

31+ " --> https://github.com/purescript/documentation/blob/master/PSCi.md"

3232

3333-- | The welcome prologue.

3434prologueMessage :: String

@@ -48,7 +48,7 @@ supportModuleMessage = unlines

4848 , ""

4949 , " psc-package install psci-support"

5050 , ""

51− , "For help getting started, visit http://wiki.purescript.org/PSCi"

51+ , "For help getting started, visit https://github.com/purescript/documentation/blob/master/PSCi.md"

5252 ]

5353

5454-- | The quit message.

src/Language/PureScript/Interactive/Parser.hs+1

@@ -114,6 +114,7 @@ acceptable P.ExternDeclaration{} = True

114114acceptable P.ExternDataDeclaration{} = True

115115acceptable P.TypeClassDeclaration{} = True

116116acceptable P.TypeInstanceDeclaration{} = True

117+acceptable P.ExternKindDeclaration{} = True

117118acceptable _ = False

118119

119120parseReplQuery' :: String -> Either String ReplQuery

src/Language/PureScript/Kinds.hs+4−6

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

77import qualified Data.Aeson.TH as A

9+import Language.PureScript.Names

10+

911-- | The data type of kinds

1012data Kind

1113 -- | Unification variable of type Kind

1214 = KUnknown Int

13− -- | The kind of types

14− | Star

15− -- | The kind of effects

16− | Bang

1715 -- | Kinds for labelled, unordered rows without duplicates

1816 | Row Kind

1917 -- | Function kinds

2018 | FunKind Kind Kind

21− -- | Type-level strings

22− | Symbol

19+ -- | A named kind

20+ | NamedKind (Qualified (ProperName 'KindName))

2321 deriving (Show, Eq, Ord)

2422

2523$(A.deriveJSON A.defaultOptions ''Kind)

src/Language/PureScript/Names.hs+7−1

@@ -24,6 +24,7 @@ data Name

2424 | DctorName (ProperName 'ConstructorName)

2525 | TyClassName (ProperName 'ClassName)

2626 | ModName ModuleName

27+ | KiName (ProperName 'KindName)

2728 deriving (Eq, Show)

2829

2930getIdentName :: Name -> Maybe Ident

@@ -117,7 +118,12 @@ instance FromJSON (ProperName a) where

117118-- |

118119-- The closed set of proper name types.

119120--

120−data ProperNameType = TypeName | ConstructorName | ClassName | Namespace

121+data ProperNameType

122+ = TypeName

123+ | ConstructorName

124+ | ClassName

125+ | KindName

126+ | Namespace

121127

122128-- |

123129-- Coerces a ProperName from one ProperNameType to another. This should be used

src/Language/PureScript/Parser/Common.hs+6

@@ -31,6 +31,12 @@ properName = ProperName <$> uname

3131typeName :: TokenParser (ProperName 'TypeName)

3232typeName = ProperName <$> tyname

3333

34+-- |

35+-- Parse a proper name for a kind.

36+--

37+kindName :: TokenParser (ProperName 'KindName)

38+kindName = ProperName <$> kiname

39+

3440-- |

3541-- Parse a proper name for a data constructor.

3642--

src/Language/PureScript/Parser/Declarations.hs+12−7

@@ -109,12 +109,16 @@ parseValueDeclaration = do

109109 return $ maybe value (`Let` value) whereClause

110110

111111parseExternDeclaration :: TokenParser Declaration

112−parseExternDeclaration = reserved "foreign" *> indented *> reserved "import" *> indented *>

113− (ExternDataDeclaration <$> (reserved "data" *> indented *> typeName)

114− <*> (indented *> doubleColon *> parseKind)

115− <|> (do ident <- parseIdent

116− ty <- indented *> doubleColon *> noWildcards parsePolyType

117− return $ ExternDeclaration ident ty))

112+parseExternDeclaration = reserved "foreign" *> indented *> reserved "import" *> indented *> parseExternAlt where

113+ parseExternAlt = parseExternData <|> P.try parseExternKind <|> parseExternTerm

114+

115+ parseExternData = ExternDataDeclaration <$> (reserved "data" *> indented *> typeName)

116+ <*> (indented *> doubleColon *> parseKind)

117+

118+ parseExternKind = ExternKindDeclaration <$> (reserved "kind" *> indented *> kindName)

119+

120+ parseExternTerm = ExternDeclaration <$> parseIdent

121+ <*> (indented *> doubleColon *> noWildcards parsePolyType)

118122

119123parseAssociativity :: TokenParser Associativity

120124parseAssociativity =

@@ -163,7 +167,8 @@ parseImportDeclaration' = do

163167parseDeclarationRef :: TokenParser DeclarationRef

164168parseDeclarationRef =

165169 withSourceSpan PositionedDeclarationRef

166− $ (ValueRef <$> parseIdent)

170+ $ (KindRef <$> P.try (reserved "kind" *> kindName))

171+ <|> (ValueRef <$> parseIdent)

167172 <|> (ValueOpRef <$> parens parseOperator)

168173 <|> parseTypeRef

169174 <|> (TypeClassRef <$> (reserved "class" *> properName))

src/Language/PureScript/Parser/Kinds.hs+10−8

@@ -5,6 +5,7 @@ module Language.PureScript.Parser.Kinds (parseKind) where

66import Prelude.Compat

8+import Language.PureScript.Environment

89import Language.PureScript.Kinds

910import Language.PureScript.Parser.Common

1011import Language.PureScript.Parser.Lexer

@@ -13,26 +14,27 @@ import qualified Text.Parsec as P

1314import qualified Text.Parsec.Expr as P

1415

1516parseStar :: TokenParser Kind

16−parseStar = const Star <$> symbol' "*"

17+parseStar = const kindType <$> symbol' "*"

1718

1819parseBang :: TokenParser Kind

19−parseBang = const Bang <$> symbol' "!"

20+parseBang = const kindEffect <$> symbol' "!"

2021

21−parseSymbol :: TokenParser Kind

22−parseSymbol = const Symbol <$> uname' "Symbol"

22+parseNamedKind :: TokenParser Kind

23+parseNamedKind = NamedKind <$> parseQualified kindName

2324

24−parseTypeAtom :: TokenParser Kind

25−parseTypeAtom = indented *> P.choice

25+parseKindAtom :: TokenParser Kind

26+parseKindAtom = indented *> P.choice

2627 [ parseStar

2728 , parseBang

28− , parseSymbol

29+ , parseNamedKind

2930 , parens parseKind

3031 ]

32+

3133-- |

3234-- Parse a kind

3335--

3436parseKind :: TokenParser Kind

35−parseKind = P.buildExpressionParser operators parseTypeAtom P.<?> "kind"

37+parseKind = P.buildExpressionParser operators parseKindAtom P.<?> "kind"

3638 where

3739 operators = [ [ P.Prefix (symbol' "#" >> return Row) ]

3840 , [ P.Infix (rarrow >> return FunKind) P.AssocRight ] ]

src/Language/PureScript/Parser/Lexer.hs+7

@@ -43,6 +43,7 @@ module Language.PureScript.Parser.Lexer

4343 , lname'

4444 , qualifier

4545 , tyname

46+ , kiname

4647 , dconsname

4748 , uname

4849 , uname'

@@ -474,6 +475,12 @@ tyname = token go P.<?> "type name"

474475 go (UName s) = Just s

475476 go _ = Nothing

476477

478+kiname :: TokenParser Text

479+kiname = token go P.<?> "kind name"

480+ where

481+ go (UName s) = Just s

482+ go _ = Nothing

483+

477484dconsname :: TokenParser Text

478485dconsname = token go P.<?> "data constructor name"

479486 where

src/Language/PureScript/Pretty/Kinds.hs+2−3

@@ -16,15 +16,14 @@ import Data.Text (Text)

1616

1717import Language.PureScript.Crash

1818import Language.PureScript.Kinds

19+import Language.PureScript.Names

1920import Language.PureScript.Pretty.Common

2021

2122typeLiterals :: Pattern () Kind String

2223typeLiterals = mkPattern match

2324 where

24− match Star = Just "*"

25− match Bang = Just "!"

26− match Symbol = Just "Symbol"

2725 match (KUnknown u) = Just $ 'u' : show u

26+ match (NamedKind name) = Just $ T.unpack (showQualified runProperName name)

2827 match _ = Nothing

2928

3029matchRow :: Pattern () Kind ((), Kind)

src/Language/PureScript/Pretty/Values.hs+4−4

@@ -54,15 +54,15 @@ prettyPrintValue d (IfThenElse cond th el) =

5454 // moveRight 2 (vcat left [ text "then " <> prettyPrintValueAtom (d - 1) th

5555 , text "else " <> prettyPrintValueAtom (d - 1) el

5656 ])

57−prettyPrintValue d (Accessor prop val) = prettyPrintValueAtom (d - 1) val <> textT ("." Monoid.<> prettyPrintObjectKey prop)

58−prettyPrintValue d (ObjectUpdate o ps) = prettyPrintValueAtom (d - 1) o <> text " " <> list '{' '}' (\(key, val) -> textT (key Monoid.<> " = ") <> prettyPrintValue (d - 1) val) ps

57+prettyPrintValue d (Accessor prop val) = prettyPrintValueAtom (d - 1) val `before` textT ("." Monoid.<> prettyPrintObjectKey prop)

58+prettyPrintValue d (ObjectUpdate o ps) = prettyPrintValueAtom (d - 1) o `beforeWithSpace` list '{' '}' (\(key, val) -> textT (key Monoid.<> " = ") <> prettyPrintValue (d - 1) val) ps

5959prettyPrintValue d (App val arg) = prettyPrintValueAtom (d - 1) val `beforeWithSpace` prettyPrintValueAtom (d - 1) arg

6060prettyPrintValue d (Abs (Left arg) val) = text ('\\' : T.unpack (showIdent arg) ++ " -> ") // moveRight 2 (prettyPrintValue (d - 1) val)

6161prettyPrintValue d (Abs (Right arg) val) = text ('\\' : T.unpack (prettyPrintBinder arg) ++ " -> ") // moveRight 2 (prettyPrintValue (d - 1) val)

6262prettyPrintValue d (TypeClassDictionaryConstructorApp className ps) =

6363 text (T.unpack (runProperName (disqualify className)) ++ " ") <> prettyPrintValueAtom (d - 1) ps

6464prettyPrintValue d (Case values binders) =

65− (text "case " <> foldl1 beforeWithSpace (map (prettyPrintValueAtom (d - 1)) values) <> text " of") //

65+ (text "case " <> foldr beforeWithSpace (text "of") (map (prettyPrintValueAtom (d - 1)) values)) //

6666 moveRight 2 (vcat left (map (prettyPrintCaseAlternative (d - 1)) binders))

6767prettyPrintValue d (Let ds val) =

6868 text "let" //

@@ -96,7 +96,7 @@ prettyPrintValueAtom d (BinaryNoParens op lhs rhs) =

9696 prettyPrintValue (d - 1) lhs `beforeWithSpace` printOp op `beforeWithSpace` prettyPrintValue (d - 1) rhs

9797 where

9898 printOp (Op (Qualified _ name)) = text $ T.unpack $ runOpName name

99− printOp expr = text "`" <> prettyPrintValue (d - 1) expr <> text "`"

99+ printOp expr = text "`" <> prettyPrintValue (d - 1) expr `before` text "`"

100100prettyPrintValueAtom d (TypedValue _ val _) = prettyPrintValueAtom d val

101101prettyPrintValueAtom d (PositionedValue _ _ val) = prettyPrintValueAtom d val

102102prettyPrintValueAtom d (Parens expr) = (text "(" <> prettyPrintValue d expr) `before` text ")"

src/Language/PureScript/Publish.hs+27−26

@@ -23,7 +23,7 @@ module Language.PureScript.Publish

2323import Prelude ()

2424import Prelude.Compat hiding (userError)

2525

26−import Control.Arrow ((***))

26+import Control.Arrow ((***), first)

2727import Control.Category ((>>>))

2828import Control.Exception (catch, try)

2929import Control.Monad.Error.Class (MonadError(..))

@@ -35,12 +35,13 @@ import Data.Aeson.BetterErrors

3535import Data.Char (isSpace)

3636import Data.Foldable (traverse_)

3737import Data.Function (on)

38−import Data.List (stripPrefix, isSuffixOf, (\\), nubBy)

38+import Data.List (stripPrefix, (\\), nubBy)

3939import Data.List.NonEmpty (NonEmpty(..))

4040import Data.List.Split (splitOn)

4141import Data.Maybe

4242import Data.Version

4343import qualified Data.SPDX as SPDX

44+import Data.Text (Text)

4445import qualified Data.Text as T

4546import qualified Data.Text.Lazy as TL

4647import qualified Data.Text.Lazy.Encoding as TL

@@ -65,7 +66,7 @@ import qualified Language.PureScript.Docs as D

6566data PublishOptions = PublishOptions

6667 { -- | How to obtain the version tag and version that the data being

6768 -- generated will refer to.

68− publishGetVersion :: PrepareM (String, Version)

69+ publishGetVersion :: PrepareM (Text, Version)

6970 , -- | What to do when the working tree is dirty

7071 publishWorkingTreeDirty :: PrepareM ()

7172 }

@@ -184,21 +185,20 @@ checkCleanWorkingTree opts = do

184185 unless (status == Clean) $

185186 publishWorkingTreeDirty opts

186187

187−getVersionFromGitTag :: PrepareM (String, Version)

188+getVersionFromGitTag :: PrepareM (Text, Version)

188189getVersionFromGitTag = do

189190 out <- readProcess' "git" ["tag", "--list", "--points-at", "HEAD"] ""

190191 let vs = map trimWhitespace (lines out)

191192 case mapMaybe parseMay vs of

192193 [] -> userError TagMustBeCheckedOut

193− [x] -> return x

194+ [x] -> return (first T.pack x)

194195 xs -> userError (AmbiguousVersions (map snd xs))

195196 where

196197 trimWhitespace =

197198 dropWhile isSpace >>> reverse >>> dropWhile isSpace >>> reverse

198− parseMay str =

199− (str,) <$> D.parseVersion' (dropPrefix "v" str)

200− dropPrefix prefix str =

201− fromMaybe str (stripPrefix prefix str)

199+ parseMay str = do

200+ digits <- stripPrefix "v" str

201+ (str,) <$> D.parseVersion' digits

202202

203203getBowerRepositoryInfo :: PackageMeta -> PrepareM (D.GithubUser, D.GithubRepo)

204204getBowerRepositoryInfo = either (userError . BadRepositoryField) return . tryExtract

@@ -209,7 +209,7 @@ getBowerRepositoryInfo = either (userError . BadRepositoryField) return . tryExt

209209 Just Repository{..} -> do

210210 unless (repositoryType == "git")

211211 (Left (BadRepositoryType repositoryType))

212− maybe (Left NotOnGithub) Right (extractGithub repositoryUrl)

212+ maybe (Left NotOnGithub) Right (extractGithub (T.pack repositoryUrl))

213213

214214checkLicense :: PackageMeta -> PrepareM ()

215215checkLicense pkgMeta =

@@ -226,9 +226,9 @@ checkLicense pkgMeta =

226226isValidSPDX :: String -> Bool

227227isValidSPDX = (== 1) . length . SPDX.parseExpression

228228

229−extractGithub :: String -> Maybe (D.GithubUser, D.GithubRepo)

229+extractGithub :: Text -> Maybe (D.GithubUser, D.GithubRepo)

230230extractGithub = stripGitHubPrefixes

231− >>> fmap (splitOn "/")

231+ >>> fmap (T.splitOn "/")

232232 >=> takeTwo

233233 >>> fmap (D.GithubUser *** (D.GithubRepo . dropDotGit))

234234

@@ -237,18 +237,18 @@ extractGithub = stripGitHubPrefixes

237237 takeTwo [x, y] = Just (x, y)

238238 takeTwo _ = Nothing

239239

240− stripGitHubPrefixes :: String -> Maybe String

240+ stripGitHubPrefixes :: Text -> Maybe Text

241241 stripGitHubPrefixes = stripPrefixes [ "git://github.com/"

242242 , "https://github.com/"

243243 , "git@github.com:"

244244 ]

245245

246− stripPrefixes :: [String] -> String -> Maybe String

247− stripPrefixes prefixes str = msum $ (`stripPrefix` str) <$> prefixes

246+ stripPrefixes :: [Text] -> Text -> Maybe Text

247+ stripPrefixes prefixes str = msum $ (`T.stripPrefix` str) <$> prefixes

248248

249− dropDotGit :: String -> String

249+ dropDotGit :: Text -> Text

250250 dropDotGit str

251− | ".git" `isSuffixOf` str = take (length str - 4) str

251+ | ".git" `T.isSuffixOf` str = T.take (T.length str - 4) str

252252 | otherwise = str

253253

254254readProcess' :: String -> [String] -> String -> PrepareM String

@@ -265,12 +265,12 @@ data DependencyStatus

265265 -- _resolution key. This can be caused by adding the dependency using

266266 -- `bower link`, or simply copying it into bower_components instead of

267267 -- installing it normally.

268− | ResolvedOther String

269− -- ^ Resolved, but to something other than a version. The String argument

268+ | ResolvedOther Text

269+ -- ^ Resolved, but to something other than a version. The Text argument

270270 -- is the resolution type. The values it can take that I'm aware of are

271271 -- "commit" and "branch".

272− | ResolvedVersion String

273− -- ^ Resolved to a version. The String argument is the resolution tag (eg,

272+ | ResolvedVersion Text

273+ -- ^ Resolved to a version. The Text argument is the resolution tag (eg,

274274 -- "v0.1.0").

275275 deriving (Show, Eq)

276276

@@ -341,9 +341,9 @@ asDependencyStatus = do

341341 else

342342 key "pkgMeta" $

343343 keyOrDefault "_resolution" NoResolution $ do

344− type_ <- key "type" asString

344+ type_ <- key "type" asText

345345 case type_ of

346− "version" -> ResolvedVersion <$> key "tag" asString

346+ "version" -> ResolvedVersion <$> key "tag" asText

347347 other -> return (ResolvedOther other)

348348

349349warnUndeclared :: [PackageName] -> [PackageName] -> PrepareM ()

@@ -374,15 +374,16 @@ handleDeps deps = do

374374 bowerDir pkgName = "bower_components/" ++ runPackageName pkgName

375375

376376 -- Try to extract a version, and warn if unsuccessful.

377+ tryExtractVersion' :: (PackageName, Text) -> PrepareM (Maybe (PackageName, Version))

377378 tryExtractVersion' pair =

378379 maybe (warn (UnacceptableVersion pair) >> return Nothing)

379380 (return . Just)

380381 (tryExtractVersion pair)

381382

382−tryExtractVersion :: (PackageName, String) -> Maybe (PackageName, Version)

383+tryExtractVersion :: (PackageName, Text) -> Maybe (PackageName, Version)

383384tryExtractVersion (pkgName, tag) =

384− let tag' = fromMaybe tag (stripPrefix "v" tag)

385− in (pkgName,) <$> D.parseVersion' tag'

385+ let tag' = fromMaybe tag (T.stripPrefix "v" tag)

386+ in (pkgName,) <$> D.parseVersion' (T.unpack tag')

386387

387388-- | Returns whether it looks like there is a purescript package checked out

388389-- in the given directory.

src/Language/PureScript/Publish/ErrorsWarnings.hs+7−7

@@ -24,6 +24,7 @@ import Data.Maybe

2424import Data.Monoid

2525import Data.Version

2626import qualified Data.List.NonEmpty as NonEmpty

27+import Data.Text (Text)

2728import qualified Data.Text as T

2829

2930import Language.PureScript.Publish.BoxesHelpers

@@ -43,7 +44,7 @@ data PackageError

4344data PackageWarning

4445 = NoResolvedVersion PackageName

4546 | UndeclaredDependency PackageName

46− | UnacceptableVersion (PackageName, String)

47+ | UnacceptableVersion (PackageName, Text)

4748 | DirtyWorkingTree_Warn

4849 deriving (Show)

4950

@@ -147,9 +148,8 @@ displayUserError e = case e of

147148 , "version."

148149 ])

149150 , spacer

150− , para "Note: tagged versions must be in one of the following forms:"

151− , indented (para "* v{MAJOR}.{MINOR}.{PATCH} (example: \"v1.6.2\")")

152− , indented (para "* {MAJOR}.{MINOR}.{PATCH} (example: \"1.6.2\")")

151+ , para "Note: tagged versions must be in the form"

152+ , indented (para "v{MAJOR}.{MINOR}.{PATCH} (example: \"v1.6.2\")")

153153 , spacer

154154 , para (concat

155155 [ "If the version you are publishing is not yet tagged, you might "

@@ -311,7 +311,7 @@ displayOtherError e = case e of

311311data CollectedWarnings = CollectedWarnings

312312 { noResolvedVersions :: [PackageName]

313313 , undeclaredDependencies :: [PackageName]

314− , unacceptableVersions :: [(PackageName, String)]

314+ , unacceptableVersions :: [(PackageName, Text)]

315315 , dirtyWorkingTree :: Any

316316 }

317317 deriving (Show, Eq, Ord)

@@ -387,7 +387,7 @@ warnUndeclaredDependencies pkgNames =

387387 ])

388388 : bulletedList runPackageName (NonEmpty.toList pkgNames)

389389

390−warnUnacceptableVersions :: NonEmpty (PackageName, String) -> Box

390+warnUnacceptableVersions :: NonEmpty (PackageName, Text) -> Box

391391warnUnacceptableVersions pkgs =

392392 let singular = NonEmpty.length pkgs == 1

393393 pl a b = if singular then b else a

@@ -414,7 +414,7 @@ warnUnacceptableVersions pkgs =

414414 ])

415415 ]

416416 where

417− showTuple (pkgName, tag) = runPackageName pkgName ++ "#" ++ tag

417+ showTuple (pkgName, tag) = runPackageName pkgName ++ "#" ++ T.unpack tag

418418

419419warnDirtyWorkingTree :: Box

420420warnDirtyWorkingTree =

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

@@ -62,6 +62,6 @@ desugar externs =

6262 >=> desugarImports externs

6363 >=> rebracket externs

6464 >=> traverse checkFixityExports

65− >=> traverse deriveInstances

65+ >=> traverse (deriveInstances externs)

6666 >=> desugarTypeClasses externs

6767 >=> traverse createBindingGroupsModule

src/Language/PureScript/Sugar/BindingGroups.hs+1

@@ -73,6 +73,7 @@ createBindingGroups moduleName = mapM f <=< handleDecls

7373 valueVerts = map (\d -> (d, declIdent d, usedIdents moduleName d `intersect` allIdents)) values

7474 bindingGroupDecls <- parU (stronglyConnComp valueVerts) (toBindingGroup moduleName)

7575 return $ filter isImportDecl ds ++

76+ filter isExternKindDecl ds ++

7677 filter isExternDataDecl ds ++

7778 dataBindingGroupDecls ++

7879 filter isTypeClassDeclaration ds ++

src/Language/PureScript/Sugar/Names.hs+39−7

@@ -25,6 +25,7 @@ import Language.PureScript.AST

2525import Language.PureScript.Crash

2626import Language.PureScript.Errors

2727import Language.PureScript.Externs

28+import Language.PureScript.Kinds

2829import Language.PureScript.Linter.Imports

2930import Language.PureScript.Names

3031import Language.PureScript.Sugar.Names.Env

@@ -98,6 +99,9 @@ desugarImportsWithEnv externs modules = do

9899 exportedRefs :: Ord a => (DeclarationRef -> Maybe a) -> M.Map a ModuleName

99100 exportedRefs f = M.fromList $ (, efModuleName) <$> mapMaybe f efExports

100101

102+ exportedKinds :: M.Map (ProperName 'KindName) ModuleName

103+ exportedKinds = exportedRefs getKindRef

104+

101105 updateEnv :: ([Module], Env) -> Module -> m ([Module], Env)

102106 updateEnv (ms, env) m@(Module ss _ mn _ refs) = do

103107 members <- findExportable m

@@ -128,6 +132,7 @@ elaborateExports exps (Module ss coms mn decls refs) =

128132 ++ go TypeClassRef exportedTypeClasses

129133 ++ go ValueRef exportedValues

130134 ++ go ValueOpRef exportedValueOps

135+ ++ go KindRef exportedKinds

131136 ++ maybe [] (filter isModuleRef) refs

132137 where

133138

@@ -165,17 +170,24 @@ renameInModule imports (Module ss coms mn decls exps) =

165170 updateDecl (_, bound) d@(PositionedDeclaration pos _ _) =

166171 return ((Just pos, bound), d)

167172 updateDecl (pos, bound) (DataDeclaration dtype name args dctors) =

168− (,) (pos, bound) <$> (DataDeclaration dtype name args <$> traverse (sndM (traverse (updateTypesEverywhere pos))) dctors)

173+ (,) (pos, bound) <$> (DataDeclaration dtype name <$> updateTypeArguments pos args

174+ <*> traverse (sndM (traverse (updateTypesEverywhere pos))) dctors)

169175 updateDecl (pos, bound) (TypeSynonymDeclaration name ps ty) =

170− (,) (pos, bound) <$> (TypeSynonymDeclaration name ps <$> updateTypesEverywhere pos ty)

176+ (,) (pos, bound) <$> (TypeSynonymDeclaration name <$> updateTypeArguments pos ps

177+ <*> updateTypesEverywhere pos ty)

171178 updateDecl (pos, bound) (TypeClassDeclaration className args implies deps ds) =

172− (,) (pos, bound) <$> (TypeClassDeclaration className args <$> updateConstraints pos implies <*> pure deps <*> pure ds)

179+ (,) (pos, bound) <$> (TypeClassDeclaration className <$> updateTypeArguments pos args

180+ <*> updateConstraints pos implies

181+ <*> pure deps

182+ <*> pure ds)

173183 updateDecl (pos, bound) (TypeInstanceDeclaration name cs cn ts ds) =

174184 (,) (pos, bound) <$> (TypeInstanceDeclaration name <$> updateConstraints pos cs <*> updateClassName cn pos <*> traverse (updateTypesEverywhere pos) ts <*> pure ds)

175185 updateDecl (pos, bound) (TypeDeclaration name ty) =

176186 (,) (pos, bound) <$> (TypeDeclaration name <$> updateTypesEverywhere pos ty)

177187 updateDecl (pos, bound) (ExternDeclaration name ty) =

178188 (,) (pos, name : bound) <$> (ExternDeclaration name <$> updateTypesEverywhere pos ty)

189+ updateDecl (pos, bound) (ExternDataDeclaration name ki) =

190+ (,) (pos, bound) <$> (ExternDataDeclaration name <$> updateKindsEverywhere pos ki)

179191 updateDecl (pos, bound) (TypeFixityDeclaration fixity alias op) =

180192 (,) (pos, bound) <$> (TypeFixityDeclaration fixity <$> updateTypeName alias pos <*> pure op)

181193 updateDecl (pos, bound) (ValueFixityDeclaration fixity (Qualified mn' (Left alias)) op) =

@@ -238,6 +250,19 @@ renameInModule imports (Module ss coms mn decls exps) =

238250 letBoundVariable (PositionedDeclaration _ _ d) = letBoundVariable d

239251 letBoundVariable _ = Nothing

240252

253+ updateKindsEverywhere :: Maybe SourceSpan -> Kind -> m Kind

254+ updateKindsEverywhere pos = everywhereOnKindsM updateKind

255+ where

256+ updateKind :: Kind -> m Kind

257+ updateKind (NamedKind name) = NamedKind <$> updateKindName name pos

258+ updateKind k = return k

259+

260+ updateTypeArguments

261+ :: (Traversable f, Traversable g)

262+ => Maybe SourceSpan

263+ -> f (a, g Kind) -> m (f (a, g Kind))

264+ updateTypeArguments pos = traverse (sndM (traverse (updateKindsEverywhere pos)))

265+

241266 updateTypesEverywhere :: Maybe SourceSpan -> Type -> m Type

242267 updateTypesEverywhere pos = everywhereOnTypesM updateType

243268 where

@@ -245,16 +270,17 @@ renameInModule imports (Module ss coms mn decls exps) =

245270 updateType (TypeOp name) = TypeOp <$> updateTypeOpName name pos

246271 updateType (TypeConstructor name) = TypeConstructor <$> updateTypeName name pos

247272 updateType (ConstrainedType cs t) = ConstrainedType <$> traverse updateInConstraint cs <*> pure t

273+ updateType (KindedType t k) = KindedType t <$> updateKindsEverywhere pos k

248274 updateType t = return t

249275 updateInConstraint :: Constraint -> m Constraint

250276 updateInConstraint (Constraint name ts info) =

251277 Constraint <$> updateClassName name pos <*> pure ts <*> pure info

252278

253279 updateConstraints :: Maybe SourceSpan -> [Constraint] -> m [Constraint]

254− updateConstraints pos = traverse $ \(Constraint name ts info) ->

255− Constraint

256− <$> updateClassName name pos

257− <*> traverse (updateTypesEverywhere pos) ts

280+ updateConstraints pos = traverse $ \(Constraint name ts info) ->

281+ Constraint

282+ <$> updateClassName name pos

283+ <*> traverse (updateTypesEverywhere pos) ts

258284 <*> pure info

259285

260286 updateTypeName

@@ -290,6 +316,12 @@ renameInModule imports (Module ss coms mn decls exps) =

290316 -> m (Qualified (OpName 'ValueOpName))

291317 updateValueOpName = update (importedValueOps imports) ValOpName

292318

319+ updateKindName

320+ :: Qualified (ProperName 'KindName)

321+ -> Maybe SourceSpan

322+ -> m (Qualified (ProperName 'KindName))

323+ updateKindName = update (importedKinds imports) KiName

324+

293325 -- Update names so unqualified references become qualified, and locally

294326 -- qualified references are replaced with their canoncial qualified names

295327 -- (e.g. M.Map -> Data.Map.Map).

src/Language/PureScript/Sugar/Names/Env.hs+33−8

@@ -16,6 +16,7 @@ module Language.PureScript.Sugar.Names.Env

1616 , exportTypeClass

1717 , exportValue

1818 , exportValueOp

19+ , exportKind

1920 , getExports

2021 , checkImportConflicts

2122 ) where

@@ -71,27 +72,27 @@ type ImportMap a = M.Map (Qualified a) [ImportRecord a]

7172data Imports = Imports

7273 {

7374 -- |

74− -- Local names for types within a module mapped to to their qualified names

75+ -- Local names for types within a module mapped to their qualified names

7576 --

7677 importedTypes :: ImportMap (ProperName 'TypeName)

7778 -- |

78− -- Local names for type operators within a module mapped to to their qualified names

79+ -- Local names for type operators within a module mapped to their qualified names

7980 --

8081 , importedTypeOps :: ImportMap (OpName 'TypeOpName)

8182 -- |

82− -- Local names for data constructors within a module mapped to to their qualified names

83+ -- Local names for data constructors within a module mapped to their qualified names

8384 --

8485 , importedDataConstructors :: ImportMap (ProperName 'ConstructorName)

8586 -- |

86− -- Local names for classes within a module mapped to to their qualified names

87+ -- Local names for classes within a module mapped to their qualified names

8788 --

8889 , importedTypeClasses :: ImportMap (ProperName 'ClassName)

8990 -- |

90− -- Local names for values within a module mapped to to their qualified names

91+ -- Local names for values within a module mapped to their qualified names

9192 --

9293 , importedValues :: ImportMap Ident

9394 -- |

94− -- Local names for value operators within a module mapped to to their qualified names

95+ -- Local names for value operators within a module mapped to their qualified names

9596 --

9697 , importedValueOps :: ImportMap (OpName 'ValueOpName)

9798 -- |

@@ -104,10 +105,14 @@ data Imports = Imports

104105 -- The "as" names of modules that have been imported qualified.

105106 --

106107 , importedQualModules :: S.Set ModuleName

108+ -- |

109+ -- Local names for kinds within a module mapped to their qualified names

110+ --

111+ , importedKinds :: ImportMap (ProperName 'KindName)

107112 } deriving (Show)

108113

109114nullImports :: Imports

110−nullImports = Imports M.empty M.empty M.empty M.empty M.empty M.empty S.empty S.empty

115+nullImports = Imports M.empty M.empty M.empty M.empty M.empty M.empty S.empty S.empty M.empty

111116

112117-- |

113118-- An 'Imports' value with imports for the `Prim` module.

@@ -117,6 +122,7 @@ primImports =

117122 nullImports

118123 { importedTypes = M.fromList $ mkEntries `concatMap` M.keys primTypes

119124 , importedTypeClasses = M.fromList $ mkEntries `concatMap` M.keys primClasses

125+ , importedKinds = M.fromList $ mkEntries `concatMap` S.toList primKinds

120126 }

121127 where

122128 mkEntries :: Qualified a -> [(Qualified a, [ImportRecord a])]

@@ -155,13 +161,17 @@ data Exports = Exports

155161 -- from.

156162 --

157163 , exportedValueOps :: M.Map (OpName 'ValueOpName) ModuleName

164+ -- |

165+ -- The exported kinds along with the module they originally came from.

166+ --

167+ , exportedKinds :: M.Map (ProperName 'KindName) ModuleName

158168 } deriving (Show)

159169

160170-- |

161171-- An empty 'Exports' value.

162172--

163173nullExports :: Exports

164−nullExports = Exports M.empty M.empty M.empty M.empty M.empty

174+nullExports = Exports M.empty M.empty M.empty M.empty M.empty M.empty

165175

166176-- |

167177-- The imports and exports for a collection of modules. The 'SourceSpan' is used

@@ -196,10 +206,12 @@ primExports =

196206 nullExports

197207 { exportedTypes = M.fromList $ mkTypeEntry `map` M.keys primTypes

198208 , exportedTypeClasses = M.fromList $ mkClassEntry `map` M.keys primClasses

209+ , exportedKinds = M.fromList $ mkKindEntry `map` S.toList primKinds

199210 }

200211 where

201212 mkTypeEntry (Qualified mn name) = (name, ([], fromJust mn))

202213 mkClassEntry (Qualified mn name) = (name, fromJust mn)

214+ mkKindEntry (Qualified mn name) = (name, fromJust mn)

203215

204216-- | Environment which only contains the Prim module.

205217primEnv :: Env

@@ -316,6 +328,19 @@ exportValueOp exps op mn = do

316328 valueOps <- addExport ValOpName op mn (exportedValueOps exps)

317329 return $ exps { exportedValueOps = valueOps }

318330

331+-- |

332+-- Safely adds a kind to some exports, returning an error if a conflict occurs.

333+--

334+exportKind

335+ :: MonadError MultipleErrors m

336+ => Exports

337+ -> ProperName 'KindName

338+ -> ModuleName

339+ -> m Exports

340+exportKind exps name mn = do

341+ kinds <- addExport KiName name mn (exportedKinds exps)

342+ return $ exps { exportedKinds = kinds }

343+

319344-- |

320345-- Adds an entry to a list of exports unless it is already present, in which

321346-- case an error is returned.

src/Language/PureScript/Sugar/Names/Exports.hs+28−11

@@ -19,7 +19,7 @@ import Language.PureScript.AST

1919import Language.PureScript.Crash

2020import Language.PureScript.Errors

2121import Language.PureScript.Names

22−import Language.PureScript.Sugar.Names.Env

22+import Language.PureScript.Sugar.Names.Env

2323import Language.PureScript.Sugar.Names.Common (warnDuplicateRefs)

2424

2525-- |

@@ -51,6 +51,8 @@ findExportable (Module _ _ mn ds _) =

5151 exportTypeOp exps op mn

5252 updateExports exps (ExternDeclaration name _) =

5353 exportValue exps name mn

54+ updateExports exps (ExternKindDeclaration pn) =

55+ exportKind exps pn mn

5456 updateExports exps (PositionedDeclaration pos _ d) =

5557 rethrowWithPosition pos $ updateExports exps d

5658 updateExports exps _ = return exps

@@ -61,21 +63,21 @@ findExportable (Module _ _ mn ds _) =

6163--

6264resolveExports

6365 :: forall m

64− . (MonadError MultipleErrors m, MonadWriter MultipleErrors m)

65− => Env

66− -> SourceSpan

66+ . (MonadError MultipleErrors m, MonadWriter MultipleErrors m)

67+ => Env

68+ -> SourceSpan

6769 -> ModuleName

6870 -> Imports

6971 -> Exports

7072 -> [DeclarationRef]

7173 -> m Exports

72−resolveExports env ss mn imps exps refs =

73− warnAndRethrow (addHint (ErrorInModule mn)) $ do

74+resolveExports env ss mn imps exps refs =

75+ warnAndRethrow (addHint (ErrorInModule mn)) $ do

7476 filtered <- filterModule mn exps refs

75− exps' <- foldM elaborateModuleExports filtered refs

76− warnDuplicateRefs ss DuplicateExportRef refs

77− return exps'

78−

77+ exps' <- foldM elaborateModuleExports filtered refs

78+ warnDuplicateRefs ss DuplicateExportRef refs

79+ return exps'

80+

7981 where

8082

8183 -- Takes the current module's imports, the accumulated list of exports, and a

@@ -83,19 +85,21 @@ resolveExports env ss mn imps exps refs =

8385 -- module, export anything from the imports that matches for that module.

8486 elaborateModuleExports :: Exports -> DeclarationRef -> m Exports

8587 elaborateModuleExports result (PositionedDeclarationRef pos _ r) =

86− warnAndRethrowWithPosition pos $ elaborateModuleExports result r

88+ warnAndRethrowWithPosition pos $ elaborateModuleExports result r

8789 elaborateModuleExports result (ModuleRef name) | name == mn = do

8890 let types' = exportedTypes result `M.union` exportedTypes exps

8991 let typeOps' = exportedTypeOps result `M.union` exportedTypeOps exps

9092 let classes' = exportedTypeClasses result `M.union` exportedTypeClasses exps

9193 let values' = exportedValues result `M.union` exportedValues exps

9294 let valueOps' = exportedValueOps result `M.union` exportedValueOps exps

95+ let kinds' = exportedKinds result `M.union` exportedKinds exps

9396 return result

9497 { exportedTypes = types'

9598 , exportedTypeOps = typeOps'

9699 , exportedTypeClasses = classes'

97100 , exportedValues = values'

98101 , exportedValueOps = valueOps'

102+ , exportedKinds = kinds'

99103 }

100104 elaborateModuleExports result (ModuleRef name) = do

101105 let isPseudo = isPseudoModule name

@@ -107,11 +111,13 @@ resolveExports env ss mn imps exps refs =

107111 reClasses <- extract isPseudo name TyClassName (importedTypeClasses imps)

108112 reValues <- extract isPseudo name IdentName (importedValues imps)

109113 reValueOps <- extract isPseudo name ValOpName (importedValueOps imps)

114+ reKinds <- extract isPseudo name KiName (importedKinds imps)

110115 foldM (\exps' ((tctor, dctors), mn') -> exportType ReExport exps' tctor dctors mn') result (resolveTypeExports reTypes reDctors)

111116 >>= flip (foldM (uncurry . exportTypeOp)) (map resolveTypeOp reTypeOps)

112117 >>= flip (foldM (uncurry . exportTypeClass ReExport)) (map resolveClass reClasses)

113118 >>= flip (foldM (uncurry . exportValue)) (map resolveValue reValues)

114119 >>= flip (foldM (uncurry . exportValueOp)) (map resolveValueOp reValueOps)

120+ >>= flip (foldM (uncurry . exportKind)) (map resolveKind reKinds)

115121 elaborateModuleExports result _ = return result

116122

117123 -- Extracts a list of values for a module based on a lookup table. If the

@@ -146,6 +152,7 @@ resolveExports env ss mn imps exps refs =

146152 || any (isQualifiedWith mn') (f (importedTypeClasses imps))

147153 || any (isQualifiedWith mn') (f (importedValues imps))

148154 || any (isQualifiedWith mn') (f (importedValueOps imps))

155+ || any (isQualifiedWith mn') (f (importedKinds imps))

149156

150157 -- Check whether a module name refers to a module that has been imported

151158 -- without qualification into an import scope.

@@ -203,6 +210,14 @@ resolveExports env ss mn imps exps refs =

203210 . fromMaybe (internalError "Missing value in resolveValueOp")

204211 $ resolve exportedValueOps op

205212

213+ -- Looks up an imported kind and re-qualifies it with the original

214+ -- module it came from.

215+ resolveKind :: Qualified (ProperName 'KindName) -> (ProperName 'KindName, ModuleName)

216+ resolveKind kind

217+ = splitQual

218+ . fromMaybe (internalError "Missing value in resolveKind")

219+ $ resolve exportedKinds kind

220+

206221 resolve

207222 :: Ord a

208223 => (Exports -> M.Map a ModuleName)

@@ -237,12 +252,14 @@ filterModule mn exps refs = do

237252 classes <- foldM (filterExport TyClassName getTypeClassRef exportedTypeClasses) M.empty refs

238253 values <- foldM (filterExport IdentName getValueRef exportedValues) M.empty refs

239254 valueOps <- foldM (filterExport ValOpName getValueOpRef exportedValueOps) M.empty refs

255+ kinds <- foldM (filterExport KiName getKindRef exportedKinds) M.empty refs

240256 return Exports

241257 { exportedTypes = types

242258 , exportedTypeOps = typeOps

243259 , exportedTypeClasses = classes

244260 , exportedValues = values

245261 , exportedValueOps = valueOps

262+ , exportedKinds = kinds

246263 }

247264

248265 where

src/Language/PureScript/Sugar/Names/Imports.hs+6

@@ -130,6 +130,8 @@ resolveImport importModule exps imps impQual = resolveByType

130130 checkImportExists TyClassName (exportedTypeClasses exps) name

131131 check (ModuleRef name) | isHiding =

132132 throwError . errorMessage $ ImportHidingModule name

133+ check (KindRef name) = do

134+ checkImportExists KiName (exportedKinds exps) name

133135 check r = internalError $ "Invalid argument to checkRefs: " ++ show r

134136

135137 -- Check that an explicitly imported item exists in the module it is being imported from

@@ -181,6 +183,7 @@ resolveImport importModule exps imps impQual = resolveByType

181183 >>= flip (foldM (\m (name, _) -> importer m (ValueRef name))) (M.toList (exportedValues exps))

182184 >>= flip (foldM (\m (name, _) -> importer m (ValueOpRef name))) (M.toList (exportedValueOps exps))

183185 >>= flip (foldM (\m (name, _) -> importer m (TypeClassRef name))) (M.toList (exportedTypeClasses exps))

186+ >>= flip (foldM (\m (name, _) -> importer m (KindRef name))) (M.toList (exportedKinds exps))

184187

185188 importRef :: ImportProvenance -> Imports -> DeclarationRef -> m Imports

186189 importRef prov imp (PositionedDeclarationRef pos _ r) =

@@ -205,6 +208,9 @@ resolveImport importModule exps imps impQual = resolveByType

205208 importRef prov imp (TypeClassRef name) = do

206209 let typeClasses' = updateImports (importedTypeClasses imp) (exportedTypeClasses exps) id name prov

207210 return $ imp { importedTypeClasses = typeClasses' }

211+ importRef prov imp (KindRef name) = do

212+ let kinds' = updateImports (importedKinds imp) (exportedKinds exps) id name prov

213+ return $ imp { importedKinds = kinds' }

208214 importRef _ _ TypeInstanceRef{} = internalError "TypeInstanceRef in importRef"

209215 importRef _ _ ModuleRef{} = internalError "ModuleRef in importRef"

210216 importRef _ _ ReExportRef{} = internalError "ReExportRef in importRef"

src/Language/PureScript/Sugar/TypeClasses/Deriving.hs+161−55

@@ -3,77 +3,102 @@

33--

44module Language.PureScript.Sugar.TypeClasses.Deriving (deriveInstances) where

6−import Prelude.Compat

7−

8−import Control.Arrow (second)

9−import Control.Monad (replicateM)

10−import Control.Monad.Error.Class (MonadError(..))

11−import Control.Monad.Supply.Class (MonadSupply)

12−

13−import Data.List (foldl', find, sortBy, unzip5)

14−import Data.Maybe (fromMaybe)

15−import Data.Ord (comparing)

16−import Data.Text (Text)

17−

18−import Language.PureScript.AST

19−import Language.PureScript.Crash

20−import Language.PureScript.Environment

21−import Language.PureScript.Errors

22−import Language.PureScript.Names

23−import Language.PureScript.Types

24−import Language.PureScript.TypeChecker (checkNewtype)

6+import Prelude.Compat

8+import Control.Arrow (second)

9+import Control.Monad (replicateM, zipWithM)

10+import Control.Monad.Error.Class (MonadError(..))

11+import Control.Monad.Supply.Class (MonadSupply)

12+import Data.List (foldl', find, sortBy, unzip5)

13+import qualified Data.Map as M

14+import Data.Maybe (fromMaybe, mapMaybe)

15+import Data.Ord (comparing)

16+import Data.Text (Text)

17+import Language.PureScript.AST

2518import qualified Language.PureScript.Constants as C

19+import Language.PureScript.Crash

20+import Language.PureScript.Environment

21+import Language.PureScript.Errors

22+import Language.PureScript.Externs

23+import Language.PureScript.Kinds

24+import Language.PureScript.Names

25+import Language.PureScript.Types

26+import Language.PureScript.TypeChecker (checkNewtype)

27+import Language.PureScript.TypeChecker.Synonyms (SynonymMap, replaceAllTypeSynonymsM)

2628

2729-- | Elaborates deriving instance declarations by code generation.

2830deriveInstances

29− :: (MonadError MultipleErrors m, MonadSupply m)

30− => Module

31+ :: forall m

32+ . (MonadError MultipleErrors m, MonadSupply m)

33+ => [ExternsFile]

34+ -> Module

3135 -> m Module

32−deriveInstances (Module ss coms mn ds exts) = Module ss coms mn <$> mapM (deriveInstance mn ds) ds <*> pure exts

36+deriveInstances externs (Module ss coms mn ds exts) =

37+ Module ss coms mn <$> mapM (deriveInstance mn synonyms ds) ds <*> pure exts

38+ where

39+ -- We need to collect type synonym information, since synonyms will not be

40+ -- removed until later, during type checking.

41+ synonyms :: SynonymMap

42+ synonyms =

43+ M.fromList $ (externs >>= \ExternsFile{..} -> mapMaybe (fromExternsDecl efModuleName) efDeclarations)

44+ ++ mapMaybe fromLocalDecl ds

45+ where

46+ fromExternsDecl mn' (EDTypeSynonym name args ty) = Just (Qualified (Just mn') name, (args, ty))

47+ fromExternsDecl _ _ = Nothing

48+

49+ fromLocalDecl (TypeSynonymDeclaration name args ty) = do

50+ Just (Qualified (Just mn) name, (args, ty))

51+ fromLocalDecl (PositionedDeclaration _ _ d) = fromLocalDecl d

52+ fromLocalDecl _ = Nothing

3353

3454-- | Takes a declaration, and if the declaration is a deriving TypeInstanceDeclaration,

3555-- elaborates that into an instance declaration via code generation.

3656deriveInstance

3757 :: (MonadError MultipleErrors m, MonadSupply m)

3858 => ModuleName

59+ -> SynonymMap

3960 -> [Declaration]

4061 -> Declaration

4162 -> m Declaration

42−deriveInstance mn ds (TypeInstanceDeclaration nm deps className tys@[ty] DerivedInstance)

63+deriveInstance mn syns ds (TypeInstanceDeclaration nm deps className tys@[ty] DerivedInstance)

4364 | className == Qualified (Just dataGeneric) (ProperName C.generic)

4465 , Just (Qualified mn' tyCon, args) <- unwrapTypeConstructor ty

4566 , mn == fromMaybe mn mn'

46− = TypeInstanceDeclaration nm deps className tys . ExplicitInstance <$> deriveGeneric mn ds tyCon args

67+ = TypeInstanceDeclaration nm deps className tys . ExplicitInstance <$> deriveGeneric mn syns ds tyCon args

4768 | className == Qualified (Just dataEq) (ProperName "Eq")

4869 , Just (Qualified mn' tyCon, _) <- unwrapTypeConstructor ty

4970 , mn == fromMaybe mn mn'

50− = TypeInstanceDeclaration nm deps className tys . ExplicitInstance <$> deriveEq mn ds tyCon

71+ = TypeInstanceDeclaration nm deps className tys . ExplicitInstance <$> deriveEq mn syns ds tyCon

5172 | className == Qualified (Just dataOrd) (ProperName "Ord")

5273 , Just (Qualified mn' tyCon, _) <- unwrapTypeConstructor ty

5374 , mn == fromMaybe mn mn'

54− = TypeInstanceDeclaration nm deps className tys . ExplicitInstance <$> deriveOrd mn ds tyCon

55−deriveInstance mn ds (TypeInstanceDeclaration nm deps className [wrappedTy, unwrappedTy] DerivedInstance)

75+ = TypeInstanceDeclaration nm deps className tys . ExplicitInstance <$> deriveOrd mn syns ds tyCon

76+ | className == Qualified (Just dataFunctor) (ProperName "Functor")

77+ , Just (Qualified mn' tyCon, _) <- unwrapTypeConstructor ty

78+ , mn == fromMaybe mn mn'

79+ = TypeInstanceDeclaration nm deps className tys . ExplicitInstance <$> deriveFunctor mn syns ds tyCon

80+deriveInstance mn syns ds (TypeInstanceDeclaration nm deps className [wrappedTy, unwrappedTy] DerivedInstance)

5681 | className == Qualified (Just dataNewtype) (ProperName "Newtype")

5782 , Just (Qualified mn' tyCon, args) <- unwrapTypeConstructor wrappedTy

5883 , mn == fromMaybe mn mn'

59− = do (inst, actualUnwrappedTy) <- deriveNewtype mn ds tyCon args unwrappedTy

84+ = do (inst, actualUnwrappedTy) <- deriveNewtype mn syns ds tyCon args unwrappedTy

6085 return $ TypeInstanceDeclaration nm deps className [wrappedTy, actualUnwrappedTy] (ExplicitInstance inst)

61−deriveInstance mn ds (TypeInstanceDeclaration nm deps className [actualTy, repTy] DerivedInstance)

86+deriveInstance mn syns ds (TypeInstanceDeclaration nm deps className [actualTy, repTy] DerivedInstance)

6287 | className == Qualified (Just dataGenericRep) (ProperName C.generic)

6388 , Just (Qualified mn' tyCon, args) <- unwrapTypeConstructor actualTy

6489 , mn == fromMaybe mn mn'

65− = do (inst, inferredRepTy) <- deriveGenericRep mn ds tyCon args repTy

90+ = do (inst, inferredRepTy) <- deriveGenericRep mn syns ds tyCon args repTy

6691 return $ TypeInstanceDeclaration nm deps className [actualTy, inferredRepTy] (ExplicitInstance inst)

67−deriveInstance _ _ (TypeInstanceDeclaration _ _ className tys DerivedInstance)

92+deriveInstance _ _ _ (TypeInstanceDeclaration _ _ className tys DerivedInstance)

6893 = throwError . errorMessage $ CannotDerive className tys

69−deriveInstance mn ds (TypeInstanceDeclaration nm deps className tys@(_ : _) NewtypeInstance)

94+deriveInstance mn syns ds (TypeInstanceDeclaration nm deps className tys@(_ : _) NewtypeInstance)

7095 | Just (Qualified mn' tyCon, args) <- unwrapTypeConstructor (last tys)

7196 , mn == fromMaybe mn mn'

72− = TypeInstanceDeclaration nm deps className tys . NewtypeInstanceWithDictionary <$> deriveNewtypeInstance className ds tys tyCon args

73−deriveInstance _ _ (TypeInstanceDeclaration _ _ className tys NewtypeInstance)

97+ = TypeInstanceDeclaration nm deps className tys . NewtypeInstanceWithDictionary <$> deriveNewtypeInstance syns className ds tys tyCon args

98+deriveInstance _ _ _ (TypeInstanceDeclaration _ _ className tys NewtypeInstance)

7499 = throwError . errorMessage $ InvalidNewtypeInstance className tys

75−deriveInstance mn ds (PositionedDeclaration pos com d) = PositionedDeclaration pos com <$> deriveInstance mn ds d

76−deriveInstance _ _ e = return e

100+deriveInstance mn syns ds (PositionedDeclaration pos com d) = PositionedDeclaration pos com <$> deriveInstance mn syns ds d

101+deriveInstance _ _ _ e = return e

77102

78103unwrapTypeConstructor :: Type -> Maybe (Qualified (ProperName 'TypeName), [Type])

79104unwrapTypeConstructor = fmap (second reverse) . go

@@ -87,13 +112,14 @@ unwrapTypeConstructor = fmap (second reverse) . go

87112deriveNewtypeInstance

88113 :: forall m

89114 . MonadError MultipleErrors m

90− => Qualified (ProperName 'ClassName)

115+ => SynonymMap

116+ -> Qualified (ProperName 'ClassName)

91117 -> [Declaration]

92118 -> [Type]

93119 -> ProperName 'TypeName

94120 -> [Type]

95121 -> m Expr

96−deriveNewtypeInstance className ds tys tyConNm dargs = do

122+deriveNewtypeInstance syns className ds tys tyConNm dargs = do

97123 tyCon <- findTypeDecl tyConNm ds

98124 go tyCon

99125 where

@@ -109,7 +135,8 @@ deriveNewtypeInstance className ds tys tyConNm dargs = do

109135 -- type argument

110136 | Just wrapped' <- stripRight (takeReverse (length tyArgNames - length dargs) tyArgNames) wrapped =

111137 do let subst = zipWith (\(name, _) t -> (name, t)) tyArgNames dargs

112− return (DeferredDictionary className (init tys ++ [replaceAllTypeVars subst wrapped']))

138+ wrapped'' <- replaceAllTypeSynonymsM syns wrapped'

139+ return (DeferredDictionary className (init tys ++ [replaceAllTypeVars subst wrapped'']))

113140 go (PositionedDeclaration _ _ d) = go d

114141 go _ = throwError . errorMessage $ InvalidNewtypeInstance className tys

115142

@@ -143,14 +170,18 @@ dataOrd = ModuleName [ ProperName "Data", ProperName "Ord" ]

143170dataNewtype :: ModuleName

144171dataNewtype = ModuleName [ ProperName "Data", ProperName "Newtype" ]

145172

173+dataFunctor :: ModuleName

174+dataFunctor = ModuleName [ ProperName "Data", ProperName "Functor" ]

175+

146176deriveGeneric

147177 :: forall m. (MonadError MultipleErrors m, MonadSupply m)

148178 => ModuleName

179+ -> SynonymMap

149180 -> [Declaration]

150181 -> ProperName 'TypeName

151182 -> [Type]

152183 -> m [Declaration]

153−deriveGeneric mn ds tyConNm dargs = do

184+deriveGeneric mn syns ds tyConNm dargs = do

154185 tyCon <- findTypeDecl tyConNm ds

155186 toSpine <- mkSpineFunction tyCon

156187 fromSpine <- mkFromSpineFunction tyCon

@@ -174,12 +205,12 @@ deriveGeneric mn ds tyConNm dargs = do

174205 mkCtorClause :: (ProperName 'ConstructorName, [Type]) -> m CaseAlternative

175206 mkCtorClause (ctorName, tys) = do

176207 idents <- replicateM (length tys) freshIdent'

177− return $ CaseAlternative [ConstructorBinder (Qualified (Just mn) ctorName) (map VarBinder idents)] (Right (caseResult idents))

178− where

179− caseResult idents =

180− App (prodConstructor (Literal . StringLiteral . showQualified runProperName $ Qualified (Just mn) ctorName))

181− . Literal . ArrayLiteral

182− $ zipWith toSpineFun (map (Var . Qualified Nothing) idents) tys

208+ tys' <- mapM (replaceAllTypeSynonymsM syns) tys

209+ let caseResult =

210+ App (prodConstructor (Literal . StringLiteral . showQualified runProperName $ Qualified (Just mn) ctorName))

211+ . Literal . ArrayLiteral

212+ $ zipWith toSpineFun (map (Var . Qualified Nothing) idents) tys'

213+ return $ CaseAlternative [ConstructorBinder (Qualified (Just mn) ctorName) (map VarBinder idents)] (Right caseResult)

183214

184215 toSpineFun :: Expr -> Type -> Expr

185216 toSpineFun i r | Just rec <- objectType r =

@@ -314,12 +345,13 @@ deriveGenericRep

314345 :: forall m

315346 . (MonadError MultipleErrors m, MonadSupply m)

316347 => ModuleName

348+ -> SynonymMap

317349 -> [Declaration]

318350 -> ProperName 'TypeName

319351 -> [Type]

320352 -> Type

321353 -> m ([Declaration], Type)

322−deriveGenericRep mn ds tyConNm tyConArgs repTy = do

354+deriveGenericRep mn syns ds tyConNm tyConArgs repTy = do

323355 checkIsWildcard tyConNm repTy

324356 go =<< findTypeDecl tyConNm ds

325357 where

@@ -370,7 +402,8 @@ deriveGenericRep mn ds tyConNm tyConArgs repTy = do

370402 :: (ProperName 'ConstructorName, [Type])

371403 -> m (Type, CaseAlternative, CaseAlternative)

372404 makeInst (ctorName, args) = do

373− (ctorTy, matchProduct, ctorArgs, matchCtor, mkProduct) <- makeProduct args

405+ args' <- mapM (replaceAllTypeSynonymsM syns) args

406+ (ctorTy, matchProduct, ctorArgs, matchCtor, mkProduct) <- makeProduct args'

374407 return ( TypeApp (TypeApp (TypeConstructor constructor)

375408 (TypeLevelString (runProperName ctorName)))

376409 ctorTy

@@ -494,10 +527,11 @@ checkIsWildcard tyConNm _ =

494527deriveEq ::

495528 forall m. (MonadError MultipleErrors m, MonadSupply m)

496529 => ModuleName

530+ -> SynonymMap

497531 -> [Declaration]

498532 -> ProperName 'TypeName

499533 -> m [Declaration]

500−deriveEq mn ds tyConNm = do

534+deriveEq mn syns ds tyConNm = do

501535 tyCon <- findTypeDecl tyConNm ds

502536 eqFun <- mkEqFunction tyCon

503537 return [ ValueDeclaration (Ident C.eq) Public [] (Right eqFun) ]

@@ -527,7 +561,8 @@ deriveEq mn ds tyConNm = do

527561 mkCtorClause (ctorName, tys) = do

528562 identsL <- replicateM (length tys) (freshIdent "l")

529563 identsR <- replicateM (length tys) (freshIdent "r")

530− let tests = zipWith3 toEqTest (map (Var . Qualified Nothing) identsL) (map (Var . Qualified Nothing) identsR) tys

564+ tys' <- mapM (replaceAllTypeSynonymsM syns) tys

565+ let tests = zipWith3 toEqTest (map (Var . Qualified Nothing) identsL) (map (Var . Qualified Nothing) identsR) tys'

531566 return $ CaseAlternative [caseBinder identsL, caseBinder identsR] (Right (conjAll tests))

532567 where

533568 caseBinder idents = ConstructorBinder (Qualified (Just mn) ctorName) (map VarBinder idents)

@@ -546,10 +581,11 @@ deriveEq mn ds tyConNm = do

546581deriveOrd ::

547582 forall m. (MonadError MultipleErrors m, MonadSupply m)

548583 => ModuleName

584+ -> SynonymMap

549585 -> [Declaration]

550586 -> ProperName 'TypeName

551587 -> m [Declaration]

552−deriveOrd mn ds tyConNm = do

588+deriveOrd mn syns ds tyConNm = do

553589 tyCon <- findTypeDecl tyConNm ds

554590 compareFun <- mkCompareFunction tyCon

555591 return [ ValueDeclaration (Ident C.compare) Public [] (Right compareFun) ]

@@ -590,7 +626,8 @@ deriveOrd mn ds tyConNm = do

590626 mkCtorClauses ((ctorName, tys), isLast) = do

591627 identsL <- replicateM (length tys) (freshIdent "l")

592628 identsR <- replicateM (length tys) (freshIdent "r")

593− let tests = zipWith3 toOrdering (map (Var . Qualified Nothing) identsL) (map (Var . Qualified Nothing) identsR) tys

629+ tys' <- mapM (replaceAllTypeSynonymsM syns) tys

630+ let tests = zipWith3 toOrdering (map (Var . Qualified Nothing) identsL) (map (Var . Qualified Nothing) identsR) tys'

594631 extras | not isLast = [ CaseAlternative [ ConstructorBinder (Qualified (Just mn) ctorName) (replicate (length tys) NullBinder)

595632 , NullBinder

596633 ]

@@ -632,12 +669,13 @@ deriveNewtype

632669 :: forall m

633670 . (MonadError MultipleErrors m, MonadSupply m)

634671 => ModuleName

672+ -> SynonymMap

635673 -> [Declaration]

636674 -> ProperName 'TypeName

637675 -> [Type]

638676 -> Type

639677 -> m ([Declaration], Type)

640−deriveNewtype mn ds tyConNm tyConArgs unwrappedTy = do

678+deriveNewtype mn syns ds tyConNm tyConArgs unwrappedTy = do

641679 checkIsWildcard tyConNm unwrappedTy

642680 go =<< findTypeDecl tyConNm ds

643681 where

@@ -649,7 +687,8 @@ deriveNewtype mn ds tyConNm tyConArgs unwrappedTy = do

649687 wrappedIdent <- freshIdent "n"

650688 unwrappedIdent <- freshIdent "a"

651689 let (ctorName, [ty]) = head dctors

652− inst =

690+ ty' <- replaceAllTypeSynonymsM syns ty

691+ let inst =

653692 [ ValueDeclaration (Ident "wrap") Public [] $ Right $

654693 Constructor (Qualified (Just mn) ctorName)

655694 , ValueDeclaration (Ident "unwrap") Public [] $ Right $

@@ -660,7 +699,7 @@ deriveNewtype mn ds tyConNm tyConArgs unwrappedTy = do

660699 ]

661700 ]

662701 subst = zipWith ((,) . fst) args tyConArgs

663− return (inst, replaceAllTypeVars subst ty)

702+ return (inst, replaceAllTypeVars subst ty')

664703 go (PositionedDeclaration _ _ d) = go d

665704 go _ = internalError "deriveNewtype go: expected DataDeclaration"

666705

@@ -702,3 +741,70 @@ decomposeRec :: Type -> [(Text, Type)]

702741decomposeRec = sortBy (comparing fst) . go

703742 where go (RCons str typ typs) = (str, typ) : decomposeRec typs

704743 go _ = []

744+

745+deriveFunctor

746+ :: forall m

747+ . (MonadError MultipleErrors m, MonadSupply m)

748+ => ModuleName

749+ -> SynonymMap

750+ -> [Declaration]

751+ -> ProperName 'TypeName

752+ -> m [Declaration]

753+deriveFunctor mn syns ds tyConNm = do

754+ tyCon <- findTypeDecl tyConNm ds

755+ mapFun <- mkMapFunction tyCon

756+ return [ ValueDeclaration (Ident C.map) Public [] (Right mapFun) ]

757+ where

758+ mkMapFunction :: Declaration -> m Expr

759+ mkMapFunction (DataDeclaration _ _ tys ctors) = case reverse tys of

760+ [] -> throwError . errorMessage $ KindsDoNotUnify (FunKind kindType kindType) kindType

761+ ((iTy, _) : _) -> do

762+ f <- freshIdent "f"

763+ m <- freshIdent "m"

764+ lam f . lamCase m <$> mapM (mkCtorClause iTy f) ctors

765+ mkMapFunction (PositionedDeclaration _ _ d) = mkMapFunction d

766+ mkMapFunction _ = internalError "mkMapFunction: expected DataDeclaration"

767+

768+ mkCtorClause :: Text -> Ident -> (ProperName 'ConstructorName, [Type]) -> m CaseAlternative

769+ mkCtorClause iTyName f (ctorName, ctorTys) = do

770+ idents <- replicateM (length ctorTys) (freshIdent "v")

771+ ctorTys' <- mapM (replaceAllTypeSynonymsM syns) ctorTys

772+ args <- zipWithM transformArg idents ctorTys'

773+ let ctor = Constructor (Qualified (Just mn) ctorName)

774+ rebuilt = foldl App ctor args

775+ caseBinder = ConstructorBinder (Qualified (Just mn) ctorName) (VarBinder <$> idents)

776+ return $ CaseAlternative [caseBinder] (Right rebuilt)

777+ where

778+ fVar = mkVar f

779+ mapVar = mkVarMn (Just dataFunctor) (Ident C.map)

780+

781+ -- TODO: deal with type synonyms, ala https://github.com/purescript/purescript/pull/2516

782+ transformArg :: Ident -> Type -> m Expr

783+ transformArg ident = fmap (foldr App (mkVar ident)) . goType where

784+

785+ goType :: Type -> m (Maybe Expr)

786+ -- argument matches the index type

787+ goType (TypeVar t) | t == iTyName = return (Just fVar)

788+

789+ -- records

790+ goType recTy | Just row <- objectType recTy =

791+ traverse buildUpdate (decomposeRec row) >>= (traverse buildRecord . justUpdates)

792+ where

793+ justUpdates :: [Maybe (Text, Expr)] -> Maybe [(Text, Expr)]

794+ justUpdates = foldMap (fmap return)

795+

796+ buildUpdate :: (Text, Type) -> m (Maybe (Text, Expr))

797+ buildUpdate (lbl, ty) = do upd <- goType ty

798+ return ((lbl,) <$> upd)

799+

800+ buildRecord :: [(Text, Expr)] -> m Expr

801+ buildRecord updates = do arg <- freshIdent "o"

802+ let argVar = mkVar arg

803+ mkAssignment (l, x) = (l, App x (Accessor l argVar))

804+ return (lam arg (ObjectUpdate argVar (mkAssignment <$> updates)))

805+

806+ -- under a `* -> *`, just assume functor for now

807+ goType (TypeApp _ t) = fmap (App mapVar) <$> goType t

808+

809+ -- otherwise do nothing - will fail type checking if type does actually contain index

810+ goType _ = return Nothing

src/Language/PureScript/TypeChecker.hs+34−14

@@ -18,7 +18,7 @@ import Control.Monad.Supply.Class (MonadSupply)

1818import Control.Monad.Writer.Class (MonadWriter(..))

1919import Control.Lens ((^..), _1, _2)

2020

21−import Data.Foldable (for_, traverse_)

21+import Data.Foldable (for_, traverse_, toList)

2222import Data.List (nub, nubBy, (\\), sort, group)

2323import Data.Maybe

2424import qualified Data.Map as M

@@ -274,11 +274,15 @@ typeCheckAll moduleName _ = traverse go

274274 env <- getEnv

275275 putEnv $ env { types = M.insert (Qualified (Just moduleName) name) (kind, ExternData) (types env) }

276276 return d

277+ go (d@(ExternKindDeclaration name)) = do

278+ env <- getEnv

279+ putEnv $ env { kinds = S.insert (Qualified (Just moduleName) name) (kinds env) }

280+ return d

277281 go (d@(ExternDeclaration name ty)) = do

278282 warnAndRethrow (addHint (ErrorInForeignImport name)) $ do

279283 env <- getEnv

280284 kind <- kindOf ty

281− guardWith (errorMessage (ExpectedType ty kind)) $ kind == Star

285+ guardWith (errorMessage (ExpectedType ty kind)) $ kind == kindType

282286 case M.lookup (Qualified (Just moduleName) name) (names env) of

283287 Just _ -> throwError . errorMessage $ RedefinedIdent name

284288 Nothing -> putEnv (env { names = M.insert (Qualified (Just moduleName) name) (ty, External, Defined) (names env) })

@@ -294,7 +298,7 @@ typeCheckAll moduleName _ = traverse go

294298 Nothing -> internalError "typeCheckAll: Encountered unknown type class in instance declaration"

295299 Just typeClass -> do

296300 sequence_ (zipWith (checkTypeClassInstance typeClass) [0..] tys)

297− checkOrphanInstance dictName className tys

301+ checkOrphanInstance dictName className typeClass tys

298302 _ <- traverseTypeInstanceBody checkInstanceMembers body

299303 let dict = TypeClassDictionaryInScope (Qualified (Just moduleName) dictName) [] className tys (Just deps)

300304 addTypeClassDictionaries (Just moduleName) . M.singleton className $ M.singleton (tcdValue dict) dict

@@ -320,19 +324,35 @@ typeCheckAll moduleName _ = traverse go

320324 | otherwise = firstDuplicate xs

321325 firstDuplicate _ = Nothing

322326

323− checkOrphanInstance :: Ident -> Qualified (ProperName 'ClassName) -> [Type] -> m ()

324− checkOrphanInstance dictName className@(Qualified (Just mn') _) tys'

325− | moduleName == mn' || any checkType tys' = return ()

327+ checkOrphanInstance :: Ident -> Qualified (ProperName 'ClassName) -> TypeClassData -> [Type] -> m ()

328+ checkOrphanInstance dictName className@(Qualified (Just mn') _) typeClass tys'

329+ | moduleName == mn' || moduleName `S.member` nonOrphanModules = return ()

326330 | otherwise = throwError . errorMessage $ OrphanInstance dictName className tys'

327331 where

328− checkType :: Type -> Bool

329− checkType (TypeVar _) = False

330− checkType (TypeLevelString _) = False

331− checkType (TypeConstructor (Qualified (Just mn'') _)) = moduleName == mn''

332− checkType (TypeConstructor (Qualified Nothing _)) = internalError "Unqualified type name in checkOrphanInstance"

333− checkType (TypeApp t1 _) = checkType t1

334− checkType _ = internalError "Invalid type in instance in checkOrphanInstance"

335− checkOrphanInstance _ _ _ = internalError "Unqualified class name in checkOrphanInstance"

332+ typeModule :: Type -> Maybe ModuleName

333+ typeModule (TypeVar _) = Nothing

334+ typeModule (TypeLevelString _) = Nothing

335+ typeModule (TypeConstructor (Qualified (Just mn'') _)) = Just mn''

336+ typeModule (TypeConstructor (Qualified Nothing _)) = internalError "Unqualified type name in checkOrphanInstance"

337+ typeModule (TypeApp t1 _) = typeModule t1

338+ typeModule _ = internalError "Invalid type in instance in checkOrphanInstance"

339+

340+ modulesByTypeIndex :: M.Map Int (Maybe ModuleName)

341+ modulesByTypeIndex = M.fromList (zip [0 ..] (typeModule <$> tys'))

342+

343+ lookupModule :: Int -> S.Set ModuleName

344+ lookupModule idx = case M.lookup idx modulesByTypeIndex of

345+ Just ms -> S.fromList (toList ms)

346+ Nothing -> internalError "Unknown type index in checkOrphanInstance"

347+

348+ -- If the instance is declared in a module that wouldn't be found based on a covering set

349+ -- then it is considered an orphan - because we'd have a situation in which we expect an

350+ -- instance but can't find it. So a valid module must be applicable across *all* covering

351+ -- sets - therefore we take the intersection of covering set modules.

352+ nonOrphanModules :: S.Set ModuleName

353+ nonOrphanModules = foldl1 S.intersection (foldMap lookupModule `S.map` typeClassCoveringSets typeClass)

354+

355+ checkOrphanInstance _ _ _ _ = internalError "Unqualified class name in checkOrphanInstance"

336356

337357 -- |

338358 -- This function adds the argument kinds for a type constructor so that they may appear in the externs file,

src/Language/PureScript/TypeChecker/Entailment.hs+33−4

@@ -45,6 +45,10 @@ data Evidence

4545 -- ^ An existing named instance

4646 | IsSymbolInstance Text

4747 -- ^ Computed instance of the IsSymbol type class for a given Symbol literal

48+ | CompareSymbolInstance

49+ -- ^ Computed instance of CompareSymbol

50+ | AppendSymbolInstance

51+ -- ^ Computed instance of AppendSymbol

4852 deriving (Eq)

4953

5054-- | Extract the identifier of a named instance

@@ -138,7 +142,18 @@ entails SolverOptions{..} constraint context hints =

138142 solve constraint

139143 where

140144 forClassName :: InstanceContext -> Qualified (ProperName 'ClassName) -> [Type] -> [TypeClassDict]

141− forClassName _ C.IsSymbol [TypeLevelString sym] = [TypeClassDictionaryInScope (IsSymbolInstance sym) [] C.IsSymbol [TypeLevelString sym] Nothing]

145+ forClassName _ C.IsSymbol [TypeLevelString sym] =

146+ [TypeClassDictionaryInScope (IsSymbolInstance sym) [] C.IsSymbol [TypeLevelString sym] Nothing]

147+ forClassName _ C.CompareSymbol [arg0@(TypeLevelString lhs), arg1@(TypeLevelString rhs), _] =

148+ let ordering = case compare lhs rhs of

149+ LT -> C.orderingLT

150+ EQ -> C.orderingEQ

151+ GT -> C.orderingGT

152+ args = [arg0, arg1, TypeConstructor ordering]

153+ in [TypeClassDictionaryInScope CompareSymbolInstance [] C.CompareSymbol args Nothing]

154+ forClassName _ C.AppendSymbol [arg0@(TypeLevelString lhs), arg1@(TypeLevelString rhs), _] =

155+ let args = [arg0, arg1, TypeLevelString (lhs <> rhs)]

156+ in [TypeClassDictionaryInScope AppendSymbolInstance [] C.AppendSymbol args Nothing]

142157 forClassName ctx cn@(Qualified (Just mn) _) tys = concatMap (findDicts ctx cn) (nub (Nothing : Just mn : map Just (mapMaybe ctorModules tys)))

143158 forClassName _ _ _ = internalError "forClassName: expected qualified class name"

144159

@@ -146,6 +161,7 @@ entails SolverOptions{..} constraint context hints =

146161 ctorModules (TypeConstructor (Qualified (Just mn) _)) = Just mn

147162 ctorModules (TypeConstructor (Qualified Nothing _)) = internalError "ctorModules: unqualified type name"

148163 ctorModules (TypeApp ty _) = ctorModules ty

164+ ctorModules (KindedType ty _) = ctorModules ty

149165 ctorModules _ = Nothing

150166

151167 findDicts :: InstanceContext -> Qualified (ProperName 'ClassName) -> Maybe ModuleName -> [TypeClassDict]

@@ -266,6 +282,7 @@ entails SolverOptions{..} constraint context hints =

266282

267283 canBeGeneralized :: Type -> Bool

268284 canBeGeneralized TUnknown{} = True

285+ canBeGeneralized (KindedType t _) = canBeGeneralized t

269286 canBeGeneralized _ = False

270287

271288 -- |

@@ -291,9 +308,13 @@ entails SolverOptions{..} constraint context hints =

291308 -- Make a dictionary from subgoal dictionaries by applying the correct function

292309 mkDictionary :: Evidence -> Maybe [Expr] -> Expr

293310 mkDictionary (NamedInstance n) args = foldl App (Var n) (fold args)

294− mkDictionary (IsSymbolInstance sym) _ = TypeClassDictionaryConstructorApp C.IsSymbol (Literal (ObjectLiteral fields)) where

295− fields = [ ("reflectSymbol", Abs (Left (Ident C.__unused)) (Literal (StringLiteral sym)))

296− ]

311+ mkDictionary (IsSymbolInstance sym) _ =

312+ let fields = [ ("reflectSymbol", Abs (Left (Ident C.__unused)) (Literal (StringLiteral sym))) ] in

313+ TypeClassDictionaryConstructorApp C.IsSymbol (Literal (ObjectLiteral fields))

314+ mkDictionary CompareSymbolInstance _ =

315+ TypeClassDictionaryConstructorApp C.CompareSymbol (Literal (ObjectLiteral []))

316+ mkDictionary AppendSymbolInstance _ =

317+ TypeClassDictionaryConstructorApp C.AppendSymbol (Literal (ObjectLiteral []))

297318

298319 -- Turn a DictionaryValue into a Expr

299320 subclassDictionaryValue :: Expr -> Qualified (ProperName a) -> Integer -> Expr

@@ -346,6 +367,8 @@ matches deps TypeClassDictionaryInScope{..} tys = do

346367 -- and return a substitution from type variables to types which makes the type heads unify.

347368 --

348369 typeHeadsAreEqual :: Type -> Type -> (Bool, Matching [Type])

370+ typeHeadsAreEqual (KindedType t1 _) t2 = typeHeadsAreEqual t1 t2

371+ typeHeadsAreEqual t1 (KindedType t2 _) = typeHeadsAreEqual t1 t2

349372 typeHeadsAreEqual (TUnknown u1) (TUnknown u2) | u1 == u2 = (True, M.empty)

350373 typeHeadsAreEqual (Skolem _ s1 _ _) (Skolem _ s2 _ _) | s1 == s2 = (True, M.empty)

351374 typeHeadsAreEqual t (TypeVar v) = (True, M.singleton v [t])

@@ -365,6 +388,8 @@ matches deps TypeClassDictionaryInScope{..} tys = do

365388 sd2 = [ (name, t2) | (name, t2) <- s2, name `notElem` map fst s1 ]

366389

367390 go :: [(Text, Type)] -> Type -> [(Text, Type)] -> Type -> (Bool, Matching [Type])

391+ go l (KindedType t1 _) r t2 = go l t1 r t2

392+ go l t1 r (KindedType t2 _) = go l t1 r t2

368393 go [] REmpty [] REmpty = (True, M.empty)

369394 go [] (TUnknown u1) [] (TUnknown u2) | u1 == u2 = (True, M.empty)

370395 go [] (TypeVar v1) [] (TypeVar v2) | v1 == v2 = (True, M.empty)

@@ -386,6 +411,8 @@ matches deps TypeClassDictionaryInScope{..} tys = do

386411 -- which was _not_ solved, i.e. one which was inferred by a functional

387412 -- dependency.

388413 typesAreEqual :: Type -> Type -> Bool

414+ typesAreEqual (KindedType t1 _) t2 = typesAreEqual t1 t2

415+ typesAreEqual t1 (KindedType t2 _) = typesAreEqual t1 t2

389416 typesAreEqual (TUnknown u1) (TUnknown u2) | u1 == u2 = True

390417 typesAreEqual (Skolem _ s1 _ _) (Skolem _ s2 _ _) = s1 == s2

391418 typesAreEqual (TypeVar v1) (TypeVar v2) = v1 == v2

@@ -403,6 +430,8 @@ matches deps TypeClassDictionaryInScope{..} tys = do

403430 in all (uncurry typesAreEqual) int && go sd1 r1' sd2 r2'

404431 where

405432 go :: [(Text, Type)] -> Type -> [(Text, Type)] -> Type -> Bool

433+ go l (KindedType t1 _) r t2 = go l t1 r t2

434+ go l t1 r (KindedType t2 _) = go l t1 r t2

406435 go [] (TUnknown u1) [] (TUnknown u2) | u1 == u2 = True

407436 go [] (Skolem _ s1 _ _) [] (Skolem _ s2 _ _) = s1 == s2

408437 go [] REmpty [] REmpty = True

src/Language/PureScript/TypeChecker/Kinds.hs+13−15

@@ -85,9 +85,7 @@ unifyKinds k1 k2 = do

8585 go (KUnknown u1) (KUnknown u2) | u1 == u2 = return ()

8686 go (KUnknown u) k = solveKind u k

8787 go k (KUnknown u) = solveKind u k

88− go Star Star = return ()

89− go Bang Bang = return ()

90− go Symbol Symbol = return ()

88+ go (NamedKind k1') (NamedKind k2') | k1' == k2' = return ()

9189 go (Row k1') (Row k2') = go k1' k2'

9290 go (FunKind k1' k2') (FunKind k3 k4) = do

9391 go k1' k3

@@ -182,15 +180,15 @@ solveTypes

182180solveTypes isData ts kargs tyCon = do

183181 ks <- traverse (fmap fst . infer) ts

184182 when isData $ do

185− unifyKinds tyCon (foldr FunKind Star kargs)

186− forM_ ks $ \k -> unifyKinds k Star

183+ unifyKinds tyCon (foldr FunKind kindType kargs)

184+ forM_ ks $ \k -> unifyKinds k kindType

187185 unless isData $

188186 unifyKinds tyCon (foldr FunKind (head ks) kargs)

189187 return tyCon

190188

191−-- | Default all unknown kinds to the Star kind of types

189+-- | Default all unknown kinds to the kindType kind of types

192190starIfUnknown :: Kind -> Kind

193−starIfUnknown (KUnknown _) = Star

191+starIfUnknown (KUnknown _) = kindType

194192starIfUnknown (Row k) = Row (starIfUnknown k)

195193starIfUnknown (FunKind k1 k2) = FunKind (starIfUnknown k1) (starIfUnknown k2)

196194starIfUnknown k = k

@@ -211,8 +209,8 @@ infer' (ForAll ident ty _) = do

211209 k1 <- freshKind

212210 Just moduleName <- checkCurrentModule <$> get

213211 (k2, args) <- bindLocalTypeVariables moduleName [(ProperName ident, k1)] $ infer ty

214− unifyKinds k2 Star

215− return (Star, (ident, k1) : args)

212+ unifyKinds k2 kindType

213+ return (kindType, (ident, k1) : args)

216214infer' (KindedType ty k) = do

217215 (k', args) <- infer ty

218216 unifyKinds k k'

@@ -224,14 +222,14 @@ infer' other = (, []) <$> go other

224222 k1 <- freshKind

225223 Just moduleName <- checkCurrentModule <$> get

226224 k2 <- bindLocalTypeVariables moduleName [(ProperName ident, k1)] $ go ty

227− unifyKinds k2 Star

228− return Star

225+ unifyKinds k2 kindType

226+ return kindType

229227 go (KindedType ty k) = do

230228 k' <- go ty

231229 unifyKinds k k'

232230 return k'

233231 go TypeWildcard{} = freshKind

234− go (TypeLevelString _) = return Symbol

232+ go (TypeLevelString _) = return kindSymbol

235233 go (TypeVar v) = do

236234 Just moduleName <- checkCurrentModule <$> get

237235 lookupTypeVariable moduleName (Qualified Nothing (ProperName v))

@@ -260,8 +258,8 @@ infer' other = (, []) <$> go other

260258 go (ConstrainedType deps ty) = do

261259 forM_ deps $ \(Constraint className tys _) -> do

262260 k <- go $ foldl TypeApp (TypeConstructor (fmap coerceProperName className)) tys

263− unifyKinds k Star

261+ unifyKinds k kindType

264262 k <- go ty

265− unifyKinds k Star

266− return Star

263+ unifyKinds k kindType

264+ return kindType

267265 go ty = internalError $ "Invalid argument to infer: " ++ show ty

src/Language/PureScript/TypeChecker/Synonyms.hs+35−20

@@ -4,44 +4,59 @@

44-- Functions for replacing fully applied type synonyms

55--

66module Language.PureScript.TypeChecker.Synonyms

7− ( replaceAllTypeSynonyms

7+ ( SynonymMap

8+ , replaceAllTypeSynonyms

9+ , replaceAllTypeSynonymsM

810 ) where

911

10−import Prelude.Compat

12+import Prelude.Compat

1113

12−import Control.Monad.Error.Class (MonadError(..))

13−import Control.Monad.State

14−

15−import Data.Maybe (fromMaybe)

14+import Control.Monad.Error.Class (MonadError(..))

15+import Control.Monad.State

16+import Data.Maybe (fromMaybe)

1617import qualified Data.Map as M

17−

18−import Language.PureScript.Environment

19−import Language.PureScript.Errors

20−import Language.PureScript.TypeChecker.Monad

21−import Language.PureScript.Types

22−

23−-- |

24−-- Replace fully applied type synonyms.

25−--

26−replaceAllTypeSynonyms' :: Environment -> Type -> Either MultipleErrors Type

27−replaceAllTypeSynonyms' env = everywhereOnTypesTopDownM try

18+import Data.Text (Text)

19+import Language.PureScript.Environment

20+import Language.PureScript.Errors

21+import Language.PureScript.Kinds

22+import Language.PureScript.Names

23+import Language.PureScript.TypeChecker.Monad

24+import Language.PureScript.Types

25+

26+-- | Type synonym information (arguments with kinds, aliased type), indexed by name

27+type SynonymMap = M.Map (Qualified (ProperName 'TypeName)) ([(Text, Maybe Kind)], Type)

28+

29+replaceAllTypeSynonyms'

30+ :: SynonymMap

31+ -> Type

32+ -> Either MultipleErrors Type

33+replaceAllTypeSynonyms' syns = everywhereOnTypesTopDownM try

2834 where

2935 try :: Type -> Either MultipleErrors Type

3036 try t = fromMaybe t <$> go 0 [] t

3137

3238 go :: Int -> [Type] -> Type -> Either MultipleErrors (Maybe Type)

3339 go c args (TypeConstructor ctor)

34− | Just (synArgs, body) <- M.lookup ctor (typeSynonyms env)

40+ | Just (synArgs, body) <- M.lookup ctor syns

3541 , c == length synArgs

3642 = let repl = replaceAllTypeVars (zip (map fst synArgs) args) body

3743 in Just <$> try repl

38− | Just (synArgs, _) <- M.lookup ctor (typeSynonyms env)

44+ | Just (synArgs, _) <- M.lookup ctor syns

3945 , length synArgs > c

4046 = throwError . errorMessage $ PartiallyAppliedSynonym ctor

4147 go c args (TypeApp f arg) = go (c + 1) (arg : args) f

4248 go _ _ _ = return Nothing

4349

50+-- | Replace fully applied type synonyms

4451replaceAllTypeSynonyms :: (e ~ MultipleErrors, MonadState CheckState m, MonadError e m) => Type -> m Type

4552replaceAllTypeSynonyms d = do

4653 env <- getEnv

47− either throwError return $ replaceAllTypeSynonyms' env d

54+ either throwError return $ replaceAllTypeSynonyms' (typeSynonyms env) d

55+

56+-- | Replace fully applied type synonyms by explicitly providing a 'SynonymMap'.

57+replaceAllTypeSynonymsM

58+ :: MonadError MultipleErrors m

59+ => SynonymMap

60+ -> Type

61+ -> m Type

62+replaceAllTypeSynonymsM syns = either throwError pure . replaceAllTypeSynonyms' syns

src/Language/PureScript/TypeChecker/Types.hs+1−1

@@ -240,7 +240,7 @@ checkTypeKind ::

240240 Type ->

241241 Kind ->

242242 m ()

243−checkTypeKind ty kind = guardWith (errorMessage (ExpectedType ty kind)) $ kind == Star

243+checkTypeKind ty kind = guardWith (errorMessage (ExpectedType ty kind)) $ kind == kindType

244244

245245-- | Remove any ForAlls and ConstrainedType constructors in a type by introducing new unknowns

246246-- or TypeClassDictionary values.

tests/Language/PureScript/Ide/Imports/IntegrationSpec.hs+1−1

@@ -28,7 +28,7 @@ outputFileShouldBe :: [Text] -> IO ()

2828outputFileShouldBe expectation = do

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

3030 outRes <- readUTF8FileT outFp

31− shouldBe (T.lines outRes) expectation

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

3232

3333spec :: Spec

3434spec = beforeAll_ setup . describe "Adding imports" $ do

tests/Language/PureScript/Ide/ImportsSpec.hs+2−2

@@ -74,7 +74,7 @@ spec = do

7474 addDtorImport i t mn is =

7575 prettyPrintImportSection (addExplicitImport' (IdeDeclDataConstructor (IdeDataConstructor (P.ProperName i) t wildcard)) mn is)

7676 addTypeImport i mn is =

77− prettyPrintImportSection (addExplicitImport' (IdeDeclType (IdeType (P.ProperName i) P.Star)) mn is)

77+ prettyPrintImportSection (addExplicitImport' (IdeDeclType (IdeType (P.ProperName i) P.kindType)) mn is)

7878 it "adds an implicit unqualified import" $

7979 shouldBe

8080 (addImplicitImport' simpleFileImports (P.moduleNameFromString "Data.Map"))

@@ -143,7 +143,7 @@ spec = do

143143 moduleName = (P.moduleNameFromString "Control.Monad")

144144 addImport imports import' = addExplicitImport' import' moduleName imports

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

146− typeImport name = (IdeDeclType (IdeType (P.ProperName name) P.Star))

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

147147 classImport name = (IdeDeclTypeClass (P.ProperName name))

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

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

tests/Language/PureScript/Ide/ReexportsSpec.hs+1−1

@@ -18,7 +18,7 @@ d = IdeDeclarationAnn emptyAnn

1818

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

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

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

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

2222classA = d (IdeDeclTypeClass (P.ProperName "ClassA"))

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

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

tests/Language/PureScript/Ide/SourceFileSpec.hs+14−10

@@ -6,6 +6,7 @@ import Protolude

77import qualified Language.PureScript as P

88import Language.PureScript.Ide.SourceFile

9+import Language.PureScript.Ide.Types

910import Test.Hspec

1011

1112span0, span1, span2 :: P.SourceSpan

@@ -13,7 +14,7 @@ span0 = P.SourceSpan "ModuleLevel" (P.SourcePos 0 0) (P.SourcePos 1 1)

1314span1 = P.SourceSpan "" (P.SourcePos 1 1) (P.SourcePos 2 2)

1415span2 = P.SourceSpan "" (P.SourcePos 2 2) (P.SourcePos 3 3)

1516

16−typeAnnotation1, value1, synonym1, class1, class2, data1, data2, foreign1, foreign2, member1 :: P.Declaration

17+typeAnnotation1, value1, synonym1, class1, class2, data1, data2, foreign1, foreign2, foreign3, member1 :: P.Declaration

1718typeAnnotation1 = P.TypeDeclaration (P.Ident "value1") P.REmpty

1819value1 = P.ValueDeclaration (P.Ident "value1") P.Public [] (Left [])

1920synonym1 = P.TypeSynonymDeclaration (P.ProperName "Synonym1") [] P.REmpty

@@ -23,28 +24,31 @@ class2 = P.TypeClassDeclaration (P.ProperName "Class2") [] [] []

2324data1 = P.DataDeclaration P.Newtype (P.ProperName "Data1") [] []

2425data2 = P.DataDeclaration P.Data (P.ProperName "Data2") [] [(P.ProperName "Cons1", [])]

2526foreign1 = P.ExternDeclaration (P.Ident "foreign1") P.REmpty

26−foreign2 = P.ExternDataDeclaration (P.ProperName "Foreign2") P.Star

27+foreign2 = P.ExternDataDeclaration (P.ProperName "Foreign2") P.kindType

28+foreign3 = P.ExternKindDeclaration (P.ProperName "Foreign3")

2729member1 = P.TypeDeclaration (P.Ident "member1") P.REmpty

2830

2931spec :: Spec

3032spec = do

3133 describe "Extracting Spans" $ do

3234 it "extracts a span for a value declaration" $

33− extractSpans span0 (P.PositionedDeclaration span1 [] value1) `shouldBe` [(Left "value1", span1)]

35+ extractSpans span0 (P.PositionedDeclaration span1 [] value1) `shouldBe` [(IdeNSValue "value1", span1)]

3436 it "extracts a span for a type synonym declaration" $

35− extractSpans span0 (P.PositionedDeclaration span1 [] synonym1) `shouldBe` [(Right "Synonym1", span1)]

37+ extractSpans span0 (P.PositionedDeclaration span1 [] synonym1) `shouldBe` [(IdeNSType "Synonym1", span1)]

3638 it "extracts a span for a typeclass declaration" $

37− extractSpans span0 (P.PositionedDeclaration span1 [] class1) `shouldBe` [(Right "Class1", span1)]

39+ extractSpans span0 (P.PositionedDeclaration span1 [] class1) `shouldBe` [(IdeNSType "Class1", span1)]

3840 it "extracts spans for a typeclass declaration and its members" $

39− extractSpans span0 (P.PositionedDeclaration span1 [] class2) `shouldBe` [(Right "Class2", span1), (Left "member1", span2)]

41+ extractSpans span0 (P.PositionedDeclaration span1 [] class2) `shouldBe` [(IdeNSType "Class2", span1), (IdeNSValue "member1", span2)]

4042 it "extracts a span for a data declaration" $

41− extractSpans span0 (P.PositionedDeclaration span1 [] data1) `shouldBe` [(Right "Data1", span1)]

43+ extractSpans span0 (P.PositionedDeclaration span1 [] data1) `shouldBe` [(IdeNSType "Data1", span1)]

4244 it "extracts spans for a data declaration and its constructors" $

43− extractSpans span0 (P.PositionedDeclaration span1 [] data2) `shouldBe` [(Right "Data2", span1), (Left "Cons1", span1)]

45+ extractSpans span0 (P.PositionedDeclaration span1 [] data2) `shouldBe` [(IdeNSType "Data2", span1), (IdeNSValue "Cons1", span1)]

4446 it "extracts a span for a foreign declaration" $

45− extractSpans span0 (P.PositionedDeclaration span1 [] foreign1) `shouldBe` [(Left "foreign1", span1)]

47+ extractSpans span0 (P.PositionedDeclaration span1 [] foreign1) `shouldBe` [(IdeNSValue "foreign1", span1)]

4648 it "extracts a span for a data foreign declaration" $

47− extractSpans span0 (P.PositionedDeclaration span1 [] foreign2) `shouldBe` [(Right "Foreign2", span1)]

49+ extractSpans span0 (P.PositionedDeclaration span1 [] foreign2) `shouldBe` [(IdeNSType "Foreign2", span1)]

50+ it "extracts a span for a foreign kind declaration" $

51+ extractSpans span0 (P.PositionedDeclaration span1 [] foreign3) `shouldBe` [(IdeNSKind "Foreign3", span1)]

4852 describe "Type annotations" $ do

4953 it "extracts a type annotation" $

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

tests/Language/PureScript/Ide/StateSpec.hs+2−2

@@ -24,7 +24,7 @@ typeOperator =

2424testModule :: Module

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

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

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

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

2828 , valueOperator Nothing

2929 , ctorOperator Nothing

3030 , typeOperator Nothing

@@ -48,4 +48,4 @@ spec = describe "resolving operators" $ do

4848 it "resolves the type for a constructor operator" $

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

5050 it "resolves the kind for a type operator" $

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

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

tests/Main.hs+2

@@ -13,6 +13,7 @@ import qualified TestDocs

1313import qualified TestPsci

1414import qualified TestPscIde

1515import qualified TestPscPublish

16+import qualified TestPrimDocs

1617import qualified TestUtils

1718

1819import System.IO (hSetEncoding, stdout, stderr, utf8)

@@ -28,6 +29,7 @@ main = do

2829 TestCompiler.main

2930 heading "Documentation test suite"

3031 TestDocs.main

32+ TestPrimDocs.main

3133 heading "psc-publish test suite"

3234 TestPscPublish.main

3335 heading "psci test suite"

tests/TestCompiler.hs+22−17

@@ -61,13 +61,13 @@ main = hspec spec

6161spec :: Spec

6262spec = do

6363

64− (supportExterns, passingTestCases, warningTestCases, failingTestCases) <- runIO $ do

64+ (supportExterns, supportForeigns, passingTestCases, warningTestCases, failingTestCases) <- runIO $ do

6565 cwd <- getCurrentDirectory

6666 let passing = cwd </> "examples" </> "passing"

6767 let warning = cwd </> "examples" </> "warning"

6868 let failing = cwd </> "examples" </> "failing"

6969 let supportDir = cwd </> "tests" </> "support" </> "bower_components"

70− let supportFiles ext = Glob.globDir1 (Glob.compile ("purescript-*/**/*." ++ ext)) supportDir

70+ let supportFiles ext = Glob.globDir1 (Glob.compile ("purescript-*/src/**/*." ++ ext)) supportDir

7171 passingFiles <- getTestFiles passing <$> testGlob passing

7272 warningFiles <- getTestFiles warning <$> testGlob warning

7373 failingFiles <- getTestFiles failing <$> testGlob failing

@@ -77,10 +77,10 @@ spec = do

7777 modules <- ExceptT . return $ P.parseModulesFromFiles id supportPursFiles

7878 foreigns <- inferForeignModules modules

7979 externs <- ExceptT . fmap fst . runTest $ P.make (makeActions foreigns) (map snd modules)

80− return (zip (map snd modules) externs)

80+ return (zip (map snd modules) externs, foreigns)

8181 case supportExterns of

8282 Left errs -> fail (P.prettyPrintMultipleErrors P.defaultPPEOptions errs)

83− Right externs -> return (externs, passingFiles, warningFiles, failingFiles)

83+ Right (externs, foreigns) -> return (externs, foreigns, passingFiles, warningFiles, failingFiles)

8484

8585 outputFile <- runIO $ do

8686 tmp <- getTemporaryDirectory

@@ -90,21 +90,21 @@ spec = do

9090 context "Passing examples" $

9191 forM_ passingTestCases $ \testPurs ->

9292 it ("'" <> takeFileName (getTestMain testPurs) <> "' should compile and run without error") $

93− assertCompiles supportExterns testPurs outputFile

93+ assertCompiles supportExterns supportForeigns testPurs outputFile

9494

9595 context "Warning examples" $

9696 forM_ warningTestCases $ \testPurs -> do

9797 let mainPath = getTestMain testPurs

9898 expectedWarnings <- runIO $ getShouldWarnWith mainPath

9999 it ("'" <> takeFileName mainPath <> "' should compile with warning(s) '" <> intercalate "', '" expectedWarnings <> "'") $

100− assertCompilesWithWarnings supportExterns testPurs expectedWarnings

100+ assertCompilesWithWarnings supportExterns supportForeigns testPurs expectedWarnings

101101

102102 context "Failing examples" $

103103 forM_ failingTestCases $ \testPurs -> do

104104 let mainPath = getTestMain testPurs

105105 expectedFailures <- runIO $ getShouldFailWith mainPath

106106 it ("'" <> takeFileName mainPath <> "' should fail with '" <> intercalate "', '" expectedFailures <> "'") $

107− assertDoesNotCompile supportExterns testPurs expectedFailures

107+ assertDoesNotCompile supportExterns supportForeigns testPurs expectedFailures

108108

109109 where

110110

@@ -197,27 +197,29 @@ runTest = P.runMake P.defaultOptions

197197

198198compile

199199 :: [(P.Module, P.ExternsFile)]

200+ -> M.Map P.ModuleName FilePath

200201 -> [FilePath]

201202 -> ([P.Module] -> IO ())

202203 -> IO (Either P.MultipleErrors [P.ExternsFile], P.MultipleErrors)

203−compile supportExterns inputFiles check = silence $ runTest $ do

204+compile supportExterns supportForeigns inputFiles check = silence $ runTest $ do

204205 fs <- liftIO $ readInput inputFiles

205206 ms <- P.parseModulesFromFiles id fs

206207 foreigns <- inferForeignModules ms

207208 liftIO (check (map snd ms))

208− let actions = makeActions foreigns

209+ let actions = makeActions (foreigns `M.union` supportForeigns)

209210 case ms of

210211 [singleModule] -> pure <$> P.rebuildModule actions (map snd supportExterns) (snd singleModule)

211212 _ -> P.make actions (map fst supportExterns ++ map snd ms)

212213

213214assert

214215 :: [(P.Module, P.ExternsFile)]

216+ -> M.Map P.ModuleName FilePath

215217 -> [FilePath]

216218 -> ([P.Module] -> IO ())

217219 -> (Either P.MultipleErrors P.MultipleErrors -> IO (Maybe String))

218220 -> Expectation

219−assert supportExterns inputFiles check f = do

220− (e, w) <- compile supportExterns inputFiles check

221+assert supportExterns supportForeigns inputFiles check f = do

222+ (e, w) <- compile supportExterns supportForeigns inputFiles check

221223 maybeErr <- f (const w <$> e)

222224 maybe (return ()) expectationFailure maybeErr

223225

@@ -235,11 +237,12 @@ checkShouldFailWith expected errs =

235237

236238assertCompiles

237239 :: [(P.Module, P.ExternsFile)]

240+ -> M.Map P.ModuleName FilePath

238241 -> [FilePath]

239242 -> Handle

240243 -> Expectation

241−assertCompiles supportExterns inputFiles outputFile =

242− assert supportExterns inputFiles checkMain $ \e ->

244+assertCompiles supportExterns supportForeigns inputFiles outputFile =

245+ assert supportExterns supportForeigns inputFiles checkMain $ \e ->

243246 case e of

244247 Left errs -> return . Just . P.prettyPrintMultipleErrors P.defaultPPEOptions $ errs

245248 Right _ -> do

@@ -260,11 +263,12 @@ assertCompiles supportExterns inputFiles outputFile =

260263

261264assertCompilesWithWarnings

262265 :: [(P.Module, P.ExternsFile)]

266+ -> M.Map P.ModuleName FilePath

263267 -> [FilePath]

264268 -> [String]

265269 -> Expectation

266−assertCompilesWithWarnings supportExterns inputFiles shouldWarnWith =

267− assert supportExterns inputFiles checkMain $ \e ->

270+assertCompilesWithWarnings supportExterns supportForeigns inputFiles shouldWarnWith =

271+ assert supportExterns supportForeigns inputFiles checkMain $ \e ->

268272 case e of

269273 Left errs ->

270274 return . Just . P.prettyPrintMultipleErrors P.defaultPPEOptions $ errs

@@ -279,11 +283,12 @@ assertCompilesWithWarnings supportExterns inputFiles shouldWarnWith =

279283

280284assertDoesNotCompile

281285 :: [(P.Module, P.ExternsFile)]

286+ -> M.Map P.ModuleName FilePath

282287 -> [FilePath]

283288 -> [String]

284289 -> Expectation

285−assertDoesNotCompile supportExterns inputFiles shouldFailWith =

286− assert supportExterns inputFiles noPreCheck $ \e ->

290+assertDoesNotCompile supportExterns supportForeigns inputFiles shouldFailWith =

291+ assert supportExterns supportForeigns inputFiles noPreCheck $ \e ->

287292 case e of

288293 Left errs ->

289294 return $ if null shouldFailWith

tests/TestDocs.hs+108−72

@@ -1,18 +1,21 @@

11{-# LANGUAGE RecordWildCards #-}

22{-# LANGUAGE ViewPatterns #-}

33{-# LANGUAGE DataKinds #-}

4+{-# LANGUAGE OverloadedStrings #-}

56module TestDocs where

78import Prelude ()

89import Prelude.Compat

910

10−import Data.Version (Version(..))

11+import Control.Arrow (first)

1112

13+import Data.Version (Version(..))

1214import Data.Monoid

1315import Data.Maybe (fromMaybe)

1416import Data.List ((\\))

1517import Data.Foldable

18+import Data.Text (Text)

1619import qualified Data.Text as T

1720import System.Exit

1821

@@ -22,6 +25,8 @@ import Language.PureScript.Docs.AsMarkdown (codeToString)

2225import qualified Language.PureScript.Publish as Publish

2326import qualified Language.PureScript.Publish.ErrorsWarnings as Publish

2427

28+import Web.Bower.PackageMeta (parsePackageName)

29+

2530import TestUtils

2631

2732publishOpts :: Publish.PublishOptions

@@ -37,7 +42,7 @@ main = pushd "examples/docs" $ do

3742 case res of

3843 Left e -> Publish.printErrorToStdout e >> exitFailure

3944 Right Docs.Package{..} ->

40− forM_ testCases $ \(P.moduleNameFromString . T.pack -> mn, pragmas) ->

45+ forM_ testCases $ \(P.moduleNameFromString -> mn, pragmas) ->

4146 let mdl = takeJust ("module not found in docs: " ++ T.unpack (P.runModuleName mn))

4247 (find ((==) mn . Docs.modName) pkgModules)

4348 in forM_ pragmas (`runAssertionIO` mdl)

@@ -49,25 +54,31 @@ takeJust msg = fromMaybe (error msg)

4954data Assertion

5055 -- | Assert that a particular declaration is documented with the given

5156 -- children

52− = ShouldBeDocumented P.ModuleName String [String]

57+ = ShouldBeDocumented P.ModuleName Text [Text]

5358 -- | Assert that a particular declaration is not documented

54− | ShouldNotBeDocumented P.ModuleName String

59+ | ShouldNotBeDocumented P.ModuleName Text

5560 -- | Assert that a particular declaration exists, but without a particular

5661 -- child.

57− | ChildShouldNotBeDocumented P.ModuleName String String

62+ | ChildShouldNotBeDocumented P.ModuleName Text Text

5863 -- | Assert that a particular declaration has a particular type class

5964 -- constraint.

60− | ShouldBeConstrained P.ModuleName String String

65+ | ShouldBeConstrained P.ModuleName Text Text

6166 -- | Assert that a particular typeclass declaration has a functional

6267 -- dependency list.

63− | ShouldHaveFunDeps P.ModuleName String [([String],[String])]

68+ | ShouldHaveFunDeps P.ModuleName Text [([Text],[Text])]

6469 -- | Assert that a particular value declaration exists, and its type

6570 -- satisfies the given predicate.

66− | ValueShouldHaveTypeSignature P.ModuleName String (ShowFn (P.Type -> Bool))

71+ | ValueShouldHaveTypeSignature P.ModuleName Text (ShowFn (P.Type -> Bool))

6772 -- | Assert that a particular type alias exists, and its corresponding

6873 -- type, when rendered, matches a given string exactly

6974 -- fields: module, type synonym name, expected type

70− | TypeSynonymShouldRenderAs P.ModuleName String String

75+ | TypeSynonymShouldRenderAs P.ModuleName Text Text

76+ -- | Assert that a documented declaration includes a documentation comment

77+ -- containing a particular string

78+ | ShouldHaveDocComment P.ModuleName Text Text

79+ -- | Assert that there should be some declarations re-exported from a

80+ -- particular module in a particular package.

81+ | ShouldHaveReExport (Docs.InPackage P.ModuleName)

7182 deriving (Show)

7283

7384newtype ShowFn a = ShowFn a

@@ -77,28 +88,34 @@ instance Show (ShowFn a) where

7788

7889data AssertionFailure

7990 -- | A declaration was not documented, but should have been

80− = NotDocumented P.ModuleName String

91+ = NotDocumented P.ModuleName Text

8192 -- | A child declaration was not documented, but should have been

82− | ChildrenNotDocumented P.ModuleName String [String]

93+ | ChildrenNotDocumented P.ModuleName Text [Text]

8394 -- | A declaration was documented, but should not have been

84− | Documented P.ModuleName String

95+ | Documented P.ModuleName Text

8596 -- | A child declaration was documented, but should not have been

86− | ChildDocumented P.ModuleName String String

97+ | ChildDocumented P.ModuleName Text Text

8798 -- | A constraint was missing.

88− | ConstraintMissing P.ModuleName String String

99+ | ConstraintMissing P.ModuleName Text Text

89100 -- | A functional dependency was missing.

90− | FunDepMissing P.ModuleName String [([String], [String])]

101+ | FunDepMissing P.ModuleName Text [([Text], [Text])]

91102 -- | A declaration had the wrong "type" (ie, value, type, type class)

92103 -- Fields: declaration title, expected "type", actual "type".

93− | WrongDeclarationType P.ModuleName String String String

104+ | WrongDeclarationType P.ModuleName Text Text Text

94105 -- | A value declaration had the wrong type (in the sense of "type

95106 -- checking"), eg, because the inferred type was used when the explicit type

96107 -- should have been.

97108 -- Fields: module name, declaration name, actual type.

98− | ValueDeclarationWrongType P.ModuleName String P.Type

109+ | ValueDeclarationWrongType P.ModuleName Text P.Type

99110 -- | A Type synonym has been rendered in an unexpected format

100111 -- Fields: module name, declaration name, expected rendering, actual rendering

101− | TypeSynonymMismatch P.ModuleName String String String

112+ | TypeSynonymMismatch P.ModuleName Text Text Text

113+ -- | A doc comment was not found or did not match what was expected

114+ -- Fields: module name, expected substring, actual comments

115+ | DocCommentMissing P.ModuleName Text (Maybe Text)

116+ -- | A module was missing re-exports from a particular module.

117+ -- Fields: module name, expected re-export, actual re-exports.

118+ | ReExportMissing P.ModuleName (Docs.InPackage P.ModuleName) [Docs.InPackage P.ModuleName]

102119 deriving (Show)

103120

104121data AssertionResult

@@ -135,75 +152,84 @@ runAssertion assertion Docs.Module{..} =

135152 Fail (NotDocumented mn decl)

136153

137154 ShouldBeConstrained mn decl tyClass ->

138− case find ((==) decl . Docs.declTitle) (declarationsFor mn) of

139− Nothing ->

140− Fail (NotDocumented mn decl)

141− Just Docs.Declaration{..} ->

142− case declInfo of

143− Docs.ValueDeclaration ty ->

144− if checkConstrained ty tyClass

145− then Pass

146− else Fail (ConstraintMissing mn decl tyClass)

147− _ ->

148− Fail (WrongDeclarationType mn decl "value"

149− (Docs.declInfoToString declInfo))

155+ findDecl mn decl $ \Docs.Declaration{..} ->

156+ case declInfo of

157+ Docs.ValueDeclaration ty ->

158+ if checkConstrained ty tyClass

159+ then Pass

160+ else Fail (ConstraintMissing mn decl tyClass)

161+ _ ->

162+ Fail (WrongDeclarationType mn decl "value"

163+ (Docs.declInfoToString declInfo))

150164

151165 ShouldHaveFunDeps mn decl fds ->

152− case find ((==) decl . Docs.declTitle) (declarationsFor mn) of

153− Nothing ->

154− Fail (NotDocumented mn decl)

155− Just Docs.Declaration{..} ->

156− case declInfo of

157− Docs.TypeClassDeclaration _ _ fundeps ->

158− if fundeps == fds

159− then Pass

160− else Fail (FunDepMissing mn decl fds)

161− _ ->

162− Fail (WrongDeclarationType mn decl "value"

163− (Docs.declInfoToString declInfo))

166+ findDecl mn decl $ \Docs.Declaration{..} ->

167+ case declInfo of

168+ Docs.TypeClassDeclaration _ _ fundeps ->

169+ if fundeps == fds

170+ then Pass

171+ else Fail (FunDepMissing mn decl fds)

172+ _ ->

173+ Fail (WrongDeclarationType mn decl "value"

174+ (Docs.declInfoToString declInfo))

164175

165176 ValueShouldHaveTypeSignature mn decl (ShowFn tyPredicate) ->

166− case find ((==) decl . Docs.declTitle) (declarationsFor mn) of

167− Nothing ->

168− Fail (NotDocumented mn decl)

169− Just Docs.Declaration{..} ->

170− case declInfo of

171− Docs.ValueDeclaration ty ->

172− if tyPredicate ty

173− then Pass

174− else Fail

175− (ValueDeclarationWrongType mn decl ty)

176− _ ->

177− Fail (WrongDeclarationType mn decl "value"

178− (Docs.declInfoToString declInfo))

177+ findDecl mn decl $ \Docs.Declaration{..} ->

178+ case declInfo of

179+ Docs.ValueDeclaration ty ->

180+ if tyPredicate ty

181+ then Pass

182+ else Fail

183+ (ValueDeclarationWrongType mn decl ty)

184+ _ ->

185+ Fail (WrongDeclarationType mn decl "value"

186+ (Docs.declInfoToString declInfo))

179187

180188 TypeSynonymShouldRenderAs mn decl expected ->

181− case find ((==) decl . Docs.declTitle) (declarationsFor mn) of

182− Nothing ->

183− Fail (NotDocumented mn decl)

184− Just Docs.Declaration{..} ->

185− case declInfo of

186− Docs.TypeSynonymDeclaration [] ty ->

187− let actual = codeToString (Docs.renderType ty) in

188− if actual == expected

189− then Pass

190− else Fail (TypeSynonymMismatch mn decl expected actual)

191− _ ->

192− Fail (WrongDeclarationType mn decl "synonym"

193− (Docs.declInfoToString declInfo))

189+ findDecl mn decl $ \Docs.Declaration{..} ->

190+ case declInfo of

191+ Docs.TypeSynonymDeclaration [] ty ->

192+ let actual = codeToString (Docs.renderType ty) in

193+ if actual == expected

194+ then Pass

195+ else Fail (TypeSynonymMismatch mn decl expected actual)

196+ _ ->

197+ Fail (WrongDeclarationType mn decl "synonym"

198+ (Docs.declInfoToString declInfo))

199+

200+ ShouldHaveDocComment mn decl expected ->

201+ findDecl mn decl $ \Docs.Declaration{..} ->

202+ if maybe False (expected `T.isInfixOf`) declComments

203+ then Pass

204+ else Fail (DocCommentMissing mn decl declComments)

205+

206+ ShouldHaveReExport reExp ->

207+ let

208+ reExps = map fst modReExports

209+ in

210+ if reExp `elem` reExps

211+ then Pass

212+ else Fail (ReExportMissing modName reExp reExps)

194213

195214 where

196215 declarationsFor mn =

197216 if mn == modName

198217 then modDeclarations

199− else fromMaybe [] (lookup mn modReExports)

218+ else fromMaybe [] (lookup mn (map (first Docs.ignorePackage) modReExports))

200219

201220 findChildren title =

202221 fmap childrenTitles . find ((==) title . Docs.declTitle)

203222

223+ findDecl mn title f =

224+ case find ((==) title . Docs.declTitle) (declarationsFor mn) of

225+ Nothing ->

226+ Fail (NotDocumented mn title)

227+ Just decl ->

228+ f decl

229+

204230 childrenTitles = map Docs.cdeclTitle . Docs.declChildren

205231

206−checkConstrained :: P.Type -> String -> Bool

232+checkConstrained :: P.Type -> Text -> Bool

207233checkConstrained ty tyClass =

208234 -- Note that we don't recurse on ConstrainedType if none of the constraints

209235 -- match; this is by design, as constraints should be moved to the front

@@ -217,7 +243,7 @@ checkConstrained ty tyClass =

217243 False

218244 where

219245 matches className =

220− (==) className . T.unpack . P.runProperName . P.disqualify . P.constraintClass

246+ (==) className . P.runProperName . P.disqualify . P.constraintClass

221247

222248runAssertionIO :: Assertion -> Docs.Module -> IO ()

223249runAssertionIO assertion mdl = do

@@ -228,7 +254,7 @@ runAssertionIO assertion mdl = do

228254 putStrLn ("Failed: " <> show reason)

229255 exitFailure

230256

231−testCases :: [(String, [Assertion])]

257+testCases :: [(Text, [Assertion])]

232258testCases =

233259 [ ("Example",

234260 [ -- From dependencies

@@ -238,7 +264,12 @@ testCases =

238264 -- From local files

239265 , ShouldBeDocumented (n "Example2") "one" []

240266 , ShouldNotBeDocumented (n "Example2") "two"

267+

268+ -- Re-exports

269+ , ShouldHaveReExport (Docs.FromDep (pkg "purescript-prelude") (n "Prelude"))

270+ , ShouldHaveReExport (Docs.Local (n "Example2"))

241271 ])

272+

242273 , ("Example2",

243274 [ ShouldBeDocumented (n "Example2") "one" []

244275 , ShouldBeDocumented (n "Example2") "two" []

@@ -319,10 +350,15 @@ testCases =

319350 , ValueShouldHaveTypeSignature (n "TypeOpAliases") "test4" (renderedType "forall a b c d. ((a ~> b) ~> c) ~> d")

320351 , ValueShouldHaveTypeSignature (n "TypeOpAliases") "third" (renderedType "forall a b c. a × b × c -> c")

321352 ])

353+

354+ , ("DocComments",

355+ [ ShouldHaveDocComment (n "DocComments") "example" " example == 0"

356+ ])

322357 ]

323358

324359 where

325360 n = P.moduleNameFromString . T.pack

361+ pkg str = let Right p = parsePackageName str in p

326362

327363 hasTypeVar varName =

328364 getAny . P.everythingOnTypes (<>) (Any . isVar varName)

tests/TestPrimDocs.hsnew file+30

@@ -0,0 +1,30 @@

1+module TestPrimDocs where

3+import Control.Monad

4+import Data.List ((\\))

5+import qualified Data.Map as Map

6+import qualified Data.Set as Set

7+import qualified Language.PureScript as P

8+import qualified Language.PureScript.Docs as D

9+import qualified Language.PureScript.Docs.AsMarkdown as D

10+

11+main :: IO ()

12+main = do

13+ putStrLn "Test that there are no bottoms hiding in primDocsModule"

14+ seq (D.runDocs (D.modulesAsMarkdown [D.primDocsModule])) (return ())

15+

16+ putStrLn "Test that Prim is fully documented"

17+ let actualPrimNames =

18+ -- note that prim type classes are listed in P.primTypes

19+ (map (P.runProperName . P.disqualify . fst) $ Map.toList P.primTypes) ++

20+ (map (P.runProperName . P.disqualify) $ Set.toList P.primKinds)

21+ let documentedPrimNames = map D.declTitle (D.modDeclarations D.primDocsModule)

22+

23+ let undocumentedNames = actualPrimNames \\ documentedPrimNames

24+ let extraNames = documentedPrimNames \\ actualPrimNames

25+

26+ when (not (null undocumentedNames)) $

27+ error $ "Undocumented Prim names: " ++ show undocumentedNames

28+

29+ when (not (null extraNames)) $

30+ error $ "Extra Prim names: " ++ show undocumentedNames

tests/TestPscPublish.hs+2−10

@@ -1,20 +1,12 @@

11{-# OPTIONS_GHC -fno-warn-missing-signatures #-}

2−{-# OPTIONS_GHC -fno-warn-unused-imports #-}

32{-# LANGUAGE ScopedTypeVariables #-}

3+{-# LANGUAGE OverloadedStrings #-}

55module TestPscPublish where

7−import Control.Monad

8−import Control.Applicative

9−import Control.Exception

10−import System.Process

11−import System.Directory

12−import System.IO

13−import System.Exit

14−import qualified Data.ByteString.Lazy as BL

7+import System.Exit (exitFailure)

158import Data.ByteString.Lazy (ByteString)

169import qualified Data.Aeson as A

17−import Data.Aeson.BetterErrors

1810import Data.Version

1911

2012import Language.PureScript.Docs

tests/TestUtils.hs+25−2

@@ -57,6 +57,8 @@ supportModules =

5757 , "Control.Alternative"

5858 , "Control.Applicative"

5959 , "Control.Apply"

60+ , "Control.Biapplicative"

61+ , "Control.Biapply"

6062 , "Control.Bind"

6163 , "Control.Category"

6264 , "Control.Comonad"

@@ -72,6 +74,15 @@ supportModules =

7274 , "Control.MonadZero"

7375 , "Control.Plus"

7476 , "Control.Semigroupoid"

77+ , "Data.Bifoldable"

78+ , "Data.Bifunctor"

79+ , "Data.Bifunctor.Clown"

80+ , "Data.Bifunctor.Flip"

81+ , "Data.Bifunctor.Join"

82+ , "Data.Bifunctor.Joker"

83+ , "Data.Bifunctor.Product"

84+ , "Data.Bifunctor.Wrap"

85+ , "Data.Bitraversable"

7586 , "Data.Boolean"

7687 , "Data.BooleanAlgebra"

7788 , "Data.Bounded"

@@ -79,18 +90,24 @@ supportModules =

7990 , "Data.Eq"

8091 , "Data.EuclideanRing"

8192 , "Data.Field"

93+ , "Data.Foldable"

8294 , "Data.Function"

8395 , "Data.Function.Uncurried"

8496 , "Data.Functor"

8597 , "Data.Functor.Invariant"

8698 , "Data.Generic.Rep"

87− , "Data.Generic.Rep.Monoid"

8899 , "Data.Generic.Rep.Eq"

100+ , "Data.Generic.Rep.Monoid"

89101 , "Data.Generic.Rep.Ord"

90102 , "Data.Generic.Rep.Semigroup"

103+ , "Data.Generic.Rep.Show"

91104 , "Data.HeytingAlgebra"

105+ , "Data.Maybe"

106+ , "Data.Maybe.First"

107+ , "Data.Maybe.Last"

92108 , "Data.Monoid"

93109 , "Data.Monoid.Additive"

110+ , "Data.Monoid.Alternate"

94111 , "Data.Monoid.Conj"

95112 , "Data.Monoid.Disj"

96113 , "Data.Monoid.Dual"

@@ -104,8 +121,9 @@ supportModules =

104121 , "Data.Ring"

105122 , "Data.Semigroup"

106123 , "Data.Semiring"

107− , "Data.Symbol"

108124 , "Data.Show"

125+ , "Data.Symbol"

126+ , "Data.Traversable"

109127 , "Data.Unit"

110128 , "Data.Void"

111129 , "Partial"

@@ -113,6 +131,11 @@ supportModules =

113131 , "Prelude"

114132 , "Test.Assert"

115133 , "Test.Main"

134+ , "Type.Data.Ordering"

135+ , "Type.Data.Symbol"

136+ , "Type.Equality"

137+ , "Type.Prelude"

138+ , "Type.Proxy"

116139 , "Unsafe.Coerce"

117140 ]

118141

tests/support/bower.json+11−10

@@ -1,16 +1,17 @@

11{

22 "name": "purescript-test-suite-support",

33 "dependencies": {

4− "purescript-assert": "1.0.0-rc.1",

5− "purescript-console": "1.0.0-rc.1",

6− "purescript-eff": "1.0.0-rc.1",

7− "purescript-functions": "1.0.0-rc.1",

8− "purescript-prelude": "1.1.0",

9− "purescript-st": "1.0.0-rc.1",

4+ "purescript-assert": "2.0.0",

5+ "purescript-console": "2.0.0",

6+ "purescript-eff": "2.0.0",

7+ "purescript-functions": "2.0.0",

8+ "purescript-prelude": "2.1.0",

9+ "purescript-st": "2.0.0",

1010 "purescript-partial": "1.1.2",

11− "purescript-newtype": "0.1.0",

12− "purescript-generics-rep": "2.0.0",

13− "purescript-symbols": "^1.0.1",

14− "purescript-unsafe-coerce": "^1.0.0"

11+ "purescript-newtype": "1.1.0",

12+ "purescript-generics-rep": "4.0.0",

13+ "purescript-symbols": "^2.0.0",

14+ "purescript-typelevel-prelude": "https://github.com/purescript/purescript-typelevel-prelude.git#29a7123a0c29c85d4b923fcf4a7df8e45ebf9bac",

15+ "purescript-unsafe-coerce": "^2.0.0"

1516 }

1617}