git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Merge branch 'master' into pure11
4e33a7eAndy Arvanitis
LICENSE+820−79
@@ -16,6 +16,8 @@ PureScript uses the following Haskell library packages. Their license files foll
16
16
17 Glob
17 Glob
18 SHA
18 SHA
19+ StateVar
20+ adjunctions
19 aeson
21 aeson
20 aeson-better-errors
22 aeson-better-errors
21 aeson-pretty
23 aeson-pretty
@@ -31,7 +33,9 @@ PureScript uses the following Haskell library packages. Their license files foll
31 auto-update
33 auto-update
32 base
34 base
33 base-compat
35 base-compat
36+ base-orphans
34 base64-bytestring
37 base64-bytestring
38+ bifunctors
35 binary
39 binary
36 blaze-builder
40 blaze-builder
37 blaze-html
41 blaze-html
@@ -46,16 +50,19 @@ PureScript uses the following Haskell library packages. Their license files foll
46 cereal
50 cereal
47 clock
51 clock
48 cmdargs
52 cmdargs
53+ comonad
49 conduit
54 conduit
50 conduit-extra
55 conduit-extra
51 connection
56 connection
52 containers
57 containers
58+ contravariant
53 cookie
59 cookie
54 cryptonite
60 cryptonite
55 data-default-class
61 data-default-class
56 data-ordlist
62 data-ordlist
57 deepseq
63 deepseq
58 directory
64 directory
65+ distributive
59 dlist
66 dlist
60 easy-file
67 easy-file
61 edit-distance
68 edit-distance
@@ -65,12 +72,15 @@ PureScript uses the following Haskell library packages. Their license files foll
65 fast-logger
72 fast-logger
66 file-embed
73 file-embed
67 filepath
74 filepath
75+ foldl
76+ free
68 fsnotify
77 fsnotify
69 ghc-prim
78 ghc-prim
70 hashable
79 hashable
71 haskeline
80 haskeline
72 hex
81 hex
73− hfsevents
82+ hinotify
83+ hostname
74 hourglass
84 hourglass
75 http-client
85 http-client
76 http-client-tls
86 http-client-tls
@@ -79,8 +89,11 @@ PureScript uses the following Haskell library packages. Their license files foll
79 http2
89 http2
80 integer-gmp
90 integer-gmp
81 iproute
91 iproute
92+ kan-extensions
82 language-javascript
93 language-javascript
94+ lens
83 lifted-base
95 lifted-base
96+ managed
84 memory
97 memory
85 mime-types
98 mime-types
86 mmorph
99 mmorph
@@ -88,10 +101,12 @@ PureScript uses the following Haskell library packages. Their license files foll
88 monad-logger
101 monad-logger
89 monad-loops
102 monad-loops
90 mtl
103 mtl
104+ mwc-random
91 network
105 network
92 network-uri
106 network-uri
93 old-locale
107 old-locale
94 old-time
108 old-time
109+ optional-args
95 optparse-applicative
110 optparse-applicative
96 parallel
111 parallel
97 parsec
112 parsec
@@ -99,16 +114,20 @@ PureScript uses the following Haskell library packages. Their license files foll
99 pem
114 pem
100 pipes
115 pipes
101 pipes-http
116 pipes-http
117+ prelude-extras
102 primitive
118 primitive
103 process
119 process
120+ profunctors
104 protolude
121 protolude
105 psqueues
122 psqueues
106 random
123 random
124+ reflection
107 regex-base
125 regex-base
108 regex-tdfa
126 regex-tdfa
109 resourcet
127 resourcet
110 safe
128 safe
111 scientific
129 scientific
130+ semigroupoids
112 semigroups
131 semigroups
113 simple-sendfile
132 simple-sendfile
114 socks
133 socks
@@ -120,16 +139,19 @@ PureScript uses the following Haskell library packages. Their license files foll
120 streaming-commons
139 streaming-commons
121 stringsearch
140 stringsearch
122 syb
141 syb
142+ system-fileio
143+ system-filepath
123 tagged
144 tagged
124 template-haskell
145 template-haskell
146+ temporary
125 terminfo
147 terminfo
126 text
148 text
127 time
149 time
128− time-locale-compat
129 tls
150 tls
130 transformers
151 transformers
131 transformers-base
152 transformers-base
132 transformers-compat
153 transformers-compat
154+ turtle
133 unix
155 unix
134 unix-compat
156 unix-compat
135 unix-time
157 unix-time
@@ -215,6 +237,67 @@ SHA LICENSE file:
215 ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
237 ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
216 POSSIBILITY OF SUCH DAMAGE.
238 POSSIBILITY OF SUCH DAMAGE.
217
239
240+StateVar LICENSE file:
241+
242+ Copyright (c) 2014-2015, Edward Kmett
243+ Copyright (c) 2009-2016, Sven Panne
244+ All rights reserved.
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+
274+ Copyright 2011-2014 Edward Kmett
275+
276+ All rights reserved.
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+
218aeson LICENSE file:
301aeson LICENSE file:
219
302
220 Copyright (c) 2011, MailRank, Inc.
303 Copyright (c) 2011, MailRank, Inc.
@@ -762,6 +845,29 @@ base-compat LICENSE file:
762 OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
845 OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
763 THE SOFTWARE.
846 THE SOFTWARE.
764
847
848+base-orphans LICENSE file:
849+
850+ Copyright (c) 2015-2016 Simon Hengel <sol@typeful.net>, João Cristóvão <jmacristovao@gmail.com>, Ryan Scott <ryan.gl.scott@gmail.com>
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+
765base64-bytestring LICENSE file:
871base64-bytestring LICENSE file:
766
872
767 Copyright (c) 2010 Bryan O'Sullivan <bos@serpentine.com>
873 Copyright (c) 2010 Bryan O'Sullivan <bos@serpentine.com>
@@ -795,6 +901,35 @@ base64-bytestring LICENSE file:
795 ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
901 ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
796 POSSIBILITY OF SUCH DAMAGE.
902 POSSIBILITY OF SUCH DAMAGE.
797
903
904+bifunctors LICENSE file:
905+
906+ Copyright 2008-2016 Edward Kmett
907+
908+ All rights reserved.
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+
798binary LICENSE file:
933binary LICENSE file:
799
934
800 Copyright (c) Lennart Kolmodin
935 Copyright (c) Lennart Kolmodin
@@ -1244,6 +1379,36 @@ cmdargs LICENSE file:
1244 (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
1379 (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
1245 OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
1380 OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
1246
1381
1382+comonad LICENSE file:
1383+
1384+ Copyright 2008-2014 Edward Kmett
1385+ Copyright 2004-2008 Dave Menendez
1386+
1387+ All rights reserved.
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+
1247conduit LICENSE file:
1412conduit LICENSE file:
1248
1413
1249 Copyright (c) 2012 Michael Snoyman, http://www.yesodweb.com/
1414 Copyright (c) 2012 Michael Snoyman, http://www.yesodweb.com/
@@ -1354,6 +1519,39 @@ containers LICENSE file:
1354 OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
1519 OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
1355 DAMAGE.
1520 DAMAGE.
1356
1521
1522+contravariant LICENSE file:
1523+
1524+ Copyright 2007-2015 Edward Kmett
1525+
1526+ All rights reserved.
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+
1357cookie LICENSE file:
1555cookie LICENSE file:
1358
1556
1359 Copyright (c) 2010 Michael Snoyman, http://www.yesodweb.com/
1557 Copyright (c) 2010 Michael Snoyman, http://www.yesodweb.com/
@@ -1426,16 +1624,16 @@ data-default-class LICENSE file:
1426 may be used to endorse or promote products derived from this software
1624 may be used to endorse or promote products derived from this software
1427 without specific prior written permission.
1625 without specific prior written permission.
1428
1626
1429− THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
1627+ THIS SOFTWARE IS PROVIDED BY LUKAS MAI AND CONTRIBUTORS "AS IS" AND ANY
1430− ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
1628+ EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
1431 WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
1629 WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
1432− DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE
1630+ DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR ANY
1433− FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
1631+ DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
1434− DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
1632+ (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
1435− SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
1633+ LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON
1436− CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
1634+ ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
1437− OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
1635+ (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
1438− OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
1636+ SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
1439
1637
1440data-ordlist LICENSE file:
1638data-ordlist LICENSE file:
1441
1639
@@ -1558,9 +1756,38 @@ directory LICENSE file:
1558
1756
1559 -----------------------------------------------------------------------------
1757 -----------------------------------------------------------------------------
1560
1758
1759+distributive LICENSE file:
1760+
1761+ Copyright 2011-2016 Edward Kmett
1762+
1763+ All rights reserved.
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+
1561dlist LICENSE file:
1788dlist LICENSE file:
1562
1789
1563− Copyright (c) 2006-2009 Don Stewart, 2013-2016 Sean Leather
1790+ Copyright (c) 2006-2009 Don Stewart, 2013-2014 Sean Leather
1564
1791
1565 All rights reserved.
1792 All rights reserved.
1566
1793
@@ -1842,6 +2069,66 @@ filepath LICENSE file:
1842 (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
2069 (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
1843 OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
2070 OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
1844
2071
2072+foldl LICENSE file:
2073+
2074+ Copyright (c) 2013 Gabriel Gonzalez
2075+ All rights reserved.
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+
2101+ Copyright 2008-2013 Edward Kmett
2102+
2103+ All rights reserved.
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+
1845fsnotify LICENSE file:
2132fsnotify LICENSE file:
1846
2133
1847 Copyright (c) 2012, Mark Dittmer
2134 Copyright (c) 2012, Mark Dittmer
@@ -2001,40 +2288,93 @@ haskeline LICENSE file:
2001
2288
2002hex LICENSE file:
2289hex LICENSE file:
2003
2290
2004− Page not found: Sorry, it's just not here.
2291+ Copyright (c) 2008, Taru Karttunen
2292+ All rights reserved.
2005
2293
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.
2007
2320
2008− Copyright (c) 2012, Luite Stegeman
2321+hinotify LICENSE file:
2322+
2323+ Copyright (c) Lennart Kolmodin
2009
2324
2010 All rights reserved.
2325 All rights reserved.
2011
2326
2012 Redistribution and use in source and binary forms, with or without
2327 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:
2014
2330
2015− * Redistributions of source code must retain the above copyright
2331+ 1. Redistributions of source code must retain the above copyright
2016− notice, this list of conditions and the following disclaimer.
2332+ notice, this list of conditions and the following disclaimer.
2017
2333
2018− * Redistributions in binary form must reproduce the above
2334+ 2. Redistributions in binary form must reproduce the above copyright
2019− copyright notice, this list of conditions and the following
2335+ notice, this list of conditions and the following disclaimer in the
2020− disclaimer in the documentation and/or other materials provided
2336+ documentation and/or other materials provided with the distribution.
2021− with the distribution.
2022
2337
2023− * Neither the name of Luite Stegeman nor the names of other
2338+ 3. Neither the name of the author nor the names of his contributors
2024− contributors may be used to endorse or promote products derived
2339+ may be used to endorse or promote products derived from this software
2025− from this software without specific prior written permission.
2340+ without specific prior written permission.
2026
2341
2027− THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
2342+ THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS
2028− "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
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+
2356+ Copyright (c) 2008, Maximilian Bolingbroke
2357+ All rights reserved.
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
2029− LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
2371+ IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
2030− A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
2372+ FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR
2031− OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
2373+ CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
2032− SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
2033− LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
2374+ DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
2034− DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
2375+ DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER
2035− THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
2036− (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
2376+ IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT
2037− OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
2377+ OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
2038
2378
2039hourglass LICENSE file:
2379hourglass LICENSE file:
2040
2380
@@ -2275,6 +2615,39 @@ iproute LICENSE file:
2275 ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
2615 ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
2276 POSSIBILITY OF SUCH DAMAGE.
2616 POSSIBILITY OF SUCH DAMAGE.
2277
2617
2618+kan-extensions LICENSE file:
2619+
2620+ Copyright 2008-2013 Edward Kmett
2621+
2622+ All rights reserved.
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+
2278language-javascript LICENSE file:
2651language-javascript LICENSE file:
2279
2652
2280 Copyright (c)2010, Alan Zimmerman
2653 Copyright (c)2010, Alan Zimmerman
@@ -2308,6 +2681,39 @@ language-javascript LICENSE file:
2308 (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
2681 (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
2309 OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
2682 OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
2310
2683
2684+lens LICENSE file:
2685+
2686+ Copyright 2012-2015 Edward Kmett
2687+
2688+ All rights reserved.
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+
2311lifted-base LICENSE file:
2717lifted-base LICENSE file:
2312
2718
2313 Copyright © 2010-2012, Bas van Dijk, Anders Kaseorg
2719 Copyright © 2010-2012, Bas van Dijk, Anders Kaseorg
@@ -2340,6 +2746,33 @@ lifted-base LICENSE file:
2340 (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
2746 (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
2341 OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
2747 OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
2342
2748
2749+managed LICENSE file:
2750+
2751+ Copyright (c) 2014 Gabriel Gonzalez
2752+ All rights reserved.
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+
2343memory LICENSE file:
2776memory LICENSE file:
2344
2777
2345 Copyright (c) 2015 Vincent Hanquez <vincent@snarc.org>
2778 Copyright (c) 2015 Vincent Hanquez <vincent@snarc.org>
@@ -2477,10 +2910,6 @@ monad-logger LICENSE file:
2477 OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
2910 OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
2478 WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
2911 WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
2479
2912
2480−monad-loops LICENSE file:
2481−
2482− Page not found: Sorry, it's just not here.
2483−
2484mtl LICENSE file:
2913mtl LICENSE file:
2485
2914
2486 The Glasgow Haskell Compiler License
2915 The Glasgow Haskell Compiler License
@@ -2515,6 +2944,35 @@ mtl LICENSE file:
2515 OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
2944 OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
2516 DAMAGE.
2945 DAMAGE.
2517
2946
2947+mwc-random LICENSE file:
2948+
2949+ Copyright (c) 2009, Bryan O'Sullivan
2950+ All rights reserved.
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+
2518network LICENSE file:
2976network LICENSE file:
2519
2977
2520 Copyright (c) 2002-2010, The University Court of the University of Glasgow.
2978 Copyright (c) 2002-2010, The University Court of the University of Glasgow.
@@ -2711,6 +3169,33 @@ old-time LICENSE file:
2711
3169
2712 -----------------------------------------------------------------------------
3170 -----------------------------------------------------------------------------
2713
3171
3172+optional-args LICENSE file:
3173+
3174+ Copyright (c) 2015 Gabriel Gonzalez
3175+ All rights reserved.
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+
2714optparse-applicative LICENSE file:
3199optparse-applicative LICENSE file:
2715
3200
2716 Copyright (c) 2012, Paolo Capriotti
3201 Copyright (c) 2012, Paolo Capriotti
@@ -2865,7 +3350,7 @@ pem LICENSE file:
2865
3350
2866pipes LICENSE file:
3351pipes LICENSE file:
2867
3352
2868− Copyright (c) 2012-2016 Gabriel Gonzalez
3353+ Copyright (c) 2012-2014 Gabriel Gonzalez
2869 All rights reserved.
3354 All rights reserved.
2870
3355
2871 Redistribution and use in source and binary forms, with or without modification,
3356 Redistribution and use in source and binary forms, with or without modification,
@@ -2917,6 +3402,39 @@ pipes-http LICENSE file:
2917 (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
3402 (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
2918 SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
3403 SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
2919
3404
3405+prelude-extras LICENSE file:
3406+
3407+ Copyright 2011-2016 Edward Kmett
3408+
3409+ All rights reserved.
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+
2920primitive LICENSE file:
3438primitive LICENSE file:
2921
3439
2922 Copyright (c) 2008-2009, Roman Leshchinskiy
3440 Copyright (c) 2008-2009, Roman Leshchinskiy
@@ -3016,6 +3534,39 @@ process LICENSE file:
3016
3534
3017 -----------------------------------------------------------------------------
3535 -----------------------------------------------------------------------------
3018
3536
3537+profunctors LICENSE file:
3538+
3539+ Copyright 2011-2015 Edward Kmett
3540+
3541+ All rights reserved.
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+
3019protolude LICENSE file:
3570protolude LICENSE file:
3020
3571
3021 Copyright (c) 2016, Stephen Diehl
3572 Copyright (c) 2016, Stephen Diehl
@@ -3138,6 +3689,40 @@ random LICENSE file:
3138
3689
3139 -----------------------------------------------------------------------------
3690 -----------------------------------------------------------------------------
3140
3691
3692+reflection LICENSE file:
3693+
3694+ Copyright (c) 2009-2013 Edward Kmett
3695+ Copyright (c) 2004 Oleg Kiselyov and Chung-chieh Shan
3696+ All rights reserved.
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+
3141regex-base LICENSE file:
3726regex-base LICENSE file:
3142
3727
3143 This modile is under this "3 clause" BSD license:
3728 This modile is under this "3 clause" BSD license:
@@ -3203,7 +3788,7 @@ resourcet LICENSE file:
3203
3788
3204safe LICENSE file:
3789safe LICENSE file:
3205
3790
3206− Copyright Neil Mitchell 2007-2015.
3791+ Copyright Neil Mitchell 2007-2016.
3207 All rights reserved.
3792 All rights reserved.
3208
3793
3209 Redistribution and use in source and binary forms, with or without
3794 Redistribution and use in source and binary forms, with or without
@@ -3267,6 +3852,35 @@ scientific LICENSE file:
3267 (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
3852 (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
3268 OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
3853 OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
3269
3854
3855+semigroupoids LICENSE file:
3856+
3857+ Copyright 2011-2015 Edward Kmett
3858+
3859+ All rights reserved.
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+
3270semigroups LICENSE file:
3884semigroups LICENSE file:
3271
3885
3272 Copyright 2011-2015 Edward Kmett
3886 Copyright 2011-2015 Edward Kmett
@@ -3552,7 +4166,36 @@ streaming-commons LICENSE file:
3552
4166
3553stringsearch LICENSE file:
4167stringsearch LICENSE file:
3554
4168
3555− Page not found: Sorry, it's just not here.
4169+ Copyright (c)2010, Daniel Fischer
4170+
4171+ All rights reserved.
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.
3556
4199
3557syb LICENSE file:
4200syb LICENSE file:
3558
4201
@@ -3640,6 +4283,56 @@ syb LICENSE file:
3640
4283
3641 -----------------------------------------------------------------------------
4284 -----------------------------------------------------------------------------
3642
4285
4286+system-fileio LICENSE file:
4287+
4288+ Copyright (c) 2011 John Millikin
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+
4313+ Copyright (c) 2010 John Millikin
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+
3643tagged LICENSE file:
4336tagged LICENSE file:
3644
4337
3645 Copyright (c) 2009-2015 Edward Kmett
4338 Copyright (c) 2009-2015 Edward Kmett
@@ -3709,6 +4402,31 @@ template-haskell LICENSE file:
3709 DAMAGE.
4402 DAMAGE.
3710
4403
3711
4404
4405+temporary LICENSE file:
4406+
4407+ Copyright (c) 2008, Maximilian Bolingbroke
4408+ All rights reserved.
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+
3712terminfo LICENSE file:
4430terminfo LICENSE file:
3713
4431
3714 Copyright 2007, Judah Jacobson.
4432 Copyright 2007, Judah Jacobson.
@@ -3777,39 +4495,6 @@ time LICENSE file:
3777
4495
3778 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.
4496 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.
3779
4497
3780−time-locale-compat LICENSE file:
3781−
3782− Copyright (c) 2014, Kei Hibino
3783−
3784− All rights reserved.
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−
3813tls LICENSE file:
4498tls LICENSE file:
3814
4499
3815 Copyright (c) 2010-2015 Vincent Hanquez <vincent@snarc.org>
4500 Copyright (c) 2010-2015 Vincent Hanquez <vincent@snarc.org>
@@ -3906,7 +4591,7 @@ transformers-base LICENSE file:
3906
4591
3907transformers-compat LICENSE file:
4592transformers-compat LICENSE file:
3908
4593
3909− Copyright 2012-2015 Edward Kmett
4594+ Copyright 2012 Edward Kmett
3910
4595
3911 All rights reserved.
4596 All rights reserved.
3912
4597
@@ -3937,6 +4622,33 @@ transformers-compat LICENSE file:
3937 ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
4622 ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
3938 POSSIBILITY OF SUCH DAMAGE.
4623 POSSIBILITY OF SUCH DAMAGE.
3939
4624
4625+turtle LICENSE file:
4626+
4627+ Copyright (c) 2015 Gabriel Gonzalez
4628+ All rights reserved.
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+
3940unix LICENSE file:
4652unix LICENSE file:
3941
4653
3942 The Glasgow Haskell Compiler License
4654 The Glasgow Haskell Compiler License
@@ -4343,7 +5055,36 @@ warp LICENSE file:
4343
5055
4344websockets LICENSE file:
5056websockets LICENSE file:
4345
5057
4346− Page not found: Sorry, it's just not here.
5058+ Copyright Jasper Van der Jeugt, 2011
5059+
5060+ All rights reserved.
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.
4347
5088
4348word8 LICENSE file:
5089word8 LICENSE file:
4349
5090
@@ -4499,7 +5240,7 @@ x509-validation LICENSE file:
4499
5240
4500zlib LICENSE file:
5241zlib LICENSE file:
4501
5242
4502− Copyright (c) 2006-2015, Duncan Coutts
5243+ Copyright (c) 2006-2016, Duncan Coutts
4503 All rights reserved.
5244 All rights reserved.
4504
5245
4505 Redistribution and use in source and binary forms, with or without
5246 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
4
4
5[![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)
5[![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)
6
6
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−
11## Language info
7## Language info
12
8
13- [PureScript home](http://purescript.org)
9- [PureScript home](http://purescript.org)
examples/docs/src/DocComments.pursnew file+11
@@ -0,0 +1,11 @@
1+module DocComments where
2+
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
3+
4+import DiffKindsSameName.LibA as LibA
5+import DiffKindsSameName.LibB as LibB
6+
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
2+
3+foreign import kind DemoKind
4+
examples/failing/DiffKindsSameName/LibB.pursnew file+6
@@ -0,0 +1,6 @@
1+module DiffKindsSameName.LibB where
2+
3+foreign import kind DemoKind
4+
5+foreign import data DemoData :: DemoKind
6+
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)
4
4
5import Data.Newtype
5import Data.Newtype
6
6
7+type MyString = String
8+
7−newtype Test = Test String
9+newtype Test = Test MyString
8
10
9derive instance newtypeTest :: Newtype Test _
11derive instance newtypeTest :: Newtype Test _
10
12
examples/passing/DeriveWithNestedSynonyms.pursnew file+29
@@ -0,0 +1,29 @@
1+module Main where
2+
3+import Prelude
4+import Control.Monad.Eff.Console (log)
5+
6+type L = {}
7+data X = X L
8+derive instance eqX :: Eq X
9+
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
10
10
11derive instance ordV :: Ord V
11derive instance ordV :: Ord V
12
12
13+type MyString = String
14+
13−data X = X Int | Y String
15+data X = X Int | Y MyString
14
16
15derive instance eqX :: Eq X
17derive instance eqX :: Eq X
16
18
examples/passing/DerivingFunctor.pursnew file+28
@@ -0,0 +1,28 @@
1+module Main where
2+
3+import Prelude
4+import Control.Monad.Eff.Console (log)
5+import Test.Assert
6+
7+type MyRecord a = { myField :: a }
8+
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
2+
3+import Prelude
4+import Control.Monad.Eff
5+import Control.Monad.Eff.Console
6+
7+test x = show (x :: _ :: *)
8+
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
2+
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)
6+
7+proxy1Add2Is3 :: NatProxy N3
8+proxy1Add2Is3 = addNat proxy1 proxy2
9+
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
2+
3+-- declaration
4+
5+foreign import kind Nat
6+
7+-- use in foreign data
8+
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 _
27instance eqZ :: Eq Z where
27instance eqZ :: Eq Z where
28 eq x y = genericEq x y
28 eq x y = genericEq x y
29
29
30+type MyString = String
31+
30−newtype W = W { x :: Int, y :: String }
32+newtype W = W { x :: Int, y :: MyString }
31
33
32derive instance genericW :: Generic W _
34derive instance genericW :: Generic W _
33
35
examples/passing/HasOwnProperty.pursnew file+5
@@ -0,0 +1,5 @@
1+module Main where
2+
3+import Control.Monad.Eff.Console (log)
4+
5+main = log ({hasOwnProperty: "Hi"} {hasOwnProperty = "Done"}).hasOwnProperty
examples/passing/NewtypeInstance.purs+3−1
@@ -4,7 +4,9 @@ import Prelude
4import Control.Monad.Eff
4import Control.Monad.Eff
5import Control.Monad.Eff.Console
5import Control.Monad.Eff.Console
6
6
7+type MyString = String
8+
7−newtype X = X String
9+newtype X = X MyString
8
10
9derive newtype instance showX :: Show X
11derive newtype instance showX :: Show X
10
12
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
2+
3+import Prelude
4+import Control.Monad.Eff.Console (log)
5+import Type.Data.Symbol (SProxy(..), class AppendSymbol, appendSymbol, reflectSymbol)
6+
7+sym :: SProxy ""
8+sym = SProxy
9+
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
2+
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)
7+
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 #-}
1-- |
2-- |
2-- A small script which regenerates the LICENSE file with all
3-- A small script which regenerates the LICENSE file with all
3-- dependencies' licenses, when the dependencies are provided via standard
4-- dependencies' licenses, when the dependencies are provided via standard
@@ -5,42 +6,167 @@
5--
6--
6-- It is recommended to run this as follows:
7-- It is recommended to run this as follows:
7--
8--
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
9--
10--
10
11
11module Main (main) where
12module Main (main) where
12
13
13−import Control.Monad (forM_)
14+import Control.Monad (forM_, when)
14−import Data.Char (isSpace)
15+import Data.Char (isSpace, toLower)
16+import Data.Maybe (mapMaybe)
15import Data.List
17import 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)
17import System.IO (hPutStrLn, stderr, getContents)
27import 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
18
50
19echoHeader :: IO ()
51echoHeader :: IO ()
20echoHeader =
52echoHeader =
21− readFile "license-generator/header.txt" >>= putStr
53+ readFile "license-generator/header.txt" >>= putStr
22−
54+
23−depsNames :: IO [String]
55+depsNamesAndVersions :: IO [(String, String)]
24−depsNames =
56+depsNamesAndVersions = do
57+ contents <- lines <$> getContents
58+ deps <- traverse parse contents
25− fmap (filter (/= "purescript") . lines) getContents
59+ pure (filter ((/= "purescript") . fst) deps)
26−
60+
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
35 where
61 where
36− f = unlines . map (trimEnd . (" " ++)) . lines
62+ parse line =
37− trimEnd = reverse . dropWhile isSpace . reverse
63+ case splitOn " " line of
64+ [pkg, vers] -> pure (pkg, vers)
65+ _ -> fail $ "Unable to parse input line: " ++ line
38
66
39−main :: IO ()
67+-- Returns True on success, False on failure.
40−main = do
68+depsLicense :: Manager -> (String, String) -> IO Bool
41− deps <-depsNames
69+depsLicense manager dep = do
42− echoHeader
70+ hPutStrLn stderr (fst dep)
43− putStrLn ""
71+ result <- downloadLicenseFromHackage manager dep
44− forM_ deps $ \d -> putStr " " >> putStrLn d
72+ case result of
45− putStrLn ""
73+ FoundLicense license -> do
46− forM_ deps depsLicense
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
9import Data.Traversable (for)
9import Data.Traversable (for)
10import Data.Version (showVersion)
10import Data.Version (showVersion)
11import Data.Monoid ((<>))
11import Data.Monoid ((<>))
12+import Data.Aeson (encode)
13+import Data.Maybe (isNothing)
12
14
13import Control.Applicative
15import Control.Applicative
14import Control.Monad
16import Control.Monad
@@ -16,12 +18,15 @@ import Control.Monad.Error.Class
16import Control.Monad.Trans.Except
18import Control.Monad.Trans.Except
17import Control.Monad.IO.Class
19import Control.Monad.IO.Class
18
20
19−import System.FilePath (takeDirectory)
21+import System.FilePath (takeDirectory, (</>), (<.>), takeFileName)
20import System.FilePath.Glob (glob)
22import System.FilePath.Glob (glob)
21import System.Exit (exitFailure)
23import System.Exit (exitFailure)
22import System.IO (stderr, stdout, hPutStrLn, hSetEncoding, utf8)
24import System.IO (stderr, stdout, hPutStrLn, hSetEncoding, utf8)
23import System.IO.UTF8 (readUTF8File, writeUTF8File)
25import 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
25
30
26import Language.PureScript.Bundle
31import Language.PureScript.Bundle
27
32
@@ -30,6 +35,9 @@ import qualified Options.Applicative as Opts
30
35
31import qualified Paths_purescript as Paths
36import qualified Paths_purescript as Paths
32
37
38+import SourceMap
39+import SourceMap.Types
40+
33-- | Command line options.
41-- | Command line options.
34data Options = Options
42data Options = Options
35 { optionsInputFiles :: [FilePath]
43 { optionsInputFiles :: [FilePath]
@@ -37,25 +45,32 @@ data Options = Options
37 , optionsEntryPoints :: [String]
45 , optionsEntryPoints :: [String]
38 , optionsMainModule :: Maybe String
46 , optionsMainModule :: Maybe String
39 , optionsNamespace :: String
47 , optionsNamespace :: String
48+ , optionsSourceMaps :: Bool
40 } deriving Show
49 } deriving Show
41
50
42-- | The main application function.
51-- | The main application function.
43-- This function parses the input files, performs dead code elimination, filters empty modules
52-- This function parses the input files, performs dead code elimination, filters empty modules
44-- and generates and prints the final Javascript bundle.
53-- 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)
46app Options{..} = do
55app Options{..} = do
47 inputFiles <- concat <$> mapM (liftIO . glob) optionsInputFiles
56 inputFiles <- concat <$> mapM (liftIO . glob) optionsInputFiles
48 when (null inputFiles) . liftIO $ do
57 when (null inputFiles) . liftIO $ do
49 hPutStrLn stderr "psc-bundle: No input files."
58 hPutStrLn stderr "psc-bundle: No input files."
50 exitFailure
59 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+
51 input <- for inputFiles $ \filename -> do
64 input <- for inputFiles $ \filename -> do
52 js <- liftIO (readUTF8File filename)
65 js <- liftIO (readUTF8File filename)
53 mid <- guessModuleIdentifier filename
66 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
55
68
56 let entryIds = map (`ModuleIdentifier` Regular) optionsEntryPoints
69 let entryIds = map (`ModuleIdentifier` Regular) optionsEntryPoints
57
70
71+ currentDir <- liftIO getCurrentDirectory
72+ let outFile = if optionsSourceMaps then fmap (currentDir </>) optionsOutputFile else Nothing
58− bundle input entryIds optionsMainModule optionsNamespace
73+ bundleSM input entryIds optionsMainModule optionsNamespace outFile
59
74
60-- | Command line options parser.
75-- | Command line options parser.
61options :: Parser Options
76options :: Parser Options
@@ -64,6 +79,7 @@ options = Options <$> some inputFile
64 <*> many entryPoint
79 <*> many entryPoint
65 <*> optional mainModule
80 <*> optional mainModule
66 <*> namespace
81 <*> namespace
82+ <*> sourceMaps
67 where
83 where
68 inputFile :: Parser FilePath
84 inputFile :: Parser FilePath
69 inputFile = Opts.strArgument $
85 inputFile = Opts.strArgument $
@@ -95,6 +111,11 @@ options = Options <$> some inputFile
95 <> Opts.showDefault
111 <> Opts.showDefault
96 <> Opts.help "Specify the namespace that PureScript modules will be exported to when running in the browser."
112 <> Opts.help "Specify the namespace that PureScript modules will be exported to when running in the browser."
97
113
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+
98-- | Make it go.
119-- | Make it go.
99main :: IO ()
120main :: IO ()
100main = do
121main = do
@@ -106,11 +127,15 @@ main = do
106 Left err -> do
127 Left err -> do
107 hPutStrLn stderr (unlines (printErrorMessage err))
128 hPutStrLn stderr (unlines (printErrorMessage err))
108 exitFailure
129 exitFailure
109− Right js ->
130+ Right (sourcemap, js) ->
110 case optionsOutputFile opts of
131 case optionsOutputFile opts of
111 Just outputFile -> do
132 Just outputFile -> do
112 createDirectoryIfMissing True (takeDirectory outputFile)
133 createDirectoryIfMissing True (takeDirectory outputFile)
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
113− writeUTF8File outputFile js
138+ Nothing -> writeUTF8File outputFile js
114 Nothing -> putStrLn js
139 Nothing -> putStrLn js
115 where
140 where
116 infoModList = Opts.fullDesc <> headerInfo <> footerInfo
141 infoModList = Opts.fullDesc <> headerInfo <> footerInfo
psc-docs/Main.hs+5−4
@@ -9,6 +9,7 @@ import Control.Category ((>>>))
9import Control.Monad.Writer
9import Control.Monad.Writer
10import Data.Text (Text)
10import Data.Text (Text)
11import qualified Data.Text as T
11import qualified Data.Text as T
12+import qualified Data.Text.IO as T
12import Data.Function (on)
13import Data.Function (on)
13import Data.List
14import Data.List
14import Data.Maybe (fromMaybe)
15import Data.Maybe (fromMaybe)
@@ -22,7 +23,7 @@ import qualified Language.PureScript as P
22import qualified Paths_purescript as Paths
23import qualified Paths_purescript as Paths
23import System.Exit (exitFailure)
24import System.Exit (exitFailure)
24import System.IO (hPutStrLn, hPrint, hSetEncoding, stderr, stdout, utf8)
25import System.IO (hPutStrLn, hPrint, hSetEncoding, stderr, stdout, utf8)
25−import System.IO.UTF8 (readUTF8FileT)
26+import System.IO.UTF8 (readUTF8FileT, writeUTF8FileT)
26import System.Directory (createDirectoryIfMissing)
27import System.Directory (createDirectoryIfMissing)
27import System.FilePath (takeDirectory)
28import System.FilePath (takeDirectory)
28import System.FilePath.Glob (glob)
29import System.FilePath.Glob (glob)
@@ -65,11 +66,11 @@ docgen (PSCDocsOptions fmt inputGlob output) = do
65
66
66 case output of
67 case output of
67 EverythingToStdOut ->
68 EverythingToStdOut ->
68− putStrLn (D.runDocs (D.modulesAsMarkdown ms))
69+ T.putStrLn (D.runDocs (D.modulesAsMarkdown ms))
69 ToStdOut names -> do
70 ToStdOut names -> do
70 let (ms', missing) = takeByName ms names
71 let (ms', missing) = takeByName ms names
71 guardMissing missing
72 guardMissing missing
72− putStrLn (D.runDocs (D.modulesAsMarkdown ms'))
73+ T.putStrLn (D.runDocs (D.modulesAsMarkdown ms'))
73 ToFiles names -> do
74 ToFiles names -> do
74 let (ms', missing) = takeByName' ms names
75 let (ms', missing) = takeByName' ms names
75 guardMissing missing
76 guardMissing missing
@@ -78,7 +79,7 @@ docgen (PSCDocsOptions fmt inputGlob output) = do
78 forM_ ms'' $ \grp -> do
79 forM_ ms'' $ \grp -> do
79 let fp = fst (head grp)
80 let fp = fst (head grp)
80 createDirectoryIfMissing True (takeDirectory fp)
81 createDirectoryIfMissing True (takeDirectory fp)
81− writeFile fp (D.runDocs (D.modulesAsMarkdown (map snd grp)))
82+ writeUTF8FileT fp (D.runDocs (D.modulesAsMarkdown (map snd grp)))
82
83
83 where
84 where
84 guardMissing [] = return ()
85 guardMissing [] = return ()
psc-docs/Tags.hs+1
@@ -17,4 +17,5 @@ tags = map (first T.unpack) . concatMap dtags . P.exportedDeclarations
17 names (P.TypeSynonymDeclaration name _ _) = [P.runProperName name]
17 names (P.TypeSynonymDeclaration name _ _) = [P.runProperName name]
18 names (P.TypeClassDeclaration name _ _ _ _) = [P.runProperName name]
18 names (P.TypeClassDeclaration name _ _ _ _) = [P.runProperName name]
19 names (P.TypeInstanceDeclaration name _ _ _ _) = [P.showIdent name]
19 names (P.TypeInstanceDeclaration name _ _ _ _) = [P.showIdent name]
20+ names (P.ExternKindDeclaration name) = [P.runProperName name]
20 names _ = []
21 names _ = []
psc-package/Main.hs+149−11
@@ -7,17 +7,20 @@
7
7
8module Main where
8module Main where
9
9
10+import qualified Control.Foldl as Foldl
10import qualified Data.Aeson as Aeson
11import qualified Data.Aeson as Aeson
11import Data.Aeson.Encode.Pretty
12import Data.Aeson.Encode.Pretty
12import Data.Foldable (fold, for_, traverse_)
13import Data.Foldable (fold, for_, traverse_)
13import Data.List (nub)
14import Data.List (nub)
14import qualified Data.Map as Map
15import qualified Data.Map as Map
15−import Data.Maybe (mapMaybe)
16+import Data.Maybe (fromMaybe, mapMaybe)
16import qualified Data.Set as Set
17import qualified Data.Set as Set
17import Data.Text (pack)
18import Data.Text (pack)
19+import qualified Data.Text as T
20+import Data.Text.Encoding (encodeUtf8)
18import qualified Data.Text.Lazy as TL
21import qualified Data.Text.Lazy as TL
19import qualified Data.Text.Lazy.Builder as TB
22import qualified Data.Text.Lazy.Builder as TB
20−import Data.Text.Encoding (encodeUtf8)
23+import qualified Data.Text.Read as TR
21import Data.Traversable (for)
24import Data.Traversable (for)
22import Data.Version (showVersion)
25import Data.Version (showVersion)
23import qualified Filesystem.Path.CurrentOS as Path
26import qualified Filesystem.Path.CurrentOS as Path
@@ -25,7 +28,8 @@ import GHC.Generics (Generic)
25import qualified Options.Applicative as Opts
28import qualified Options.Applicative as Opts
26import qualified Paths_purescript as Paths
29import qualified Paths_purescript as Paths
27import qualified System.IO as IO
30import qualified System.IO as IO
28−import Turtle hiding (fold)
31+import Turtle hiding (fold, s, x)
32+import qualified Turtle
29
33
30packageFile :: Path.FilePath
34packageFile :: Path.FilePath
31packageFile = "psc-package.json"
35packageFile = "psc-package.json"
@@ -61,8 +65,8 @@ readPackageFile = do
61 exit (ExitFailure 1)
65 exit (ExitFailure 1)
62 Just pkg -> return pkg
66 Just pkg -> return pkg
63
67
64−encodePrettyToText :: Aeson.ToJSON json => json -> Text
68+packageConfigToJSON :: PackageConfig -> Text
65−encodePrettyToText =
69+packageConfigToJSON =
66 TL.toStrict
70 TL.toStrict
67 . TB.toLazyText
71 . TB.toLazyText
68 . encodePrettyToTextBuilder' config
72 . encodePrettyToTextBuilder' config
@@ -76,10 +80,18 @@ encodePrettyToText =
76 ]
80 ]
77 }
81 }
78
82
83+packageSetToJSON :: PackageSet -> Text
84+packageSetToJSON =
85+ TL.toStrict
86+ . TB.toLazyText
87+ . encodePrettyToTextBuilder' config
88+ where
89+ config = defConfig { confCompare = compare }
90+
79writePackageFile :: PackageConfig -> IO ()
91writePackageFile :: PackageConfig -> IO ()
80writePackageFile =
92writePackageFile =
81 writeTextFile packageFile
93 writeTextFile packageFile
82− . encodePrettyToText
94+ . packageConfigToJSON
83
95
84data PackageInfo = PackageInfo
96data PackageInfo = PackageInfo
85 { repo :: Text
97 { repo :: Text
@@ -108,6 +120,18 @@ cloneShallow from ref into =
108 , pathToTextUnsafe into
120 , pathToTextUnsafe into
109 ] empty .||. exit (ExitFailure 1)
121 ] empty .||. exit (ExitFailure 1)
110
122
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+
111getPackageSet :: PackageConfig -> IO ()
135getPackageSet :: PackageConfig -> IO ()
112getPackageSet PackageConfig{ source, set } = do
136getPackageSet PackageConfig{ source, set } = do
113 let pkgDir = ".psc-package" </> fromText set </> ".set"
137 let pkgDir = ".psc-package" </> fromText set </> ".set"
@@ -128,11 +152,18 @@ readPackageSet PackageConfig{ set } = do
128 exit (ExitFailure 1)
152 exit (ExitFailure 1)
129 Just db -> return db
153 Just db -> return db
130
154
131−installOrUpdate :: PackageConfig -> Text -> PackageInfo -> IO ()
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
132−installOrUpdate PackageConfig{ set } pkgName PackageInfo{ repo, version } = do
161+installOrUpdate set pkgName PackageInfo{ repo, version } = do
162+ echo ("Updating " <> pkgName)
133 let pkgDir = ".psc-package" </> fromText set </> fromText pkgName </> fromText version
163 let pkgDir = ".psc-package" </> fromText set </> fromText pkgName </> fromText version
134 exists <- testdir pkgDir
164 exists <- testdir pkgDir
135 unless exists . void $ cloneShallow repo version pkgDir
165 unless exists . void $ cloneShallow repo version pkgDir
166+ pure pkgDir
136
167
137getTransitiveDeps :: PackageSet -> [Text] -> IO [(Text, PackageInfo)]
168getTransitiveDeps :: PackageSet -> [Text] -> IO [(Text, PackageInfo)]
138getTransitiveDeps db depends = do
169getTransitiveDeps db depends = do
@@ -151,9 +182,7 @@ updateImpl config@PackageConfig{ depends } = do
151 db <- readPackageSet config
182 db <- readPackageSet config
152 trans <- getTransitiveDeps db depends
183 trans <- getTransitiveDeps db depends
153 echo ("Updating " <> pack (show (length trans)) <> " packages...")
184 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
157
186
158initialize :: IO ()
187initialize :: IO ()
159initialize = do
188initialize = do
@@ -233,6 +262,101 @@ exec exeName = do
233 (map pathToTextUnsafe ("src" </> "**" </> "*.purs" : paths))
262 (map pathToTextUnsafe ("src" </> "**" </> "*.purs" : paths))
234 empty
263 empty
235
264
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+
236main :: IO ()
360main :: IO ()
237main = do
361main = do
238 IO.hSetEncoding IO.stdout IO.utf8
362 IO.hSetEncoding IO.stdout IO.utf8
@@ -275,8 +399,22 @@ main = do
275 , Opts.command "available"
399 , Opts.command "available"
276 (Opts.info (pure listPackages)
400 (Opts.info (pure listPackages)
277 (Opts.progDesc "List all packages available in the package set"))
401 (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"))
278 ]
408 ]
279 where
409 where
280 pkg = Opts.strArgument $
410 pkg = Opts.strArgument $
281 Opts.metavar "PACKAGE"
411 Opts.metavar "PACKAGE"
282 <> Opts.help "The name of the package to install"
412 <> 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 #-}
1
2
2module Main where
3module Main where
3
4
psci/Main.hs+16−10
@@ -72,10 +72,16 @@ inputFile = Opts.strArgument $
72 Opts.metavar "FILE"
72 Opts.metavar "FILE"
73 <> Opts.help "Optional .purs files to load on start"
73 <> Opts.help "Optional .purs files to load on start"
74
74
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+
75−nodeFlagsFlag :: Opts.Parser [String]
81+nodeFlagsOption :: Opts.Parser [String]
76−nodeFlagsFlag = Opts.option parser $
82+nodeFlagsOption = Opts.option parser $
77 Opts.long "node-opts"
83 Opts.long "node-opts"
78− <> Opts.metavar "NODE_OPTS"
84+ <> Opts.metavar "OPTS"
79 <> Opts.value []
85 <> Opts.value []
80 <> Opts.help "Flags to pass to node, separated by spaces"
86 <> Opts.help "Flags to pass to node, separated by spaces"
81 where
87 where
@@ -90,7 +96,7 @@ port = Opts.option Opts.auto $
90backend :: Opts.Parser Backend
96backend :: Opts.Parser Backend
91backend =
97backend =
92 (browserBackend <$> port)
98 (browserBackend <$> port)
93− <|> (nodeBackend <$> nodeFlagsFlag)
99+ <|> (nodeBackend <$> nodePathOption <*> nodeFlagsOption)
94
100
95psciOptions :: Opts.Parser PSCiOptions
101psciOptions :: Opts.Parser PSCiOptions
96psciOptions = PSCiOptions <$> many inputFile
102psciOptions = PSCiOptions <$> many inputFile
@@ -293,8 +299,8 @@ browserBackend serverPort = Backend setup evaluate reload shutdown
293 result <- takeMVar resultVar
299 result <- takeMVar resultVar
294 putStrLn result
300 putStrLn result
295
301
296−nodeBackend :: [String] -> Backend
302+nodeBackend :: Maybe FilePath -> [String] -> Backend
297−nodeBackend nodeArgs = Backend setup eval reload shutdown
303+nodeBackend nodePath nodeArgs = Backend setup eval reload shutdown
298 where
304 where
299 setup :: IO ()
305 setup :: IO ()
300 setup = return ()
306 setup = return ()
@@ -302,12 +308,12 @@ nodeBackend nodeArgs = Backend setup eval reload shutdown
302 eval :: () -> String -> IO ()
308 eval :: () -> String -> IO ()
303 eval _ _ = do
309 eval _ _ = do
304 writeFile indexFile "require('$PSCI')['$main']();"
310 writeFile indexFile "require('$PSCI')['$main']();"
305− process <- findNodeProcess
311+ process <- maybe findNodeProcess (pure . pure) nodePath
306 result <- traverse (\node -> readProcessWithExitCode node (nodeArgs ++ [indexFile]) "") process
312 result <- traverse (\node -> readProcessWithExitCode node (nodeArgs ++ [indexFile]) "") process
307 case result of
313 case result of
308− Just (ExitSuccess, out, _) -> putStrLn out
314+ Just (ExitSuccess, out, _) -> putStrLn out
309− Just (ExitFailure _, _, err) -> putStrLn err
315+ Just (ExitFailure _, _, err) -> putStrLn err
310− Nothing -> putStrLn "Couldn't find node.js"
316+ Nothing -> putStrLn "Couldn't find node.js"
311
317
312 reload :: () -> IO ()
318 reload :: () -> IO ()
313 reload _ = return ()
319 reload _ = return ()
purescript.cabal+18−3
@@ -1,5 +1,5 @@
1name: purescript
1name: purescript
2−version: 0.10.3
2+version: 0.10.4
3cabal-version: >=1.8
3cabal-version: >=1.8
4build-type: Simple
4build-type: Simple
5license: BSD3
5license: BSD3
@@ -28,6 +28,7 @@ extra-source-files: examples/passing/*.purs
28 , examples/passing/ExplicitImportReExport/*.purs
28 , examples/passing/ExplicitImportReExport/*.purs
29 , examples/passing/ExportExplicit/*.purs
29 , examples/passing/ExportExplicit/*.purs
30 , examples/passing/ExportExplicit2/*.purs
30 , examples/passing/ExportExplicit2/*.purs
31+ , examples/passing/ForeignKind/*.purs
31 , examples/passing/Import/*.purs
32 , examples/passing/Import/*.purs
32 , examples/passing/ImportExplicit/*.purs
33 , examples/passing/ImportExplicit/*.purs
33 , examples/passing/ImportQualified/*.purs
34 , examples/passing/ImportQualified/*.purs
@@ -39,6 +40,8 @@ extra-source-files: examples/passing/*.purs
39 , examples/passing/ModuleExportQualified/*.purs
40 , examples/passing/ModuleExportQualified/*.purs
40 , examples/passing/ModuleExportSelf/*.purs
41 , examples/passing/ModuleExportSelf/*.purs
41 , examples/passing/NonConflictingExports/*.purs
42 , examples/passing/NonConflictingExports/*.purs
43+ , examples/passing/NonOrphanInstanceMulti/*.purs
44+ , examples/passing/NonOrphanInstanceFunDepExtra/*.purs
42 , examples/passing/OperatorAliasElsewhere/*.purs
45 , examples/passing/OperatorAliasElsewhere/*.purs
43 , examples/passing/Operators/*.purs
46 , examples/passing/Operators/*.purs
44 , examples/passing/PendingConflictingImports/*.purs
47 , examples/passing/PendingConflictingImports/*.purs
@@ -63,6 +66,7 @@ extra-source-files: examples/passing/*.purs
63 , examples/failing/ConflictingImports2/*.purs
66 , examples/failing/ConflictingImports2/*.purs
64 , examples/failing/ConflictingQualifiedImports/*.purs
67 , examples/failing/ConflictingQualifiedImports/*.purs
65 , examples/failing/ConflictingQualifiedImports2/*.purs
68 , examples/failing/ConflictingQualifiedImports2/*.purs
69+ , examples/failing/DiffKindsSameName/*.purs
66 , examples/failing/DuplicateModule/*.purs
70 , examples/failing/DuplicateModule/*.purs
67 , examples/failing/ExportConflictClass/*.purs
71 , examples/failing/ExportConflictClass/*.purs
68 , examples/failing/ExportConflictCtor/*.purs
72 , examples/failing/ExportConflictCtor/*.purs
@@ -78,6 +82,9 @@ extra-source-files: examples/passing/*.purs
78 , examples/failing/ImportModule/*.purs
82 , examples/failing/ImportModule/*.purs
79 , examples/failing/InstanceExport/*.purs
83 , examples/failing/InstanceExport/*.purs
80 , examples/failing/OrphanInstance/*.purs
84 , examples/failing/OrphanInstance/*.purs
85+ , examples/failing/OrphanInstanceFunDepCycle/*.purs
86+ , examples/failing/OrphanInstanceWithDetermined/*.purs
87+ , examples/failing/OrphanInstanceNullary/*.purs
81 , examples/warning/*.purs
88 , examples/warning/*.purs
82 , examples/warning/*.js
89 , examples/warning/*.js
83 , examples/warning/UnusedExplicitImportTypeOp/*.purs
90 , examples/warning/UnusedExplicitImportTypeOp/*.purs
@@ -272,6 +279,7 @@ library
272 Language.PureScript.Docs.Convert
279 Language.PureScript.Docs.Convert
273 Language.PureScript.Docs.Convert.Single
280 Language.PureScript.Docs.Convert.Single
274 Language.PureScript.Docs.Convert.ReExports
281 Language.PureScript.Docs.Convert.ReExports
282+ Language.PureScript.Docs.Prim
275 Language.PureScript.Docs.Render
283 Language.PureScript.Docs.Render
276 Language.PureScript.Docs.Types
284 Language.PureScript.Docs.Types
277 Language.PureScript.Docs.RenderedCode
285 Language.PureScript.Docs.RenderedCode
@@ -448,7 +456,7 @@ executable psc-package
448 optparse-applicative -any,
456 optparse-applicative -any,
449 system-filepath -any,
457 system-filepath -any,
450 text -any,
458 text -any,
451− turtle -any
459+ turtle <1.3
452 main-is: Main.hs
460 main-is: Main.hs
453 other-modules: Paths_purescript
461 other-modules: Paths_purescript
454 buildable: True
462 buildable: True
@@ -478,14 +486,19 @@ executable psc-bundle
478 other-modules: Paths_purescript
486 other-modules: Paths_purescript
479 other-extensions:
487 other-extensions:
480 build-depends: base >=4 && <5,
488 build-depends: base >=4 && <5,
489+ bytestring -any,
481 purescript -any,
490 purescript -any,
482 directory -any,
491 directory -any,
492+ aeson >= 0.8 && < 1.0,
483 filepath -any,
493 filepath -any,
484 Glob -any,
494 Glob -any,
485 mtl -any,
495 mtl -any,
486 optparse-applicative >= 0.12.1,
496 optparse-applicative >= 0.12.1,
497+ sourcemap >= 0.1.6,
487 transformers -any,
498 transformers -any,
488− transformers-compat -any
499+ transformers-compat -any,
500+ utf8-string >= 1 && < 2
501+
489 ghc-options: -Wall -O2
502 ghc-options: -Wall -O2
490 hs-source-dirs: psc-bundle
503 hs-source-dirs: psc-bundle
491
504
@@ -559,6 +572,7 @@ test-suite tests
559 aeson -any,
572 aeson -any,
560 aeson-better-errors -any,
573 aeson-better-errors -any,
561 base-compat -any,
574 base-compat -any,
575+ bower-json -any,
562 boxes -any,
576 boxes -any,
563 bytestring -any,
577 bytestring -any,
564 containers -any,
578 containers -any,
@@ -588,6 +602,7 @@ test-suite tests
588 other-modules: TestUtils
602 other-modules: TestUtils
589 TestCompiler
603 TestCompiler
590 TestDocs
604 TestDocs
605+ TestPrimDocs
591 TestPscPublish
606 TestPscPublish
592 TestPsci
607 TestPsci
593 TestPscIde
608 TestPscIde
src/Language/PureScript/AST/Declarations.hs+25−1
@@ -240,6 +240,10 @@ data DeclarationRef
240 --
240 --
241 | ModuleRef ModuleName
241 | ModuleRef ModuleName
242 -- |
242 -- |
243+ -- A named kind
244+ --
245+ | KindRef (ProperName 'KindName)
246+ -- |
243 -- A value re-exported from another module. These will be inserted during
247 -- A value re-exported from another module. These will be inserted during
244 -- elaboration in name desugaring.
248 -- elaboration in name desugaring.
245 --
249 --
@@ -258,6 +262,7 @@ instance Eq DeclarationRef where
258 (TypeClassRef name) == (TypeClassRef name') = name == name'
262 (TypeClassRef name) == (TypeClassRef name') = name == name'
259 (TypeInstanceRef name) == (TypeInstanceRef name') = name == name'
263 (TypeInstanceRef name) == (TypeInstanceRef name') = name == name'
260 (ModuleRef name) == (ModuleRef name') = name == name'
264 (ModuleRef name) == (ModuleRef name') = name == name'
265+ (KindRef name) == (KindRef name') = name == name'
261 (ReExportRef mn ref) == (ReExportRef mn' ref') = mn == mn' && ref == ref'
266 (ReExportRef mn ref) == (ReExportRef mn' ref') = mn == mn' && ref == ref'
262 (PositionedDeclarationRef _ _ r) == r' = r == r'
267 (PositionedDeclarationRef _ _ r) == r' = r == r'
263 r == (PositionedDeclarationRef _ _ r') = r == r'
268 r == (PositionedDeclarationRef _ _ r') = r == r'
@@ -274,6 +279,7 @@ compDecRef (ValueOpRef name) (ValueOpRef name') = compare name name'
274compDecRef (TypeClassRef name) (TypeClassRef name') = compare name name'
279compDecRef (TypeClassRef name) (TypeClassRef name') = compare name name'
275compDecRef (TypeInstanceRef ident) (TypeInstanceRef ident') = compare ident ident'
280compDecRef (TypeInstanceRef ident) (TypeInstanceRef ident') = compare ident ident'
276compDecRef (ModuleRef name) (ModuleRef name') = compare name name'
281compDecRef (ModuleRef name) (ModuleRef name') = compare name name'
282+compDecRef (KindRef name) (KindRef name') = compare name name'
277compDecRef (ReExportRef name _) (ReExportRef name' _) = compare name name'
283compDecRef (ReExportRef name _) (ReExportRef name' _) = compare name name'
278compDecRef (PositionedDeclarationRef _ _ ref) ref' = compDecRef ref ref'
284compDecRef (PositionedDeclarationRef _ _ ref) ref' = compDecRef ref ref'
279compDecRef ref (PositionedDeclarationRef _ _ ref') = compDecRef ref ref'
285compDecRef ref (PositionedDeclarationRef _ _ ref') = compDecRef ref ref'
@@ -286,7 +292,8 @@ compDecRef ref ref' = compare
286 orderOf (TypeRef _ _) = 2
292 orderOf (TypeRef _ _) = 2
287 orderOf (ValueRef _) = 3
293 orderOf (ValueRef _) = 3
288 orderOf (ValueOpRef _) = 4
294 orderOf (ValueOpRef _) = 4
289− orderOf _ = 5
295+ orderOf (KindRef _) = 5
296+ orderOf _ = 6
290
297
291getTypeRef :: DeclarationRef -> Maybe (ProperName 'TypeName, Maybe [ProperName 'ConstructorName])
298getTypeRef :: DeclarationRef -> Maybe (ProperName 'TypeName, Maybe [ProperName 'ConstructorName])
292getTypeRef (TypeRef name dctors) = Just (name, dctors)
299getTypeRef (TypeRef name dctors) = Just (name, dctors)
@@ -313,6 +320,11 @@ getTypeClassRef (TypeClassRef name) = Just name
313getTypeClassRef (PositionedDeclarationRef _ _ r) = getTypeClassRef r
320getTypeClassRef (PositionedDeclarationRef _ _ r) = getTypeClassRef r
314getTypeClassRef _ = Nothing
321getTypeClassRef _ = Nothing
315
322
323+getKindRef :: DeclarationRef -> Maybe (ProperName 'KindName)
324+getKindRef (KindRef name) = Just name
325+getKindRef (PositionedDeclarationRef _ _ r) = getKindRef r
326+getKindRef _ = Nothing
327+
316isModuleRef :: DeclarationRef -> Bool
328isModuleRef :: DeclarationRef -> Bool
317isModuleRef (PositionedDeclarationRef _ _ r) = isModuleRef r
329isModuleRef (PositionedDeclarationRef _ _ r) = isModuleRef r
318isModuleRef (ModuleRef _) = True
330isModuleRef (ModuleRef _) = True
@@ -381,6 +393,10 @@ data Declaration
381 --
393 --
382 | ExternDataDeclaration (ProperName 'TypeName) Kind
394 | ExternDataDeclaration (ProperName 'TypeName) Kind
383 -- |
395 -- |
396+ -- A foreign kind import (name)
397+ --
398+ | ExternKindDeclaration (ProperName 'KindName)
399+ -- |
384 -- A fixity declaration
400 -- A fixity declaration
385 --
401 --
386 | FixityDeclaration (Either ValueFixity TypeFixity)
402 | FixityDeclaration (Either ValueFixity TypeFixity)
@@ -469,6 +485,14 @@ isExternDataDecl ExternDataDeclaration{} = True
469isExternDataDecl (PositionedDeclaration _ _ d) = isExternDataDecl d
485isExternDataDecl (PositionedDeclaration _ _ d) = isExternDataDecl d
470isExternDataDecl _ = False
486isExternDataDecl _ = False
471
487
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+
472-- |
496-- |
473-- Test if a declaration is a fixity declaration
497-- Test if a declaration is a fixity declaration
474--
498--
src/Language/PureScript/AST/Exported.hs+1
@@ -132,6 +132,7 @@ isExported (Just exps) decl = any (matches decl) exps
132 matches (ExternDeclaration ident _) (ValueRef ident') = ident == ident'
132 matches (ExternDeclaration ident _) (ValueRef ident') = ident == ident'
133 matches (DataDeclaration _ ident _ _) (TypeRef ident' _) = ident == ident'
133 matches (DataDeclaration _ ident _ _) (TypeRef ident' _) = ident == ident'
134 matches (ExternDataDeclaration ident _) (TypeRef ident' _) = ident == ident'
134 matches (ExternDataDeclaration ident _) (TypeRef ident' _) = ident == ident'
135+ matches (ExternKindDeclaration ident) (KindRef ident') = ident == ident'
135 matches (TypeSynonymDeclaration ident _ _) (TypeRef ident' _) = ident == ident'
136 matches (TypeSynonymDeclaration ident _ _) (TypeRef ident' _) = ident == ident'
136 matches (TypeClassDeclaration ident _ _ _ _) (TypeClassRef ident') = ident == ident'
137 matches (TypeClassDeclaration ident _ _ _ _) (TypeClassRef ident') = ident == ident'
137 matches (ValueFixityDeclaration _ _ op) (ValueOpRef op') = op == op'
138 matches (ValueFixityDeclaration _ _ op) (ValueOpRef op') = op == op'
src/Language/PureScript/AST/Traversals.hs+40−3
@@ -14,11 +14,12 @@ import Data.Maybe (mapMaybe)
14import qualified Data.Set as S
14import qualified Data.Set as S
15
15
16import Language.PureScript.AST.Binders
16import Language.PureScript.AST.Binders
17−import Language.PureScript.AST.Literals
18import Language.PureScript.AST.Declarations
17import Language.PureScript.AST.Declarations
19−import Language.PureScript.Types
18+import Language.PureScript.AST.Literals
20−import Language.PureScript.Traversals
19+import Language.PureScript.Kinds
21import Language.PureScript.Names
20import Language.PureScript.Names
21+import Language.PureScript.Traversals
22+import Language.PureScript.Types
22
23
23everywhereOnValues
24everywhereOnValues
24 :: (Declaration -> Declaration)
25 :: (Declaration -> Declaration)
@@ -588,6 +589,42 @@ accumTypes f = everythingOnValues mappend forDecls forValues (const mempty) (con
588 forValues (TypedValue _ _ ty) = f ty
589 forValues (TypedValue _ _ ty) = f ty
589 forValues _ = mempty
590 forValues _ = mempty
590
591
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+
591-- |
628-- |
592-- Map a function over type annotations appearing inside a value
629-- Map a function over type annotations appearing inside a value
593--
630--
src/Language/PureScript/Bundle.hs+104−31
@@ -6,6 +6,7 @@
6-- and generates the final Javascript bundle.
6-- and generates the final Javascript bundle.
7module Language.PureScript.Bundle
7module Language.PureScript.Bundle
8 ( bundle
8 ( bundle
9+ , bundleSM
9 , guessModuleIdentifier
10 , guessModuleIdentifier
10 , ModuleIdentifier(..)
11 , ModuleIdentifier(..)
11 , moduleName
12 , moduleName
@@ -19,6 +20,7 @@ import Prelude.Compat
19
20
20import Control.Monad
21import Control.Monad
21import Control.Monad.Error.Class
22import Control.Monad.Error.Class
23+import Control.Arrow ((&&&))
22
24
23import Data.Char (chr, digitToInt)
25import Data.Char (chr, digitToInt)
24import Data.Generics (everything, everywhere, mkQ, mkT)
26import Data.Generics (everything, everywhere, mkQ, mkT)
@@ -33,7 +35,9 @@ import Language.JavaScript.Parser.AST
33
35
34import qualified Paths_purescript as Paths
36import qualified Paths_purescript as Paths
35
37
36−import System.FilePath (takeFileName, takeDirectory)
38+import System.FilePath (takeFileName, takeDirectory, takeDirectory, makeRelative)
39+
40+import SourceMap.Types
37
41
38-- | The type of error messages. We separate generation and rendering of errors using a data
42-- | The type of error messages. We separate generation and rendering of errors using a data
39-- type, in case we need to match on error types later.
43-- type, in case we need to match on error types later.
@@ -98,10 +102,11 @@ data ModuleElement
98 | Member JSStatement Bool String JSExpression [Key]
102 | Member JSStatement Bool String JSExpression [Key]
99 | ExportsList [(ExportType, String, JSExpression, [Key])]
103 | ExportsList [(ExportType, String, JSExpression, [Key])]
100 | Other JSStatement
104 | Other JSStatement
105+ | Skip JSStatement
101 deriving (Show)
106 deriving (Show)
102
107
103-- | A module is just a list of elements of the types listed above.
108-- | 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)
105
110
106-- | Prepare an error message for consumption by humans.
111-- | Prepare an error message for consumption by humans.
107printErrorMessage :: ErrorMessage -> [String]
112printErrorMessage :: ErrorMessage -> [String]
@@ -159,7 +164,7 @@ checkImportPath name _ _ = Left name
159--
164--
160-- where name is the name of a member defined in the current module.
165-- where name is the name of a member defined in the current module.
161withDeps :: Module -> Module
166withDeps :: Module -> Module
162−withDeps (Module modulePath es) = Module modulePath (map expandDeps es)
167+withDeps (Module modulePath fn es) = Module modulePath fn (map expandDeps es)
163 where
168 where
164 -- | Collects all modules which are imported, so that we can identify dependencies of the first type.
169 -- | Collects all modules which are imported, so that we can identify dependencies of the first type.
165 imports :: [(String, ModuleIdentifier)]
170 imports :: [(String, ModuleIdentifier)]
@@ -248,9 +253,9 @@ trailingCommaList (JSCTLNone l) = commaList l
248--
253--
249-- Each type of module element is matched using pattern guards, and everything else is bundled into the
254-- Each type of module element is matched using pattern guards, and everything else is bundled into the
250-- Other constructor.
255-- Other constructor.
251−toModule :: forall m. (MonadError ErrorMessage m) => S.Set String -> ModuleIdentifier -> JSAST -> m Module
256+toModule :: forall m. (MonadError ErrorMessage m) => S.Set String -> ModuleIdentifier -> Maybe FilePath -> JSAST -> m Module
252−toModule mids mid top
257+toModule mids mid filename top
253− | JSAstProgram smts _ <- top = Module mid <$> traverse toModuleElement smts
258+ | JSAstProgram smts _ <- top = Module mid filename <$> traverse toModuleElement smts
254 | otherwise = err InvalidTopLevel
259 | otherwise = err InvalidTopLevel
255 where
260 where
256 err = throwError . ErrorInModule mid
261 err = throwError . ErrorInModule mid
@@ -389,7 +394,7 @@ compile modules entryPoints = filteredModules
389 -- | The vertex set
394 -- | The vertex set
390 verts :: [(ModuleElement, Key, [Key])]
395 verts :: [(ModuleElement, Key, [Key])]
391 verts = do
396 verts = do
392− Module mid els <- modules
397+ Module mid _ els <- modules
393 concatMap (toVertices mid) els
398 concatMap (toVertices mid) els
394 where
399 where
395 -- | Create a set of vertices for a module element.
400 -- | Create a set of vertices for a module element.
@@ -425,14 +430,21 @@ compile modules entryPoints = filteredModules
425 filteredModules = map filterUsed modules
430 filteredModules = map filterUsed modules
426 where
431 where
427 filterUsed :: Module -> Module
432 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))
429 where
434 where
430 go :: [ModuleElement] -> [ModuleElement]
435 go :: [ModuleElement] -> [ModuleElement]
431 go [] = []
436 go [] = []
432 go (d : rest)
437 go (d : rest)
433− | not (isDeclUsed d) = go rest
438+ | not (isDeclUsed d) = skipDecl d : go rest
434 | otherwise = d : go rest
439 | otherwise = d : go rest
435
440
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+
436 -- | Filter out the exports for members which aren't used.
448 -- | Filter out the exports for members which aren't used.
437 filterExports :: ModuleElement -> ModuleElement
449 filterExports :: ModuleElement -> ModuleElement
438 filterExports (ExportsList exps) = ExportsList (filter (\(_, nm, _, _) -> isKeyUsed (mid, nm)) exps)
450 filterExports (ExportsList exps) = ExportsList (filter (\(_, nm, _, _) -> isKeyUsed (mid, nm)) exps)
@@ -453,7 +465,7 @@ sortModules :: [Module] -> [Module]
453sortModules modules = map (\v -> case nodeFor v of (n, _, _) -> n) (reverse (topSort graph))
465sortModules modules = map (\v -> case nodeFor v of (n, _, _) -> n) (reverse (topSort graph))
454 where
466 where
455 (graph, nodeFor, _) = graphFromEdges $ do
467 (graph, nodeFor, _) = graphFromEdges $ do
456− m@(Module mid els) <- modules
468+ m@(Module mid _ els) <- modules
457 return (m, mid, mapMaybe getKey els)
469 return (m, mid, mapMaybe getKey els)
458
470
459 getKey :: ModuleElement -> Maybe ModuleIdentifier
471 getKey :: ModuleElement -> Maybe ModuleIdentifier
@@ -466,12 +478,13 @@ sortModules modules = map (\v -> case nodeFor v of (n, _, _) -> n) (reverse (top
466--
478--
467-- If a module is empty, we don't want to generate code for it.
479-- If a module is empty, we don't want to generate code for it.
468isModuleEmpty :: Module -> Bool
480isModuleEmpty :: Module -> Bool
469−isModuleEmpty (Module _ els) = all isElementEmpty els
481+isModuleEmpty (Module _ _ els) = all isElementEmpty els
470 where
482 where
471 isElementEmpty :: ModuleElement -> Bool
483 isElementEmpty :: ModuleElement -> Bool
472 isElementEmpty (ExportsList exps) = null exps
484 isElementEmpty (ExportsList exps) = null exps
473 isElementEmpty Require{} = True
485 isElementEmpty Require{} = True
474 isElementEmpty (Other _) = True
486 isElementEmpty (Other _) = True
487+ isElementEmpty (Skip _) = True
475 isElementEmpty _ = False
488 isElementEmpty _ = False
476
489
477-- | Generate code for a set of modules, including a call to main().
490-- | Generate code for a set of modules, including a call to main().
@@ -490,16 +503,62 @@ isModuleEmpty (Module _ els) = all isElementEmpty els
490codeGen :: Maybe String -- ^ main module
503codeGen :: Maybe String -- ^ main module
491 -> String -- ^ namespace
504 -> String -- ^ namespace
492 -> [Module] -- ^ input modules
505 -> [Module] -- ^ input modules
506+ -> Maybe String -- ^ output filename
493− -> String
507+ -> (Maybe SourceMapping, String)
494−codeGen optionsMainModule optionsNamespace ms = renderToString (JSAstProgram (prelude : concatMap moduleToJS ms ++ maybe [] runMain optionsMainModule) JSNoAnnot)
508+codeGen optionsMainModule optionsNamespace ms outFileOpt = (fmap sourceMapping outFileOpt, rendered)
495 where
509 where
496− moduleToJS :: Module -> [JSStatement]
510+ rendered = renderToString (JSAstProgram (prelude : concatMap fst modulesJS ++ maybe [] runMain optionsMainModule) JSNoAnnot)
497− moduleToJS (Module mn ds) = wrap (moduleName mn) (indent (concatMap declToJS ds))
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+ }
498 where
529 where
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+
499− declToJS :: ModuleElement -> [JSStatement]
557+ declToJS :: ModuleElement -> ([JSStatement], Either Int Int)
500− declToJS (Member n _ _ _ _) = [n]
558+ declToJS (Member n _ _ _ _) = withLength [n]
501− declToJS (Other n) = [n]
559+ declToJS (Other n) = withLength [n]
560+ declToJS (Skip n) = ([], Left $ moduleLength [n])
502− declToJS (Require _ nm req) =
561+ declToJS (Require _ nm req) = withLength
503 [
562 [
504 JSVariable lfsp
563 JSVariable lfsp
505 (cList [
564 (cList [
@@ -507,9 +566,10 @@ codeGen optionsMainModule optionsNamespace ms = renderToString (JSAstProgram (p
507 (JSVarInit sp $ either require (moduleReference sp . moduleName) req )
566 (JSVarInit sp $ either require (moduleReference sp . moduleName) req )
508 ]) (JSSemi JSNoAnnot)
567 ]) (JSSemi JSNoAnnot)
509 ]
568 ]
510− declToJS (ExportsList exps) = map toExport exps
569+ declToJS (ExportsList exps) = withLength $ map toExport exps
511
570
512 where
571 where
572+
513 toExport :: (ExportType, String, JSExpression, [Key]) -> JSStatement
573 toExport :: (ExportType, String, JSExpression, [Key]) -> JSStatement
514 toExport (_, nm, val, _) =
574 toExport (_, nm, val, _) =
515 JSAssignStatement
575 JSAssignStatement
@@ -612,26 +672,39 @@ codeGen optionsMainModule optionsNamespace ms = renderToString (JSAstProgram (p
612-- | The bundling function.
672-- | The bundling function.
613-- This function performs dead code elimination, filters empty modules
673-- This function performs dead code elimination, filters empty modules
614-- and generates and prints the final Javascript bundle.
674-- and generates and prints the final Javascript bundle.
615−bundle :: (MonadError ErrorMessage m)
675+bundleSM :: (MonadError ErrorMessage m)
616− => [(ModuleIdentifier, String)] -- ^ The input modules. Each module should be javascript rendered from 'Language.PureScript.Make' or @psc@.
676+ => [(ModuleIdentifier, Maybe FilePath, String)] -- ^ The input modules. Each module should be javascript rendered from 'Language.PureScript.Make' or @psc@.
617 -> [ModuleIdentifier] -- ^ Entry points. These module identifiers are used as the roots for dead-code elimination
677 -> [ModuleIdentifier] -- ^ Entry points. These module identifiers are used as the roots for dead-code elimination
618 -> Maybe String -- ^ An optional main module.
678 -> Maybe String -- ^ An optional main module.
619 -> String -- ^ The namespace (e.g. PS).
679 -> String -- ^ The namespace (e.g. PS).
680+ -> Maybe FilePath -- ^ The output file name (if there is one - in which case generate source map)
620− -> m String
681+ -> m (Maybe SourceMapping, String)
621−bundle inputStrs entryPoints mainModule namespace = do
682+bundleSM inputStrs entryPoints mainModule namespace outFilename = do
683+ let mid (a,_,_) = a
622 forM_ mainModule $ \mname ->
684 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))
624 forM_ entryPoints $ \mIdent ->
686 forM_ entryPoints $ \mIdent ->
625− when (mIdent `notElem` map fst inputStrs) (throwError (MissingEntryPoint (moduleName mIdent)))
687+ when (mIdent `notElem` map mid inputStrs) (throwError (MissingEntryPoint (moduleName mIdent)))
626− input <- forM inputStrs $ \(ident, js) -> do
688+ input <- forM inputStrs $ \(ident, filename, js) -> do
627 ast <- either (throwError . ErrorInModule ident . UnableToParseModule) pure $ parse js (moduleName ident)
689 ast <- either (throwError . ErrorInModule ident . UnableToParseModule) pure $ parse js (moduleName ident)
628− return (ident, ast)
690+ return (ident, filename, ast)
629
691
630− let mids = S.fromList (map (moduleName . fst) input)
692+ let mids = S.fromList (map (moduleName . mid) input)
631
693
632− modules <- traverse (fmap withDeps . uncurry (toModule mids)) input
694+ modules <- traverse (fmap withDeps . (\(a,fn,c) -> toModule mids a fn c)) input
633
695
634 let compiled = compile modules entryPoints
696 let compiled = compile modules entryPoints
635 sorted = sortModules (filter (not . isModuleEmpty) compiled)
697 sorted = sortModules (filter (not . isModuleEmpty) compiled)
636
698
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_ =
293 evaluate = JSVariableIntroduction Nothing evaluatedObj (Just obj)
293 evaluate = JSVariableIntroduction Nothing evaluatedObj (Just obj)
294 objAssign = JSVariableIntroduction Nothing newObj (Just $ JSObjectLiteral Nothing [])
294 objAssign = JSVariableIntroduction Nothing newObj (Just $ JSObjectLiteral Nothing [])
295 copy = JSForIn Nothing key jsEvaluatedObj $ JSBlock Nothing [JSIfElse Nothing cond assign Nothing]
295 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]
297 assign = JSBlock Nothing [JSAssignment Nothing (JSIndexer Nothing jsKey jsNewObj) (JSIndexer Nothing jsKey jsEvaluatedObj)]
297 assign = JSBlock Nothing [JSAssignment Nothing (JSIndexer Nothing jsKey jsNewObj) (JSIndexer Nothing jsKey jsEvaluatedObj)]
298 stToAssign (s, js) = JSAssignment Nothing (accessorString s jsNewObj) js
298 stToAssign (s, js) = JSAssignment Nothing (accessorString s jsNewObj) js
299 extend = map stToAssign sts
299 extend = map stToAssign sts
src/Language/PureScript/Constants.hs+47−4
@@ -139,6 +139,9 @@ compose = "compose"
139composeFlipped :: Text
139composeFlipped :: Text
140composeFlipped = "composeFlipped"
140composeFlipped = "composeFlipped"
141
141
142+map :: Text
143+map = "map"
144+
142-- Functions
145-- Functions
143
146
144negate :: Text
147negate :: Text
@@ -314,10 +317,38 @@ fromSpine = "fromSpine"
314toSignature :: Text
317toSignature :: Text
315toSignature = "toSignature"
318toSignature = "toSignature"
316
319
317−-- IsSymbol class
320+-- Data.Symbol
321+
322+pattern DataSymbol :: ModuleName
323+pattern DataSymbol = ModuleName [ProperName "Data", ProperName "Symbol"]
318
324
319pattern IsSymbol :: Qualified (ProperName 'ClassName)
325pattern IsSymbol :: Qualified (ProperName 'ClassName)
326+pattern IsSymbol = Qualified (Just DataSymbol) (ProperName "IsSymbol")
327+
328+-- Type.Data.Symbol
329+
330+pattern TypeDataSymbol :: ModuleName
320−pattern IsSymbol = Qualified (Just (ModuleName [ProperName "Data", ProperName "Symbol"])) (ProperName "IsSymbol")
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")
321
352
322-- Main module
353-- Main module
323
354
@@ -329,11 +360,23 @@ main = "main"
329partial :: Text
360partial :: Text
330partial = "Partial"
361partial = "Partial"
331
362
363+pattern Prim :: ModuleName
364+pattern Prim = ModuleName [ProperName "Prim"]
365+
332pattern Partial :: Qualified (ProperName 'ClassName)
366pattern Partial :: Qualified (ProperName 'ClassName)
333−pattern Partial = Qualified (Just (ModuleName [ProperName "Prim"])) (ProperName "Partial")
367+pattern Partial = Qualified (Just Prim) (ProperName "Partial")
334
368
335pattern Fail :: Qualified (ProperName 'ClassName)
369pattern 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"
337
380
338-- Code Generation
381-- Code Generation
339
382
src/Language/PureScript/Docs.hs+1
@@ -7,6 +7,7 @@ module Language.PureScript.Docs (
7) where
7) where
8
8
9import Language.PureScript.Docs.Convert as Docs
9import Language.PureScript.Docs.Convert as Docs
10+import Language.PureScript.Docs.Prim as Docs
10import Language.PureScript.Docs.ParseAndBookmark as Docs
11import Language.PureScript.Docs.ParseAndBookmark as Docs
11import Language.PureScript.Docs.Render as Docs
12import Language.PureScript.Docs.Render as Docs
12import Language.PureScript.Docs.RenderedCode.Render as Docs
13import 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)
13import Control.Monad.Writer (Writer, tell, execWriter)
13import Control.Monad.Writer (Writer, tell, execWriter)
14
14
15import Data.Foldable (for_)
15import Data.Foldable (for_)
16+import Data.Monoid ((<>))
16import Data.List (partition)
17import Data.List (partition)
18+import Data.Text (Text)
17import qualified Data.Text as T
19import qualified Data.Text as T
18
20
19import Language.PureScript.Docs.RenderedCode
21import Language.PureScript.Docs.RenderedCode
@@ -24,27 +26,28 @@ import qualified Language.PureScript.Docs.Render as Render
24
26
25-- |
27-- |
26-- Take a list of modules and render them all in order, returning a single
28-- Take a list of modules and render them all in order, returning a single
27−-- Markdown-formatted String.
29+-- Markdown-formatted Text.
28--
30--
29renderModulesAsMarkdown ::
31renderModulesAsMarkdown ::
30 (MonadError P.MultipleErrors m) =>
32 (MonadError P.MultipleErrors m) =>
31 [P.Module] ->
33 [P.Module] ->
32− m String
34+ m Text
33renderModulesAsMarkdown =
35renderModulesAsMarkdown =
34− fmap (runDocs . modulesAsMarkdown) . Convert.convertModules
36+ fmap (runDocs . modulesAsMarkdown) . Convert.convertModules Local
35
37
36modulesAsMarkdown :: [Module] -> Docs
38modulesAsMarkdown :: [Module] -> Docs
37modulesAsMarkdown = mapM_ moduleAsMarkdown
39modulesAsMarkdown = mapM_ moduleAsMarkdown
38
40
39moduleAsMarkdown :: Module -> Docs
41moduleAsMarkdown :: Module -> Docs
40moduleAsMarkdown Module{..} = do
42moduleAsMarkdown Module{..} = do
41− headerLevel 2 $ "Module " ++ T.unpack (P.runModuleName modName)
43+ headerLevel 2 $ "Module " <> P.runModuleName modName
42 spacer
44 spacer
43 for_ modComments tell'
45 for_ modComments tell'
44 mapM_ (declAsMarkdown modName) modDeclarations
46 mapM_ (declAsMarkdown modName) modDeclarations
45 spacer
47 spacer
46− for_ modReExports $ \(mn, decls) -> do
48+ for_ modReExports $ \(mn', decls) -> do
49+ let mn = ignorePackage mn'
47− headerLevel 3 $ "Re-exported from " ++ T.unpack (P.runModuleName mn) ++ ":"
50+ headerLevel 3 $ "Re-exported from " <> P.runModuleName mn <> ":"
48 spacer
51 spacer
49 mapM_ (declAsMarkdown mn) decls
52 mapM_ (declAsMarkdown mn) decls
50
53
@@ -71,7 +74,7 @@ declAsMarkdown mn decl@Declaration{..} = do
71 isChildInstance (ChildInstance _ _) = True
74 isChildInstance (ChildInstance _ _) = True
72 isChildInstance _ = False
75 isChildInstance _ = False
73
76
74−codeToString :: RenderedCode -> String
77+codeToString :: RenderedCode -> Text
75codeToString = outputWith elemAsMarkdown
78codeToString = outputWith elemAsMarkdown
76 where
79 where
77 elemAsMarkdown (Syntax x) = x
80 elemAsMarkdown (Syntax x) = x
@@ -95,14 +98,14 @@ codeToString = outputWith elemAsMarkdown
95-- P.Infixr -> "right-associative"
98-- P.Infixr -> "right-associative"
96-- P.Infix -> "non-associative"
99-- P.Infix -> "non-associative"
97
100
98−childToString :: First -> ChildDeclaration -> String
101+childToString :: First -> ChildDeclaration -> Text
99childToString f decl@ChildDeclaration{..} =
102childToString f decl@ChildDeclaration{..} =
100 case cdeclInfo of
103 case cdeclInfo of
101 ChildDataConstructor _ ->
104 ChildDataConstructor _ ->
102 let c = if f == First then "=" else "|"
105 let c = if f == First then "=" else "|"
103− in " " ++ c ++ " " ++ str
106+ in " " <> c <> " " <> str
104 ChildTypeClassMember _ ->
107 ChildTypeClassMember _ ->
105− " " ++ str
108+ " " <> str
106 ChildInstance _ _ ->
109 ChildInstance _ _ ->
107 str
110 str
108 where
111 where
@@ -113,19 +116,19 @@ data First
113 | NotFirst
116 | NotFirst
114 deriving (Show, Eq, Ord)
117 deriving (Show, Eq, Ord)
115
118
116−type Docs = Writer [String] ()
119+type Docs = Writer [Text] ()
117
120
118−runDocs :: Docs -> String
121+runDocs :: Docs -> Text
119−runDocs = unlines . execWriter
122+runDocs = T.unlines . execWriter
120
123
121−tell' :: String -> Docs
124+tell' :: Text -> Docs
122tell' = tell . (:[])
125tell' = tell . (:[])
123
126
124spacer :: Docs
127spacer :: Docs
125spacer = tell' ""
128spacer = tell' ""
126
129
127−headerLevel :: Int -> String -> Docs
130+headerLevel :: Int -> Text -> Docs
128−headerLevel level hdr = tell' (replicate level '#' ++ ' ' : hdr)
131+headerLevel level hdr = tell' (T.replicate level "#" <> " " <> hdr)
129
132
130fencedBlock :: Docs -> Docs
133fencedBlock :: Docs -> Docs
131fencedBlock inner = do
134fencedBlock inner = do
@@ -133,5 +136,5 @@ fencedBlock inner = do
133 inner
136 inner
134 tell' "```"
137 tell' "```"
135
138
136−ticks :: String -> String
139+ticks :: Text -> Text
137−ticks = ("`" ++) . (++ "`")
140+ticks = ("`" <>) . (<> "`")
src/Language/PureScript/Docs/Convert.hs+20−8
@@ -15,8 +15,9 @@ import Control.Monad
15import Control.Monad.Error.Class (MonadError)
15import Control.Monad.Error.Class (MonadError)
16import Control.Monad.State (runStateT)
16import Control.Monad.State (runStateT)
17import Control.Monad.Writer.Strict (runWriterT)
17import Control.Monad.Writer.Strict (runWriterT)
18+import Data.List (find)
18import qualified Data.Map as Map
19import qualified Data.Map as Map
19−import qualified Data.Text as T
20+import Data.Text (Text)
20
21
21import Language.PureScript.Docs.Convert.ReExports (updateReExports)
22import Language.PureScript.Docs.Convert.ReExports (updateReExports)
22import Language.PureScript.Docs.Convert.Single (convertSingleModule, collectBookmarks)
23import Language.PureScript.Docs.Convert.Single (convertSingleModule, collectBookmarks)
@@ -42,9 +43,18 @@ convertModulesInPackage modules =
42 map P.getModuleName (takeLocals modules)
43 map P.getModuleName (takeLocals modules)
43 go =
44 go =
44 map ignorePackage
45 map ignorePackage
45− >>> convertModules
46+ >>> convertModules withPackage
46 >>> fmap (filter ((`elem` localNames) . modName))
47 >>> fmap (filter ((`elem` localNames) . modName))
47
48
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+
48-- |
58-- |
49-- Convert a group of modules to the intermediate format, designed for
59-- Convert a group of modules to the intermediate format, designed for
50-- producing documentation from. It is also necessary to pass an Env containing
60-- producing documentation from. It is also necessary to pass an Env containing
@@ -61,12 +71,13 @@ convertModulesInPackage modules =
61--
71--
62convertModules ::
72convertModules ::
63 (MonadError P.MultipleErrors m) =>
73 (MonadError P.MultipleErrors m) =>
74+ (P.ModuleName -> InPackage P.ModuleName) ->
64 [P.Module] ->
75 [P.Module] ->
65 m [Module]
76 m [Module]
66−convertModules =
77+convertModules withPackage =
67 P.sortModules
78 P.sortModules
68 >>> fmap (fst >>> map importPrim)
79 >>> fmap (fst >>> map importPrim)
69− >=> convertSorted
80+ >=> convertSorted withPackage
70
81
71importPrim :: P.Module -> P.Module
82importPrim :: P.Module -> P.Module
72importPrim = P.addDefaultImport (P.ModuleName [P.ProperName C.prim])
83importPrim = P.addDefaultImport (P.ModuleName [P.ProperName C.prim])
@@ -76,16 +87,17 @@ importPrim = P.addDefaultImport (P.ModuleName [P.ProperName C.prim])
76--
87--
77convertSorted ::
88convertSorted ::
78 (MonadError P.MultipleErrors m) =>
89 (MonadError P.MultipleErrors m) =>
90+ (P.ModuleName -> InPackage P.ModuleName) ->
79 [P.Module] ->
91 [P.Module] ->
80 m [Module]
92 m [Module]
81−convertSorted modules = do
93+convertSorted withPackage modules = do
82 (env, convertedModules) <- second (map convertSingleModule) <$> partiallyDesugar modules
94 (env, convertedModules) <- second (map convertSingleModule) <$> partiallyDesugar modules
83
95
84 modulesWithTypes <- typeCheckIfNecessary modules convertedModules
96 modulesWithTypes <- typeCheckIfNecessary modules convertedModules
85 let moduleMap = Map.fromList (map (modName &&& id) modulesWithTypes)
97 let moduleMap = Map.fromList (map (modName &&& id) modulesWithTypes)
86
98
87 let traversalOrder = map P.getModuleName modules
99 let traversalOrder = map P.getModuleName modules
88− pure (Map.elems (updateReExports env traversalOrder moduleMap))
100+ pure (Map.elems (updateReExports env traversalOrder withPackage moduleMap))
89
101
90-- |
102-- |
91-- If any exported value declarations have either wildcard type signatures, or
103-- If any exported value declarations have either wildcard type signatures, or
@@ -167,9 +179,9 @@ insertValueTypes env m =
167 err msg =
179 err msg =
168 P.internalError ("Docs.Convert.insertValueTypes: " ++ msg)
180 P.internalError ("Docs.Convert.insertValueTypes: " ++ msg)
169
181
170−runParser :: P.TokenParser a -> String -> Either String a
182+runParser :: P.TokenParser a -> Text -> Either String a
171runParser p s = either (Left . show) Right $ do
183runParser p s = either (Left . show) Right $ do
172− ts <- P.lex "" (T.pack s)
184+ ts <- P.lex "" s
173 P.runTokenParser "" (p <* eof) ts
185 P.runTokenParser "" (p <* eof) ts
174
186
175-- |
187-- |
src/Language/PureScript/Docs/Convert/ReExports.hs+43−19
@@ -16,6 +16,7 @@ import Data.Map (Map)
16import Data.Maybe (mapMaybe)
16import Data.Maybe (mapMaybe)
17import Data.Monoid ((<>))
17import Data.Monoid ((<>))
18import qualified Data.Map as Map
18import qualified Data.Map as Map
19+import Data.Text (Text)
19import qualified Data.Text as T
20import qualified Data.Text as T
20
21
21import Language.PureScript.Docs.Types
22import Language.PureScript.Docs.Types
@@ -34,9 +35,10 @@ import qualified Language.PureScript as P
34updateReExports ::
35updateReExports ::
35 P.Env ->
36 P.Env ->
36 [P.ModuleName] ->
37 [P.ModuleName] ->
38+ (P.ModuleName -> InPackage P.ModuleName) ->
37 Map P.ModuleName Module ->
39 Map P.ModuleName Module ->
38 Map P.ModuleName Module
40 Map P.ModuleName Module
39−updateReExports env order = execState action
41+updateReExports env order withPackage = execState action
40 where
42 where
41 action =
43 action =
42 void (traverse go order)
44 void (traverse go order)
@@ -44,7 +46,7 @@ updateReExports env order = execState action
44 go mn = do
46 go mn = do
45 mdl <- lookup' mn
47 mdl <- lookup' mn
46 reExports <- getReExports env mn
48 reExports <- getReExports env mn
47− let mdl' = mdl { modReExports = reExports }
49+ let mdl' = mdl { modReExports = map (first withPackage) reExports }
48 modify (Map.insert mn mdl')
50 modify (Map.insert mn mdl')
49
51
50 lookup' mn = do
52 lookup' mn = do
@@ -108,13 +110,14 @@ collectDeclarations imports exports = do
108 typeClasses <- collect lookupTypeClassDeclaration impTCs expTCs
110 typeClasses <- collect lookupTypeClassDeclaration impTCs expTCs
109 types <- collect lookupTypeDeclaration impTypes expTypes
111 types <- collect lookupTypeDeclaration impTypes expTypes
110 typeOps <- collect lookupTypeOpDeclaration impTypeOps expTypeOps
112 typeOps <- collect lookupTypeOpDeclaration impTypeOps expTypeOps
113+ kinds <- collect lookupKindDeclaration impKinds expKinds
111
114
112 (vals, classes) <- handleTypeClassMembers valsAndMembers typeClasses
115 (vals, classes) <- handleTypeClassMembers valsAndMembers typeClasses
113
116
114 let filteredTypes = filterDataConstructors expCtors types
117 let filteredTypes = filterDataConstructors expCtors types
115 let filteredClasses = filterTypeClassMembers (Map.keys expVals) classes
118 let filteredClasses = filterTypeClassMembers (Map.keys expVals) classes
116
119
117− pure (Map.toList (Map.unionsWith (<>) [filteredTypes, filteredClasses, vals, valOps, typeOps]))
120+ pure (Map.toList (Map.unionsWith (<>) [filteredTypes, filteredClasses, vals, valOps, typeOps, kinds]))
118
121
119 where
122 where
120
123
@@ -145,6 +148,9 @@ collectDeclarations imports exports = do
145 expTCs = P.exportedTypeClasses exports
148 expTCs = P.exportedTypeClasses exports
146 impTCs = concat (Map.elems (P.importedTypeClasses imports))
149 impTCs = concat (Map.elems (P.importedTypeClasses imports))
147
150
151+ expKinds = P.exportedKinds exports
152+ impKinds = concat (Map.elems (P.importedKinds imports))
153+
148-- |
154-- |
149-- Given a list of imported declarations (of a particular kind, ie. type, data,
155-- Given a list of imported declarations (of a particular kind, ie. type, data,
150-- class, value, etc), and the name of an exported declaration of the same
156-- class, value, etc), and the name of an exported declaration of the same
@@ -184,12 +190,12 @@ lookupValueDeclaration ::
184 MonadReader P.ModuleName m) =>
190 MonadReader P.ModuleName m) =>
185 P.ModuleName ->
191 P.ModuleName ->
186 P.Ident ->
192 P.Ident ->
187− m (P.ModuleName, [Either (String, P.Constraint, ChildDeclaration) Declaration])
193+ m (P.ModuleName, [Either (Text, P.Constraint, ChildDeclaration) Declaration])
188lookupValueDeclaration importedFrom ident = do
194lookupValueDeclaration importedFrom ident = do
189 decls <- lookupModuleDeclarations "lookupValueDeclaration" importedFrom
195 decls <- lookupModuleDeclarations "lookupValueDeclaration" importedFrom
190 let
196 let
191 rs =
197 rs =
192− filter (\d -> declTitle d == T.unpack (P.showIdent ident)
198+ filter (\d -> declTitle d == P.showIdent ident
193 && (isValue d || isValueAlias d)) decls
199 && (isValue d || isValueAlias d)) decls
194 errOther other =
200 errOther other =
195 internalErrorInModule
201 internalErrorInModule
@@ -215,7 +221,7 @@ lookupValueDeclaration importedFrom ident = do
215 (declChildren d))
221 (declChildren d))
216
222
217 matchesIdent cdecl =
223 matchesIdent cdecl =
218− cdeclTitle cdecl == T.unpack (P.showIdent ident)
224+ cdeclTitle cdecl == P.showIdent ident
219
225
220 matchesAndIsTypeClassMember =
226 matchesAndIsTypeClassMember =
221 uncurry (&&) . (matchesIdent &&& isTypeClassMember)
227 uncurry (&&) . (matchesIdent &&& isTypeClassMember)
@@ -239,7 +245,7 @@ lookupValueOpDeclaration
239 -> m (P.ModuleName, [Declaration])
245 -> m (P.ModuleName, [Declaration])
240lookupValueOpDeclaration importedFrom op = do
246lookupValueOpDeclaration importedFrom op = do
241 decls <- lookupModuleDeclarations "lookupValueOpDeclaration" importedFrom
247 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
243 [d] ->
249 [d] ->
244 pure (importedFrom, [d])
250 pure (importedFrom, [d])
245 other ->
251 other ->
@@ -259,7 +265,7 @@ lookupTypeDeclaration ::
259lookupTypeDeclaration importedFrom ty = do
265lookupTypeDeclaration importedFrom ty = do
260 decls <- lookupModuleDeclarations "lookupTypeDeclaration" importedFrom
266 decls <- lookupModuleDeclarations "lookupTypeDeclaration" importedFrom
261 let
267 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
263 case ds of
269 case ds of
264 [d] ->
270 [d] ->
265 pure (importedFrom, [d])
271 pure (importedFrom, [d])
@@ -275,7 +281,7 @@ lookupTypeOpDeclaration
275lookupTypeOpDeclaration importedFrom tyOp = do
281lookupTypeOpDeclaration importedFrom tyOp = do
276 decls <- lookupModuleDeclarations "lookupTypeOpDeclaration" importedFrom
282 decls <- lookupModuleDeclarations "lookupTypeOpDeclaration" importedFrom
277 let
283 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
279 case ds of
285 case ds of
280 [d] ->
286 [d] ->
281 pure (importedFrom, [d])
287 pure (importedFrom, [d])
@@ -291,7 +297,7 @@ lookupTypeClassDeclaration
291lookupTypeClassDeclaration importedFrom tyClass = do
297lookupTypeClassDeclaration importedFrom tyClass = do
292 decls <- lookupModuleDeclarations "lookupTypeClassDeclaration" importedFrom
298 decls <- lookupModuleDeclarations "lookupTypeClassDeclaration" importedFrom
293 let
299 let
294− ds = filter (\d -> declTitle d == T.unpack (P.runProperName tyClass)
300+ ds = filter (\d -> declTitle d == P.runProperName tyClass
295 && isTypeClass d)
301 && isTypeClass d)
296 decls
302 decls
297 case ds of
303 case ds of
@@ -302,6 +308,24 @@ lookupTypeClassDeclaration importedFrom tyClass = do
302 ("lookupTypeClassDeclaration: unexpected result: "
308 ("lookupTypeClassDeclaration: unexpected result: "
303 ++ (unlines . map show) other)
309 ++ (unlines . map show) other)
304
310
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+
305-- |
329-- |
306-- Get the full list of declarations for a particular module out of the
330-- Get the full list of declarations for a particular module out of the
307-- state, or raise an internal error if it is not there.
331-- state, or raise an internal error if it is not there.
@@ -324,7 +348,7 @@ lookupModuleDeclarations definedIn moduleName = do
324
348
325handleTypeClassMembers ::
349handleTypeClassMembers ::
326 (MonadReader P.ModuleName m) =>
350 (MonadReader P.ModuleName m) =>
327− Map P.ModuleName [Either (String, P.Constraint, ChildDeclaration) Declaration] ->
351+ Map P.ModuleName [Either (Text, P.Constraint, ChildDeclaration) Declaration] ->
328 Map P.ModuleName [Declaration] ->
352 Map P.ModuleName [Declaration] ->
329 m (Map P.ModuleName [Declaration], Map P.ModuleName [Declaration])
353 m (Map P.ModuleName [Declaration], Map P.ModuleName [Declaration])
330handleTypeClassMembers valsAndMembers typeClasses =
354handleTypeClassMembers valsAndMembers typeClasses =
@@ -339,7 +363,7 @@ handleTypeClassMembers valsAndMembers typeClasses =
339 |> fmap splitMap
363 |> fmap splitMap
340
364
341valsAndMembersToEnv ::
365valsAndMembersToEnv ::
342− [Either (String, P.Constraint, ChildDeclaration) Declaration] -> TypeClassEnv
366+ [Either (Text, P.Constraint, ChildDeclaration) Declaration] -> TypeClassEnv
343valsAndMembersToEnv xs =
367valsAndMembersToEnv xs =
344 let (envUnhandledMembers, envValues) = partitionEithers xs
368 let (envUnhandledMembers, envValues) = partitionEithers xs
345 envTypeClasses = []
369 envTypeClasses = []
@@ -360,11 +384,11 @@ typeClassesToEnv classes =
360--
384--
361data TypeClassEnv = TypeClassEnv
385data TypeClassEnv = TypeClassEnv
362 { -- |
386 { -- |
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
364 -- name of the type class they belong to, and the constraint is used to
388 -- name of the type class they belong to, and the constraint is used to
365 -- make sure that they have the correct type if they get promoted.
389 -- make sure that they have the correct type if they get promoted.
366 --
390 --
367− envUnhandledMembers :: [(String, P.Constraint, ChildDeclaration)]
391+ envUnhandledMembers :: [(Text, P.Constraint, ChildDeclaration)]
368 -- |
392 -- |
369 -- A list of normal value declarations. Type class members will be added to
393 -- A list of normal value declarations. Type class members will be added to
370 -- this list if their parent type class is not available.
394 -- this list if their parent type class is not available.
@@ -428,7 +452,7 @@ handleEnv TypeClassEnv{..} =
428 _ ->
452 _ ->
429 internalErrorInModule
453 internalErrorInModule
430 ("handleEnv: Bad child declaration passed to promoteChild: "
454 ("handleEnv: Bad child declaration passed to promoteChild: "
431− ++ cdeclTitle)
455+ ++ T.unpack cdeclTitle)
432
456
433 addConstraint constraint =
457 addConstraint constraint =
434 P.quantify . P.moveQuantifiersToFront . P.ConstrainedType [constraint]
458 P.quantify . P.moveQuantifiersToFront . P.ConstrainedType [constraint]
@@ -448,7 +472,7 @@ filterDataConstructors
448 -> Map P.ModuleName [Declaration]
472 -> Map P.ModuleName [Declaration]
449 -> Map P.ModuleName [Declaration]
473 -> Map P.ModuleName [Declaration]
450filterDataConstructors =
474filterDataConstructors =
451− filterExportedChildren isDataConstructor (T.unpack . P.runProperName)
475+ filterExportedChildren isDataConstructor P.runProperName
452
476
453-- |
477-- |
454-- Given a list of exported type class member names, remove any data
478-- Given a list of exported type class member names, remove any data
@@ -460,12 +484,12 @@ filterTypeClassMembers
460 -> Map P.ModuleName [Declaration]
484 -> Map P.ModuleName [Declaration]
461 -> Map P.ModuleName [Declaration]
485 -> Map P.ModuleName [Declaration]
462filterTypeClassMembers =
486filterTypeClassMembers =
463− filterExportedChildren isTypeClassMember (T.unpack . P.showIdent)
487+ filterExportedChildren isTypeClassMember P.showIdent
464
488
465filterExportedChildren
489filterExportedChildren
466 :: (Functor f)
490 :: (Functor f)
467 => (ChildDeclaration -> Bool)
491 => (ChildDeclaration -> Bool)
468− -> (name -> String)
492+ -> (name -> Text)
469 -> [name]
493 -> [name]
470 -> f [Declaration]
494 -> f [Declaration]
471 -> f [Declaration]
495 -> f [Declaration]
@@ -504,7 +528,7 @@ typeClassConstraintFor :: Declaration -> Maybe P.Constraint
504typeClassConstraintFor Declaration{..} =
528typeClassConstraintFor Declaration{..} =
505 case declInfo of
529 case declInfo of
506 TypeClassDeclaration tyArgs _ _ ->
530 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)
508 _ ->
532 _ ->
509 Nothing
533 Nothing
510 where
534 where
src/Language/PureScript/Docs/Convert/Single.hs+29−48
@@ -5,24 +5,19 @@ module Language.PureScript.Docs.Convert.Single
5
5
6import Prelude.Compat
6import Prelude.Compat
7
7
8−import Control.Arrow (first)
9import Control.Category ((>>>))
8import Control.Category ((>>>))
10import Control.Monad
9import Control.Monad
11
10
12−import Data.Bifunctor (bimap)
13import Data.Either
11import Data.Either
14import Data.List (nub)
12import Data.List (nub)
15−import Data.Maybe (mapMaybe)
13+import Data.Maybe (mapMaybe, fromMaybe)
16import Data.Monoid ((<>))
14import Data.Monoid ((<>))
17import Data.Text (Text)
15import Data.Text (Text)
18import qualified Data.Text as T
16import qualified Data.Text as T
19−import qualified Data.Vector as V
20
17
21import Language.PureScript.Docs.Types
18import Language.PureScript.Docs.Types
22import qualified Language.PureScript as P
19import qualified Language.PureScript as P
23
20
24−-- TODO (Christoph): Get rid of the T.unpack s
25−
26-- |
21-- |
27-- Convert a single Module, but ignore re-exports; any re-exported types or
22-- Convert a single Module, but ignore re-exports; any re-exported types or
28-- values will not appear in the result.
23-- values will not appear in the result.
@@ -48,14 +43,14 @@ convertSingleModule m@(P.Module _ coms moduleName _ _) =
48-- In the second pass, we go over all of the Left values and augment the
43-- In the second pass, we go over all of the Left values and augment the
49-- relevant declarations, leaving only the augmented Right values.
44-- relevant declarations, leaving only the augmented Right values.
50--
45--
51−-- Note that in the Left case, we provide a [String] as well as augment
46+-- Note that in the Left case, we provide a [Text] as well as augment
52−-- information. The [String] value should be a list of titles of declarations
47+-- information. The [Text] value should be a list of titles of declarations
53-- that the augmentation should apply to. For example, for a type instance
48-- that the augmentation should apply to. For example, for a type instance
54-- declaration, that would be any types or type classes mentioned in the
49-- declaration, that would be any types or type classes mentioned in the
55-- instance. For a fixity declaration, it would be just the relevant operator's
50-- instance. For a fixity declaration, it would be just the relevant operator's
56-- name.
51-- name.
57type IntermediateDeclaration
52type IntermediateDeclaration
58− = Either ([String], DeclarationAugment) Declaration
53+ = Either ([Text], DeclarationAugment) Declaration
59
54
60-- | Some data which will be used to augment a Declaration in the
55-- | Some data which will be used to augment a Declaration in the
61-- output.
56-- output.
@@ -88,6 +83,7 @@ getDeclarationTitle (P.ValueDeclaration name _ _ _) = Just (P.showIdent name)
88getDeclarationTitle (P.ExternDeclaration name _) = Just (P.showIdent name)
83getDeclarationTitle (P.ExternDeclaration name _) = Just (P.showIdent name)
89getDeclarationTitle (P.DataDeclaration _ name _ _) = Just (P.runProperName name)
84getDeclarationTitle (P.DataDeclaration _ name _ _) = Just (P.runProperName name)
90getDeclarationTitle (P.ExternDataDeclaration name _) = Just (P.runProperName name)
85getDeclarationTitle (P.ExternDataDeclaration name _) = Just (P.runProperName name)
86+getDeclarationTitle (P.ExternKindDeclaration name) = Just (P.runProperName name)
91getDeclarationTitle (P.TypeSynonymDeclaration name _ _) = Just (P.runProperName name)
87getDeclarationTitle (P.TypeSynonymDeclaration name _ _) = Just (P.runProperName name)
92getDeclarationTitle (P.TypeClassDeclaration name _ _ _ _) = Just (P.runProperName name)
88getDeclarationTitle (P.TypeClassDeclaration name _ _ _ _) = Just (P.runProperName name)
93getDeclarationTitle (P.TypeInstanceDeclaration name _ _ _ _) = Just (P.showIdent name)
89getDeclarationTitle (P.TypeInstanceDeclaration name _ _ _ _) = Just (P.showIdent name)
@@ -99,7 +95,7 @@ getDeclarationTitle _ = Nothing
99-- | Create a basic Declaration value.
95-- | Create a basic Declaration value.
100mkDeclaration :: Text -> DeclarationInfo -> Declaration
96mkDeclaration :: Text -> DeclarationInfo -> Declaration
101mkDeclaration title info =
97mkDeclaration title info =
102− Declaration { declTitle = T.unpack title
98+ Declaration { declTitle = title
103 , declComments = Nothing
99 , declComments = Nothing
104 , declSourceSpan = Nothing
100 , declSourceSpan = Nothing
105 , declChildren = []
101 , declChildren = []
@@ -121,42 +117,29 @@ convertDeclaration (P.ExternDeclaration _ ty) title =
121convertDeclaration (P.DataDeclaration dtype _ args ctors) title =
117convertDeclaration (P.DataDeclaration dtype _ args ctors) title =
122 Just (Right (mkDeclaration title info) { declChildren = children })
118 Just (Right (mkDeclaration title info) { declChildren = children })
123 where
119 where
124− info = DataDeclaration dtype (map (first T.unpack) args)
120+ info = DataDeclaration dtype args
125 children = map convertCtor ctors
121 children = map convertCtor ctors
126 convertCtor (ctor', tys) =
122 convertCtor (ctor', tys) =
127− ChildDeclaration (T.unpack (P.runProperName ctor')) Nothing Nothing (ChildDataConstructor tys)
123+ ChildDeclaration (P.runProperName ctor') Nothing Nothing (ChildDataConstructor tys)
128convertDeclaration (P.ExternDataDeclaration _ kind') title =
124convertDeclaration (P.ExternDataDeclaration _ kind') title =
129 basicDeclaration title (ExternDataDeclaration kind')
125 basicDeclaration title (ExternDataDeclaration kind')
126+convertDeclaration (P.ExternKindDeclaration _) title =
127+ basicDeclaration title ExternKindDeclaration
130convertDeclaration (P.TypeSynonymDeclaration _ args ty) title =
128convertDeclaration (P.TypeSynonymDeclaration _ args ty) title =
131− basicDeclaration title (TypeSynonymDeclaration (map (first T.unpack) args) ty)
129+ basicDeclaration title (TypeSynonymDeclaration args ty)
132convertDeclaration (P.TypeClassDeclaration _ args implies fundeps ds) title =
130convertDeclaration (P.TypeClassDeclaration _ args implies fundeps ds) title =
133 Just (Right (mkDeclaration title info) { declChildren = children })
131 Just (Right (mkDeclaration title info) { declChildren = children })
134 where
132 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)
136 children = map convertClassMember ds
134 children = map convertClassMember ds
137 convertClassMember (P.PositionedDeclaration _ _ d) =
135 convertClassMember (P.PositionedDeclaration _ _ d) =
138 convertClassMember d
136 convertClassMember d
139 convertClassMember (P.TypeDeclaration ident' ty) =
137 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)
141 convertClassMember _ =
139 convertClassMember _ =
142 P.internalError "convertDeclaration: Invalid argument to convertClassMember."
140 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)
158convertDeclaration (P.TypeInstanceDeclaration _ constraints className tys _) title =
141convertDeclaration (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))
160 where
143 where
161 classNameString = unQual className
144 classNameString = unQual className
162 typeNameStrings = nub (concatMap (P.everythingOnTypes (++) extractProperNames) tys)
145 typeNameStrings = nub (concatMap (P.everythingOnTypes (++) extractProperNames) tys)
@@ -165,7 +148,7 @@ convertDeclaration (P.TypeInstanceDeclaration _ constraints className tys _) tit
165 extractProperNames (P.TypeConstructor n) = [unQual n]
148 extractProperNames (P.TypeConstructor n) = [unQual n]
166 extractProperNames _ = []
149 extractProperNames _ = []
167
150
168− childDecl = ChildDeclaration (T.unpack title) Nothing Nothing (ChildInstance constraints classApp)
151+ childDecl = ChildDeclaration title Nothing Nothing (ChildInstance constraints classApp)
169 classApp = foldl P.TypeApp (P.TypeConstructor (fmap P.coerceProperName className)) tys
152 classApp = foldl P.TypeApp (P.TypeConstructor (fmap P.coerceProperName className)) tys
170convertDeclaration (P.ValueFixityDeclaration fixity (P.Qualified mn alias) _) title =
153convertDeclaration (P.ValueFixityDeclaration fixity (P.Qualified mn alias) _) title =
171 Just $ Right $ mkDeclaration title (AliasDeclaration fixity (P.Qualified mn (Right alias)))
154 Just $ Right $ mkDeclaration title (AliasDeclaration fixity (P.Qualified mn (Right alias)))
@@ -189,25 +172,24 @@ convertDeclaration (P.PositionedDeclaration srcSpan com d') title =
189 withAugmentChild f (t, AugmentChild d) = (t, AugmentChild (f d))
172 withAugmentChild f (t, AugmentChild d) = (t, AugmentChild (f d))
190convertDeclaration _ _ = Nothing
173convertDeclaration _ _ = Nothing
191
174
192−convertComments :: [P.Comment] -> Maybe String
175+convertComments :: [P.Comment] -> Maybe Text
193convertComments cs = do
176convertComments cs = do
194 let raw = concatMap toLines cs
177 let raw = concatMap toLines cs
195 let docs = mapMaybe stripPipe raw
178 let docs = mapMaybe stripPipe raw
196 guard (not (null docs))
179 guard (not (null docs))
197− pure (unlines docs)
180+ pure (T.unlines docs)
198
181
199 where
182 where
200− toLines (P.LineComment s) = [T.unpack s]
183+ toLines (P.LineComment s) = [s]
201− toLines (P.BlockComment s) = lines (T.unpack s)
184+ toLines (P.BlockComment s) = T.lines s
202−
185+
203− stripPipe s' =
186+ stripPipe =
204− case dropWhile (== ' ') s' of
187+ T.dropWhile (== ' ')
205− ('|':' ':s) ->
188+ >>> T.stripPrefix "|"
206− Just s
189+ >>> fmap (dropPrefix " ")
207− ('|':s) ->
190+
208− Just s
191+ dropPrefix prefix str =
209− _ ->
192+ fromMaybe str (T.stripPrefix prefix str)
210− Nothing
211
193
212-- | Go through a PureScript module and extract a list of Bookmarks; references
194-- | Go through a PureScript module and extract a list of Bookmarks; references
213-- to data types or values, to be used as a kind of index. These are used for
195-- 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]
216collectBookmarks (Local m) = map Local (collectBookmarks' m)
198collectBookmarks (Local m) = map Local (collectBookmarks' m)
217collectBookmarks (FromDep pkg m) = map (FromDep pkg) (collectBookmarks' m)
199collectBookmarks (FromDep pkg m) = map (FromDep pkg) (collectBookmarks' m)
218
200
219−collectBookmarks' :: P.Module -> [(P.ModuleName, String)]
201+collectBookmarks' :: P.Module -> [(P.ModuleName, Text)]
220collectBookmarks' m =
202collectBookmarks' m =
221 map (P.getModuleName m, )
203 map (P.getModuleName m, )
222− (mapMaybe (fmap T.unpack . getDeclarationTitle)
204+ (mapMaybe getDeclarationTitle (P.exportedDeclarations m))
223− (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
3+
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 &mdash; 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
13
13
14import Data.Maybe (maybeToList)
14import Data.Maybe (maybeToList)
15import Data.Monoid ((<>))
15import Data.Monoid ((<>))
16−import qualified Data.Text as T
17import Data.Text (Text)
16import Data.Text (Text)
17+import qualified Data.Text as T
18
18
19import Language.PureScript.Docs.RenderedCode
19import Language.PureScript.Docs.RenderedCode
20import Language.PureScript.Docs.Types
20import Language.PureScript.Docs.Types
21import Language.PureScript.Docs.Utils.MonoidExtras
21import Language.PureScript.Docs.Utils.MonoidExtras
22import qualified Language.PureScript as P
22import qualified Language.PureScript as P
23
23
24−-- TODO (Christoph): get rid of T.unpack's
25−
26renderDeclaration :: Declaration -> RenderedCode
24renderDeclaration :: Declaration -> RenderedCode
27renderDeclaration = renderDeclarationWithOptions defaultRenderTypeOptions
25renderDeclaration = renderDeclarationWithOptions defaultRenderTypeOptions
28
26
@@ -35,7 +33,7 @@ renderDeclarationWithOptions opts Declaration{..} =
35 , renderType' ty
33 , renderType' ty
36 ]
34 ]
37 DataDeclaration dtype args ->
35 DataDeclaration dtype args ->
38− [ keyword (T.unpack (P.showDataDeclType dtype))
36+ [ keyword (P.showDataDeclType dtype)
39 , renderType' (typeApp declTitle args)
37 , renderType' (typeApp declTitle args)
40 ]
38 ]
41 ExternDataDeclaration kind' ->
39 ExternDataDeclaration kind' ->
@@ -76,20 +74,25 @@ renderDeclarationWithOptions opts Declaration{..} =
76
74
77 AliasDeclaration (P.Fixity associativity precedence) for@(P.Qualified _ alias) ->
75 AliasDeclaration (P.Fixity associativity precedence) for@(P.Qualified _ alias) ->
78 [ keywordFixity associativity
76 [ keywordFixity associativity
79− , syntax $ show precedence
77+ , syntax $ T.pack $ show precedence
80 , ident $ renderQualAlias for
78 , ident $ renderQualAlias for
81 , keyword "as"
79 , keyword "as"
82 , ident $ adjustAliasName alias declTitle
80 , ident $ adjustAliasName alias declTitle
83 ]
81 ]
84
82
83+ ExternKindDeclaration ->
84+ [ keywordKind
85+ , renderKind (P.NamedKind (notQualified declTitle))
86+ ]
87+
85 where
88 where
86 renderType' :: P.Type -> RenderedCode
89 renderType' :: P.Type -> RenderedCode
87 renderType' = renderTypeWithOptions opts
90 renderType' = renderTypeWithOptions opts
88
91
89− renderQualAlias :: FixityAlias -> String
92+ renderQualAlias :: FixityAlias -> Text
90 renderQualAlias (P.Qualified mn alias)
93 renderQualAlias (P.Qualified mn alias)
91− | mn == currentModule opts = T.unpack (renderAlias id alias)
94+ | mn == currentModule opts = renderAlias id alias
92− | otherwise = T.unpack (renderAlias (\f -> P.showQualified f . P.Qualified mn) alias)
95+ | otherwise = renderAlias (\f -> P.showQualified f . P.Qualified mn) alias
93
96
94 renderAlias
97 renderAlias
95 :: (forall a. (a -> Text) -> a -> Text)
98 :: (forall a. (a -> Text) -> a -> Text)
@@ -99,8 +102,7 @@ renderDeclarationWithOptions opts Declaration{..} =
99 = either (("type " <>) . f P.runProperName)
102 = either (("type " <>) . f P.runProperName)
100 $ either (f P.runIdent) (f P.runProperName)
103 $ either (f P.runIdent) (f P.runProperName)
101
104
102− -- adjustAliasName (P.AliasType{}) title = drop 6 (init title)
103− adjustAliasName _ title = tail (init title)
105+ adjustAliasName _ title = T.tail (T.init title)
104
106
105renderChildDeclaration :: ChildDeclaration -> RenderedCode
107renderChildDeclaration :: ChildDeclaration -> RenderedCode
106renderChildDeclaration = renderChildDeclarationWithOptions defaultRenderTypeOptions
108renderChildDeclaration = renderChildDeclarationWithOptions defaultRenderTypeOptions
@@ -146,15 +148,15 @@ renderConstraintsWithOptions opts constraints
146 mintersperse (syntax "," <> sp)
148 mintersperse (syntax "," <> sp)
147 (map (renderConstraintWithOptions opts) constraints)
149 (map (renderConstraintWithOptions opts) constraints)
148
150
149−notQualified :: String -> P.Qualified (P.ProperName a)
151+notQualified :: Text -> P.Qualified (P.ProperName a)
150−notQualified = P.Qualified Nothing . P.ProperName . T.pack
152+notQualified = P.Qualified Nothing . P.ProperName
151
153
152−typeApp :: String -> [(String, Maybe P.Kind)] -> P.Type
154+typeApp :: Text -> [(Text, Maybe P.Kind)] -> P.Type
153typeApp title typeArgs =
155typeApp title typeArgs =
154 foldl P.TypeApp
156 foldl P.TypeApp
155 (P.TypeConstructor (notQualified title))
157 (P.TypeConstructor (notQualified title))
156 (map toTypeVar typeArgs)
158 (map toTypeVar typeArgs)
157
159
158−toTypeVar :: (String, Maybe P.Kind) -> P.Type
160+toTypeVar :: (Text, Maybe P.Kind) -> P.Type
159−toTypeVar (s, Nothing) = P.TypeVar (T.pack s)
161+toTypeVar (s, Nothing) = P.TypeVar s
160−toTypeVar (s, Just k) = P.KindedType (P.TypeVar (T.pack s)) k
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
14
14
15import Data.Maybe (fromMaybe)
15import Data.Maybe (fromMaybe)
16import Data.Monoid ((<>))
16import Data.Monoid ((<>))
17−import qualified Data.Text as T
18import Data.Text (Text)
17import Data.Text (Text)
19
18
20−import Control.Arrow ((<+>), first)
19+import Control.Arrow ((<+>))
21import Control.PatternArrows as PA
20import Control.PatternArrows as PA
22
21
23import Language.PureScript.Crash
22import Language.PureScript.Crash
@@ -35,7 +34,7 @@ typeLiterals = mkPattern match
35 match TypeWildcard{} =
34 match TypeWildcard{} =
36 Just (syntax "_")
35 Just (syntax "_")
37 match (TypeVar var) =
36 match (TypeVar var) =
38− Just (ident (T.unpack var))
37+ Just (ident var)
39 match (PrettyPrintObject row) =
38 match (PrettyPrintObject row) =
40 Just $ mintersperse sp
39 Just $ mintersperse sp
41 [ syntax "{"
40 [ syntax "{"
@@ -43,7 +42,7 @@ typeLiterals = mkPattern match
43 , syntax "}"
42 , syntax "}"
44 ]
43 ]
45 match (TypeConstructor (Qualified mn name)) =
44 match (TypeConstructor (Qualified mn name)) =
46− Just (ctor (T.unpack (runProperName name)) (maybeToContainingModule mn))
45+ Just (ctor (runProperName name) (maybeToContainingModule mn))
47 match REmpty =
46 match REmpty =
48 Just (syntax "()")
47 Just (syntax "()")
49 match row@RCons{} =
48 match row@RCons{} =
@@ -51,7 +50,7 @@ typeLiterals = mkPattern match
51 match (BinaryNoParensType op l r) =
50 match (BinaryNoParensType op l r) =
52 Just $ renderTypeAtom l <> sp <> renderTypeAtom op <> sp <> renderTypeAtom r
51 Just $ renderTypeAtom l <> sp <> renderTypeAtom op <> sp <> renderTypeAtom r
53 match (TypeOp (Qualified mn op)) =
52 match (TypeOp (Qualified mn op)) =
54− Just (ident' (T.unpack (runOpName op)) (maybeToContainingModule mn))
53+ Just (ident' (runOpName op) (maybeToContainingModule mn))
55 match _ =
54 match _ =
56 Nothing
55 Nothing
57
56
@@ -76,16 +75,14 @@ renderConstraints deps ty =
76-- Render code representing a Row
75-- Render code representing a Row
77--
76--
78renderRow :: Type -> RenderedCode
77renderRow :: Type -> RenderedCode
79−renderRow = uncurry renderRow' . convertString . rowToList
78+renderRow = uncurry renderRow' . rowToList
80 where
79 where
81− convertString :: ([(Text, Type)], Type) -> ([(String, Type)], Type)
82− convertString = first (map (first T.unpack))
83 renderRow' h t = renderHead h <> renderTail t
80 renderRow' h t = renderHead h <> renderTail t
84
81
85−renderHead :: [(String, Type)] -> RenderedCode
82+renderHead :: [(Text, Type)] -> RenderedCode
86renderHead = mintersperse (syntax "," <> sp) . map renderLabel
83renderHead = mintersperse (syntax "," <> sp) . map renderLabel
87
84
88−renderLabel :: (String, Type) -> RenderedCode
85+renderLabel :: (Text, Type) -> RenderedCode
89renderLabel (label, ty) =
86renderLabel (label, ty) =
90 mintersperse sp
87 mintersperse sp
91 [ ident label
88 [ ident label
@@ -145,10 +142,10 @@ matchType = buildPrettyPrinter operators matchTypeAtom
145 , [ Wrap explicitParens $ \_ ty -> ty ]
142 , [ Wrap explicitParens $ \_ ty -> ty ]
146 ]
143 ]
147
144
148−forall_ :: Pattern () Type ([String], Type)
145+forall_ :: Pattern () Type ([Text], Type)
149forall_ = mkPattern match
146forall_ = mkPattern match
150 where
147 where
151− match (PrettyPrintForAll idents ty) = Just (map T.unpack idents, ty)
148+ match (PrettyPrintForAll idents ty) = Just (idents, ty)
152 match _ = Nothing
149 match _ = Nothing
153
150
154insertPlaceholders :: RenderTypeOptions -> Type -> Type
151insertPlaceholders :: RenderTypeOptions -> Type -> Type
@@ -180,7 +177,7 @@ preprocessType opts = dePrim . insertPlaceholders opts
180-- Render code representing a Kind
177-- Render code representing a Kind
181--
178--
182renderKind :: Kind -> RenderedCode
179renderKind :: Kind -> RenderedCode
183−renderKind = kind . T.unpack . prettyPrintKind
180+renderKind = kind . prettyPrintKind
184
181
185-- |
182-- |
186-- Render code representing a Type, as it should appear inside parentheses
183-- 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
29 , keywordInstance
29 , keywordInstance
30 , keywordWhere
30 , keywordWhere
31 , keywordFixity
31 , keywordFixity
32+ , keywordKind
32 ) where
33 ) where
33
34
34import Prelude.Compat
35import Prelude.Compat
@@ -37,7 +38,7 @@ import Control.Monad.Error.Class (MonadError(..))
37
38
38import Data.Aeson.BetterErrors
39import Data.Aeson.BetterErrors
39import qualified Data.Aeson as A
40import qualified Data.Aeson as A
40−import qualified Data.Text as T
41+import Data.Text (Text)
41
42
42import qualified Language.PureScript as P
43import qualified Language.PureScript as P
43
44
@@ -46,11 +47,11 @@ import qualified Language.PureScript as P
46-- multiple output formats. For example, plain text, or highlighted HTML.
47-- multiple output formats. For example, plain text, or highlighted HTML.
47--
48--
48data RenderedCodeElement
49data RenderedCodeElement
49− = Syntax String
50+ = Syntax Text
50− | Ident String ContainingModule
51+ | Ident Text ContainingModule
51− | Ctor String ContainingModule
52+ | Ctor Text ContainingModule
52− | Kind String
53+ | Kind Text
53− | Keyword String
54+ | Keyword Text
54 | Space
55 | Space
55 deriving (Show, Eq, Ord)
56 deriving (Show, Eq, Ord)
56
57
@@ -66,9 +67,9 @@ instance A.ToJSON RenderedCodeElement where
66 toJSON (Keyword str) =
67 toJSON (Keyword str) =
67 A.toJSON ["keyword", str]
68 A.toJSON ["keyword", str]
68 toJSON Space =
69 toJSON Space =
69− A.toJSON ["space" :: String]
70+ A.toJSON ["space" :: Text]
70
71
71−asRenderedCodeElement :: Parse String RenderedCodeElement
72+asRenderedCodeElement :: Parse Text RenderedCodeElement
72asRenderedCodeElement =
73asRenderedCodeElement =
73 a Syntax "syntax" <|>
74 a Syntax "syntax" <|>
74 asIdent <|>
75 asIdent <|>
@@ -80,14 +81,14 @@ asRenderedCodeElement =
80 where
81 where
81 p <|> q = catchError p (const q)
82 p <|> q = catchError p (const q)
82
83
83− a ctor' ctorStr = ctor' <$> (nth 0 (withString (eq ctorStr)) *> nth 1 asString)
84+ a ctor' ctorStr = ctor' <$> (nth 0 (withText (eq ctorStr)) *> nth 1 asText)
84− asIdent = nth 0 (withString (eq "ident")) *> (Ident <$> nth 1 asString <*> nth 2 asContainingModule)
85+ asIdent = nth 0 (withText (eq "ident")) *> (Ident <$> nth 1 asText <*> nth 2 asContainingModule)
85− asCtor = nth 0 (withString (eq "ctor")) *> (Ctor <$> nth 1 asString <*> nth 2 asContainingModule)
86+ asCtor = nth 0 (withText (eq "ctor")) *> (Ctor <$> nth 1 asText <*> nth 2 asContainingModule)
86− asSpace = nth 0 (withString (eq "space")) *> pure Space
87+ asSpace = nth 0 (withText (eq "space")) *> pure Space
87
88
88 eq s s' = if s == s' then Right () else Left ""
89 eq s s' = if s == s' then Right () else Left ""
89
90
90− unableToParse = withString (Left . show)
91+ unableToParse = withText Left
91
92
92-- |
93-- |
93-- This type is isomorphic to 'Maybe' 'P.ModuleName'. It makes code a bit easier
94-- This type is isomorphic to 'Maybe' 'P.ModuleName'. It makes code a bit easier
@@ -103,7 +104,7 @@ instance A.ToJSON ContainingModule where
103
104
104asContainingModule :: Parse e ContainingModule
105asContainingModule :: Parse e ContainingModule
105asContainingModule =
106asContainingModule =
106− maybeToContainingModule <$> perhaps (P.moduleNameFromString . T.pack <$> asString)
107+ maybeToContainingModule <$> perhaps (P.moduleNameFromString <$> asText)
107
108
108-- |
109-- |
109-- Convert a 'Maybe' 'P.ModuleName' to a 'ContainingModule', using the obvious
110-- Convert a 'Maybe' 'P.ModuleName' to a 'ContainingModule', using the obvious
@@ -139,7 +140,7 @@ newtype RenderedCode
139instance A.ToJSON RenderedCode where
140instance A.ToJSON RenderedCode where
140 toJSON (RC elems) = A.toJSON elems
141 toJSON (RC elems) = A.toJSON elems
141
142
142−asRenderedCode :: Parse String RenderedCode
143+asRenderedCode :: Parse Text RenderedCode
143asRenderedCode = RC <$> eachInArray asRenderedCodeElement
144asRenderedCode = RC <$> eachInArray asRenderedCodeElement
144
145
145-- |
146-- |
@@ -157,22 +158,22 @@ outputWith f = foldMap f . unRC
157sp :: RenderedCode
158sp :: RenderedCode
158sp = RC [Space]
159sp = RC [Space]
159
160
160−syntax :: String -> RenderedCode
161+syntax :: Text -> RenderedCode
161syntax x = RC [Syntax x]
162syntax x = RC [Syntax x]
162
163
163−ident :: String -> RenderedCode
164+ident :: Text -> RenderedCode
164ident x = RC [Ident x ThisModule]
165ident x = RC [Ident x ThisModule]
165
166
166−ident' :: String -> ContainingModule -> RenderedCode
167+ident' :: Text -> ContainingModule -> RenderedCode
167ident' x m = RC [Ident x m]
168ident' x m = RC [Ident x m]
168
169
169−ctor :: String -> ContainingModule -> RenderedCode
170+ctor :: Text -> ContainingModule -> RenderedCode
170ctor x m = RC [Ctor x m]
171ctor x m = RC [Ctor x m]
171
172
172−kind :: String -> RenderedCode
173+kind :: Text -> RenderedCode
173kind x = RC [Kind x]
174kind x = RC [Kind x]
174
175
175−keyword :: String -> RenderedCode
176+keyword :: Text -> RenderedCode
176keyword kw = RC [Keyword kw]
177keyword kw = RC [Keyword kw]
177
178
178keywordForall :: RenderedCode
179keywordForall :: RenderedCode
@@ -200,3 +201,6 @@ keywordFixity :: P.Associativity -> RenderedCode
200keywordFixity P.Infixl = keyword "infixl"
201keywordFixity P.Infixl = keyword "infixl"
201keywordFixity P.Infixr = keyword "infixr"
202keywordFixity P.Infixr = keyword "infixr"
202keywordFixity P.Infix = keyword "infix"
203keywordFixity 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
8
8
9import Control.Arrow (first, (***))
9import Control.Arrow (first, (***))
10import Control.Monad (when)
10import Control.Monad (when)
11+import Control.Monad.Error.Class (catchError)
11
12
12import Data.Aeson ((.=))
13import Data.Aeson ((.=))
13import Data.Aeson.BetterErrors
14import Data.Aeson.BetterErrors
14import Data.ByteString.Lazy (ByteString)
15import Data.ByteString.Lazy (ByteString)
15import Data.Either (isLeft, isRight)
16import Data.Either (isLeft, isRight)
16−import Data.Maybe (mapMaybe)
17+import Data.Maybe (mapMaybe, fromMaybe)
17import Data.Text (Text)
18import Data.Text (Text)
18import Data.Version
19import Data.Version
20+import qualified Data.Vector as V
19import qualified Data.Aeson as A
21import qualified Data.Aeson as A
20import qualified Data.Text as T
22import qualified Data.Text as T
21
23
@@ -36,7 +38,7 @@ import Language.PureScript.Docs.RenderedCode as ReExports
36data Package a = Package
38data Package a = Package
37 { pkgMeta :: PackageMeta
39 { pkgMeta :: PackageMeta
38 , pkgVersion :: Version
40 , pkgVersion :: Version
39− , pkgVersionTag :: String
41+ , pkgVersionTag :: Text
40 , pkgModules :: [Module]
42 , pkgModules :: [Module]
41 , pkgBookmarks :: [Bookmark]
43 , pkgBookmarks :: [Bookmark]
42 , pkgResolvedDependencies :: [(PackageName, Version)]
44 , pkgResolvedDependencies :: [(PackageName, Version)]
@@ -71,16 +73,16 @@ packageName = bowerName . pkgMeta
71
73
72data Module = Module
74data Module = Module
73 { modName :: P.ModuleName
75 { modName :: P.ModuleName
74− , modComments :: Maybe String
76+ , modComments :: Maybe Text
75 , modDeclarations :: [Declaration]
77 , modDeclarations :: [Declaration]
76 -- Re-exported values from other modules
78 -- Re-exported values from other modules
77− , modReExports :: [(P.ModuleName, [Declaration])]
79+ , modReExports :: [(InPackage P.ModuleName, [Declaration])]
78 }
80 }
79 deriving (Show, Eq, Ord)
81 deriving (Show, Eq, Ord)
80
82
81data Declaration = Declaration
83data Declaration = Declaration
82− { declTitle :: String
84+ { declTitle :: Text
83− , declComments :: Maybe String
85+ , declComments :: Maybe Text
84 , declSourceSpan :: Maybe P.SourceSpan
86 , declSourceSpan :: Maybe P.SourceSpan
85 , declChildren :: [ChildDeclaration]
87 , declChildren :: [ChildDeclaration]
86 , declInfo :: DeclarationInfo
88 , declInfo :: DeclarationInfo
@@ -107,7 +109,7 @@ data DeclarationInfo
107 -- newtype) and its type arguments. Constructors are represented as child
109 -- newtype) and its type arguments. Constructors are represented as child
108 -- declarations.
110 -- declarations.
109 --
111 --
110− | DataDeclaration P.DataDeclType [(String, Maybe P.Kind)]
112+ | DataDeclaration P.DataDeclType [(Text, Maybe P.Kind)]
111
113
112 -- |
114 -- |
113 -- A data type foreign import, with its kind.
115 -- A data type foreign import, with its kind.
@@ -117,30 +119,54 @@ data DeclarationInfo
117 -- |
119 -- |
118 -- A type synonym, with its type arguments and its type.
120 -- A type synonym, with its type arguments and its type.
119 --
121 --
120− | TypeSynonymDeclaration [(String, Maybe P.Kind)] P.Type
122+ | TypeSynonymDeclaration [(Text, Maybe P.Kind)] P.Type
121
123
122 -- |
124 -- |
123 -- A type class, with its type arguments, its superclasses and functional
125 -- A type class, with its type arguments, its superclasses and functional
124 -- dependencies. Instances and members are represented as child declarations.
126 -- dependencies. Instances and members are represented as child declarations.
125 --
127 --
126− | TypeClassDeclaration [(String, Maybe P.Kind)] [P.Constraint] [([String], [String])]
128+ | TypeClassDeclaration [(Text, Maybe P.Kind)] [P.Constraint] [([Text], [Text])]
127
129
128 -- |
130 -- |
129 -- An operator alias declaration, with the member the alias is for and the
131 -- An operator alias declaration, with the member the alias is for and the
130 -- operator's fixity.
132 -- operator's fixity.
131 --
133 --
132 | AliasDeclaration P.Fixity FixityAlias
134 | AliasDeclaration P.Fixity FixityAlias
135+
136+ -- |
137+ -- A kind declaration
138+ --
139+ | ExternKindDeclaration
133 deriving (Show, Eq, Ord)
140 deriving (Show, Eq, Ord)
134
141
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+
135type FixityAlias = P.Qualified (Either (P.ProperName 'P.TypeName) (Either P.Ident (P.ProperName 'P.ConstructorName)))
160type FixityAlias = P.Qualified (Either (P.ProperName 'P.TypeName) (Either P.Ident (P.ProperName 'P.ConstructorName)))
136
161
137−declInfoToString :: DeclarationInfo -> String
162+declInfoToString :: DeclarationInfo -> Text
138declInfoToString (ValueDeclaration _) = "value"
163declInfoToString (ValueDeclaration _) = "value"
139declInfoToString (DataDeclaration _ _) = "data"
164declInfoToString (DataDeclaration _ _) = "data"
140declInfoToString (ExternDataDeclaration _) = "externData"
165declInfoToString (ExternDataDeclaration _) = "externData"
141declInfoToString (TypeSynonymDeclaration _ _) = "typeSynonym"
166declInfoToString (TypeSynonymDeclaration _ _) = "typeSynonym"
142declInfoToString (TypeClassDeclaration _ _ _) = "typeClass"
167declInfoToString (TypeClassDeclaration _ _ _) = "typeClass"
143declInfoToString (AliasDeclaration _ _) = "alias"
168declInfoToString (AliasDeclaration _ _) = "alias"
169+declInfoToString ExternKindDeclaration = "kind"
144
170
145isTypeClass :: Declaration -> Bool
171isTypeClass :: Declaration -> Bool
146isTypeClass Declaration{..} =
172isTypeClass Declaration{..} =
@@ -174,14 +200,20 @@ isTypeAlias Declaration{..} =
174 AliasDeclaration _ (P.Qualified _ d) -> isLeft d
200 AliasDeclaration _ (P.Qualified _ d) -> isLeft d
175 _ -> False
201 _ -> False
176
202
203+isKind :: Declaration -> Bool
204+isKind Declaration{..} =
205+ case declInfo of
206+ ExternKindDeclaration{} -> True
207+ _ -> False
208+
177-- | Discard any children which do not satisfy the given predicate.
209-- | Discard any children which do not satisfy the given predicate.
178filterChildren :: (ChildDeclaration -> Bool) -> Declaration -> Declaration
210filterChildren :: (ChildDeclaration -> Bool) -> Declaration -> Declaration
179filterChildren p decl =
211filterChildren p decl =
180 decl { declChildren = filter p (declChildren decl) }
212 decl { declChildren = filter p (declChildren decl) }
181
213
182data ChildDeclaration = ChildDeclaration
214data ChildDeclaration = ChildDeclaration
183− { cdeclTitle :: String
215+ { cdeclTitle :: Text
184− , cdeclComments :: Maybe String
216+ , cdeclComments :: Maybe Text
185 , cdeclSourceSpan :: Maybe P.SourceSpan
217 , cdeclSourceSpan :: Maybe P.SourceSpan
186 , cdeclInfo :: ChildDeclarationInfo
218 , cdeclInfo :: ChildDeclarationInfo
187 }
219 }
@@ -206,7 +238,7 @@ data ChildDeclarationInfo
206 | ChildTypeClassMember P.Type
238 | ChildTypeClassMember P.Type
207 deriving (Show, Eq, Ord)
239 deriving (Show, Eq, Ord)
208
240
209−childDeclInfoToString :: ChildDeclarationInfo -> String
241+childDeclInfoToString :: ChildDeclarationInfo -> Text
210childDeclInfoToString (ChildInstance _ _) = "instance"
242childDeclInfoToString (ChildInstance _ _) = "instance"
211childDeclInfoToString (ChildDataConstructor _) = "dataConstructor"
243childDeclInfoToString (ChildDataConstructor _) = "dataConstructor"
212childDeclInfoToString (ChildTypeClassMember _) = "typeClassMember"
244childDeclInfoToString (ChildTypeClassMember _) = "typeClassMember"
@@ -224,11 +256,11 @@ isDataConstructor ChildDeclaration{..} =
224 _ -> False
256 _ -> False
225
257
226newtype GithubUser
258newtype GithubUser
227− = GithubUser { runGithubUser :: String }
259+ = GithubUser { runGithubUser :: Text }
228 deriving (Show, Eq, Ord)
260 deriving (Show, Eq, Ord)
229
261
230newtype GithubRepo
262newtype GithubRepo
231− = GithubRepo { runGithubRepo :: String }
263+ = GithubRepo { runGithubRepo :: Text }
232 deriving (Show, Eq, Ord)
264 deriving (Show, Eq, Ord)
233
265
234data PackageError
266data PackageError
@@ -237,14 +269,14 @@ data PackageError
237 -- parser, and actual version used.
269 -- parser, and actual version used.
238 | ErrorInPackageMeta BowerError
270 | ErrorInPackageMeta BowerError
239 | InvalidVersion
271 | InvalidVersion
240− | InvalidDeclarationType String
272+ | InvalidDeclarationType Text
241− | InvalidChildDeclarationType String
273+ | InvalidChildDeclarationType Text
242 | InvalidFixity
274 | InvalidFixity
243− | InvalidKind String
275+ | InvalidKind Text
244− | InvalidDataDeclType String
276+ | InvalidDataDeclType Text
245 deriving (Show, Eq, Ord)
277 deriving (Show, Eq, Ord)
246
278
247−type Bookmark = InPackage (P.ModuleName, String)
279+type Bookmark = InPackage (P.ModuleName, Text)
248
280
249data InPackage a
281data InPackage a
250 = Local a
282 = Local a
@@ -286,7 +318,7 @@ asPackage minimumVersion uploader = do
286
318
287 Package <$> key "packageMeta" asPackageMeta .! ErrorInPackageMeta
319 Package <$> key "packageMeta" asPackageMeta .! ErrorInPackageMeta
288 <*> key "version" asVersion
320 <*> key "version" asVersion
289− <*> key "versionTag" asString
321+ <*> key "versionTag" asText
290 <*> key "modules" (eachInArray asModule)
322 <*> key "modules" (eachInArray asModule)
291 <*> key "bookmarks" asBookmarks .! ErrorInPackageMeta
323 <*> key "bookmarks" asBookmarks .! ErrorInPackageMeta
292 <*> key "resolvedDependencies" asResolvedDependencies
324 <*> key "resolvedDependencies" asResolvedDependencies
@@ -317,15 +349,15 @@ displayPackageError e = case e of
317 InvalidVersion ->
349 InvalidVersion ->
318 "Invalid version"
350 "Invalid version"
319 InvalidDeclarationType str ->
351 InvalidDeclarationType str ->
320− "Invalid declaration type: \"" <> T.pack str <> "\""
352+ "Invalid declaration type: \"" <> str <> "\""
321 InvalidChildDeclarationType str ->
353 InvalidChildDeclarationType str ->
322− "Invalid child declaration type: \"" <> T.pack str <> "\""
354+ "Invalid child declaration type: \"" <> str <> "\""
323 InvalidFixity ->
355 InvalidFixity ->
324 "Invalid fixity"
356 "Invalid fixity"
325 InvalidKind str ->
357 InvalidKind str ->
326− "Invalid kind: \"" <> T.pack str <> "\""
358+ "Invalid kind: \"" <> str <> "\""
327 InvalidDataDeclType str ->
359 InvalidDataDeclType str ->
328− "Invalid data declaration type: \"" <> T.pack str <> "\""
360+ "Invalid data declaration type: \"" <> str <> "\""
329 where
361 where
330 (<>) = T.append
362 (<>) = T.append
331
363
@@ -334,7 +366,7 @@ instance A.FromJSON a => A.FromJSON (Package a) where
334 (asPackage (Version [0,0,0,0] []) fromAesonParser)
366 (asPackage (Version [0,0,0,0] []) fromAesonParser)
335
367
336asGithubUser :: Parse e GithubUser
368asGithubUser :: Parse e GithubUser
337−asGithubUser = GithubUser <$> asString
369+asGithubUser = GithubUser <$> asText
338
370
339instance A.FromJSON GithubUser where
371instance A.FromJSON GithubUser where
340 parseJSON = toAesonParser' asGithubUser
372 parseJSON = toAesonParser' asGithubUser
@@ -351,22 +383,33 @@ parseVersion' str =
351asModule :: Parse PackageError Module
383asModule :: Parse PackageError Module
352asModule =
384asModule =
353 Module <$> key "name" (P.moduleNameFromString <$> asText)
385 Module <$> key "name" (P.moduleNameFromString <$> asText)
354− <*> key "comments" (perhaps asString)
386+ <*> key "comments" (perhaps asText)
355 <*> key "declarations" (eachInArray asDeclaration)
387 <*> key "declarations" (eachInArray asDeclaration)
356 <*> key "reExports" (eachInArray asReExport)
388 <*> key "reExports" (eachInArray asReExport)
357
389
358asDeclaration :: Parse PackageError Declaration
390asDeclaration :: Parse PackageError Declaration
359asDeclaration =
391asDeclaration =
360− Declaration <$> key "title" asString
392+ Declaration <$> key "title" asText
361− <*> key "comments" (perhaps asString)
393+ <*> key "comments" (perhaps asText)
362 <*> key "sourceSpan" (perhaps asSourceSpan)
394 <*> key "sourceSpan" (perhaps asSourceSpan)
363 <*> key "children" (eachInArray asChildDeclaration)
395 <*> key "children" (eachInArray asChildDeclaration)
364 <*> key "info" asDeclarationInfo
396 <*> key "info" asDeclarationInfo
365
397
366−asReExport :: Parse PackageError (P.ModuleName, [Declaration])
398+asReExport :: Parse PackageError (InPackage P.ModuleName, [Declaration])
367asReExport =
399asReExport =
368− (,) <$> key "moduleName" fromAesonParser
400+ (,) <$> key "moduleName" asReExportModuleName
369 <*> key "declarations" (eachInArray asDeclaration)
401 <*> 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)
370
413
371asInPackage :: Parse BowerError a -> Parse BowerError (InPackage a)
414asInPackage :: Parse BowerError a -> Parse BowerError (InPackage a)
372asInPackage inner =
415asInPackage inner =
@@ -396,7 +439,7 @@ asAssociativity = withString (maybe (Left InvalidFixity) Right . parseAssociativ
396
439
397asDeclarationInfo :: Parse PackageError DeclarationInfo
440asDeclarationInfo :: Parse PackageError DeclarationInfo
398asDeclarationInfo = do
441asDeclarationInfo = do
399− ty <- key "declType" asString
442+ ty <- key "declType" asText
400 case ty of
443 case ty of
401 "value" ->
444 "value" ->
402 ValueDeclaration <$> key "type" asType
445 ValueDeclaration <$> key "type" asType
@@ -415,13 +458,15 @@ asDeclarationInfo = do
415 "alias" ->
458 "alias" ->
416 AliasDeclaration <$> key "fixity" asFixity
459 AliasDeclaration <$> key "fixity" asFixity
417 <*> key "alias" asFixityAlias
460 <*> key "alias" asFixityAlias
461+ "kind" ->
462+ pure ExternKindDeclaration
418 other ->
463 other ->
419 throwCustomError (InvalidDeclarationType other)
464 throwCustomError (InvalidDeclarationType other)
420
465
421−asTypeArguments :: Parse PackageError [(String, Maybe P.Kind)]
466+asTypeArguments :: Parse PackageError [(Text, Maybe P.Kind)]
422asTypeArguments = eachInArray asTypeArgument
467asTypeArguments = eachInArray asTypeArgument
423 where
468 where
424− asTypeArgument = (,) <$> nth 0 asString <*> nth 1 (perhaps asKind)
469+ asTypeArgument = (,) <$> nth 0 asText <*> nth 1 (perhaps asKind)
425
470
426asKind :: Parse e P.Kind
471asKind :: Parse e P.Kind
427asKind = fromAesonParser
472asKind = fromAesonParser
@@ -429,28 +474,28 @@ asKind = fromAesonParser
429asType :: Parse e P.Type
474asType :: Parse e P.Type
430asType = fromAesonParser
475asType = fromAesonParser
431
476
432−asFunDeps :: Parse PackageError [([String], [String])]
477+asFunDeps :: Parse PackageError [([Text], [Text])]
433asFunDeps = eachInArray asFunDep
478asFunDeps = eachInArray asFunDep
434 where
479 where
435− asFunDep = (,) <$> nth 0 (eachInArray asString) <*> nth 1 (eachInArray asString)
480+ asFunDep = (,) <$> nth 0 (eachInArray asText) <*> nth 1 (eachInArray asText)
436
481
437asDataDeclType :: Parse PackageError P.DataDeclType
482asDataDeclType :: Parse PackageError P.DataDeclType
438asDataDeclType =
483asDataDeclType =
439− withString $ \s -> case s of
484+ withText $ \s -> case s of
440 "data" -> Right P.Data
485 "data" -> Right P.Data
441 "newtype" -> Right P.Newtype
486 "newtype" -> Right P.Newtype
442 other -> Left (InvalidDataDeclType other)
487 other -> Left (InvalidDataDeclType other)
443
488
444asChildDeclaration :: Parse PackageError ChildDeclaration
489asChildDeclaration :: Parse PackageError ChildDeclaration
445asChildDeclaration =
490asChildDeclaration =
446− ChildDeclaration <$> key "title" asString
491+ ChildDeclaration <$> key "title" asText
447− <*> key "comments" (perhaps asString)
492+ <*> key "comments" (perhaps asText)
448 <*> key "sourceSpan" (perhaps asSourceSpan)
493 <*> key "sourceSpan" (perhaps asSourceSpan)
449 <*> key "info" asChildDeclarationInfo
494 <*> key "info" asChildDeclarationInfo
450
495
451asChildDeclarationInfo :: Parse PackageError ChildDeclarationInfo
496asChildDeclarationInfo :: Parse PackageError ChildDeclarationInfo
452asChildDeclarationInfo = do
497asChildDeclarationInfo = do
453− ty <- key "declType" asString
498+ ty <- key "declType" asText
454 case ty of
499 case ty of
455 "instance" ->
500 "instance" ->
456 ChildInstance <$> key "dependencies" (eachInArray asConstraint)
501 ChildInstance <$> key "dependencies" (eachInArray asConstraint)
@@ -483,7 +528,7 @@ asBookmarks = eachInArray asBookmark
483asBookmark :: Parse BowerError Bookmark
528asBookmark :: Parse BowerError Bookmark
484asBookmark =
529asBookmark =
485 asInPackage ((,) <$> nth 0 (P.moduleNameFromString <$> asText)
530 asInPackage ((,) <$> nth 0 (P.moduleNameFromString <$> asText)
486− <*> nth 1 asString)
531+ <*> nth 1 asText)
487
532
488asResolvedDependencies :: Parse PackageError [(PackageName, Version)]
533asResolvedDependencies :: Parse PackageError [(PackageName, Version)]
489asResolvedDependencies =
534asResolvedDependencies =
@@ -493,8 +538,8 @@ asResolvedDependencies =
493 mapLeft _ (Right x) = Right x
538 mapLeft _ (Right x) = Right x
494
539
495asGithub :: Parse e (GithubUser, GithubRepo)
540asGithub :: Parse e (GithubUser, GithubRepo)
496−asGithub = (,) <$> nth 0 (GithubUser <$> asString)
541+asGithub = (,) <$> nth 0 (GithubUser <$> asText)
497− <*> nth 1 (GithubRepo <$> asString)
542+ <*> nth 1 (GithubRepo <$> asText)
498
543
499asSourceSpan :: Parse e P.SourceSpan
544asSourceSpan :: Parse e P.SourceSpan
500asSourceSpan = P.SourceSpan <$> key "name" asString
545asSourceSpan = P.SourceSpan <$> key "name" asString
@@ -562,6 +607,7 @@ instance A.ToJSON DeclarationInfo where
562 TypeSynonymDeclaration args ty -> ["arguments" .= args, "type" .= ty]
607 TypeSynonymDeclaration args ty -> ["arguments" .= args, "type" .= ty]
563 TypeClassDeclaration args super fundeps -> ["arguments" .= args, "superclasses" .= super, "fundeps" .= fundeps]
608 TypeClassDeclaration args super fundeps -> ["arguments" .= args, "superclasses" .= super, "fundeps" .= fundeps]
564 AliasDeclaration fixity alias -> ["fixity" .= fixity, "alias" .= alias]
609 AliasDeclaration fixity alias -> ["fixity" .= fixity, "alias" .= alias]
610+ ExternKindDeclaration -> []
565
611
566instance A.ToJSON ChildDeclarationInfo where
612instance A.ToJSON ChildDeclarationInfo where
567 toJSON info = A.object $ "declType" .= childDeclInfoToString info : props
613 toJSON info = A.object $ "declType" .= childDeclInfoToString info : props
src/Language/PureScript/Environment.hs+83−23
@@ -8,11 +8,13 @@ import Data.Aeson.TH
8import qualified Data.Aeson as A
8import qualified Data.Aeson as A
9import qualified Data.Map as M
9import qualified Data.Map as M
10import qualified Data.Set as S
10import qualified Data.Set as S
11−import Data.Maybe (fromMaybe)
11+import Data.Maybe (fromMaybe, mapMaybe)
12import Data.Text (Text)
12import Data.Text (Text)
13import qualified Data.Text as T
13import qualified Data.Text as T
14import Data.List (nub)
14import Data.List (nub)
15+import Data.Tree (Tree, rootLabel)
15import qualified Data.Graph as G
16import qualified Data.Graph as G
17+import Data.Foldable (toList)
16
18
17import Language.PureScript.Crash
19import Language.PureScript.Crash
18import Language.PureScript.Kinds
20import Language.PureScript.Kinds
@@ -36,6 +38,8 @@ data Environment = Environment
36 -- ^ Available type class dictionaries
38 -- ^ Available type class dictionaries
37 , typeClasses :: M.Map (Qualified (ProperName 'ClassName)) TypeClassData
39 , typeClasses :: M.Map (Qualified (ProperName 'ClassName)) TypeClassData
38 -- ^ Type classes
40 -- ^ Type classes
41+ , kinds :: S.Set (Qualified (ProperName 'KindName))
42+ -- ^ Kinds in scope
39 } deriving Show
43 } deriving Show
40
44
41-- | Information about a type class
45-- | Information about a type class
@@ -55,6 +59,8 @@ data TypeClassData = TypeClassData
55 -- ^ A set of indexes of type argument that are fully determined by other
59 -- ^ A set of indexes of type argument that are fully determined by other
56 -- arguments via functional dependencies. This can be computed from both
60 -- arguments via functional dependencies. This can be computed from both
57 -- typeClassArguments and typeClassDependencies.
61 -- typeClassArguments and typeClassDependencies.
62+ , typeClassCoveringSets :: S.Set (S.Set Int)
63+ -- ^ A sets of arguments that can be used to infer all other arguments.
58 } deriving Show
64 } deriving Show
59
65
60-- | A functional dependency indicates a relationship between two sets of
66-- | A functional dependency indicates a relationship between two sets of
@@ -70,11 +76,14 @@ data FunctionalDependency = FunctionalDependency
70-- The initial environment with no values and only the default javascript types defined
76-- The initial environment with no values and only the default javascript types defined
71--
77--
72initEnvironment :: Environment
78initEnvironment :: 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
74
80
75-- |
81-- |
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.
77-- Fully determined means that this argument cannot be used when selecting a type class instance.
84-- 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.
78--
87--
79-- An example of the difference between determined and fully determined would be with the class:
88-- An example of the difference between determined and fully determined would be with the class:
80-- ```class C a b c | a -> b, b -> a, b -> c```
89-- ```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
82-- Both `a` and `b` can be used in selecting a type class instance. However, `c` cannot - it is
91-- Both `a` and `b` can be used in selecting a type class instance. However, `c` cannot - it is
83-- fully determined by `a` and `b`.
92-- fully determined by `a` and `b`.
84--
93--
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.
86-- An argument is fully determined if doesn't appear at the start of a path of strongly connected components.
96-- An argument is fully determined if doesn't appear at the start of a path of strongly connected components.
87-- An argument is not fully determined otherwise.
97-- An argument is not fully determined otherwise.
88--
98--
@@ -95,26 +105,51 @@ makeTypeClassData
95 -> [Constraint]
105 -> [Constraint]
96 -> [FunctionalDependency]
106 -> [FunctionalDependency]
97 -> TypeClassData
107 -> 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
99 where
109 where
110+ argumentIndicies = [0 .. length args - 1]
111+
112+ -- each argument determines themselves
113+ identities = (\i -> (i, [i])) <$> argumentIndicies
114+
100 -- list all the edges in the graph: for each fundep an edge exists for each determiner to each determined
115 -- 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
102 fd <- deps
117 fd <- deps
103 src <- fdDeterminers fd
118 src <- fdDeterminers fd
104 (src, fdDetermined fd) : map (, []) (fdDetermined fd)
119 (src, fdDetermined fd) : map (, []) (fdDetermined fd)
105
120
106− -- here we build a graph of which arguments determine other arguments
121+ -- build a graph of which arguments determine other arguments
107− (depGraph, _, fromKey) = G.graphFromEdges ((\(n, v) -> (n, n, nub v)) <$> M.toList contributingDeps)
122+ (depGraph, fromVertex, fromKey) = G.graphFromEdges ((\(n, v) -> (n, n, nub v)) <$> M.toList contributingDeps)
108
123
109 -- do there exist any arguments that contribute to `arg` that `arg` doesn't contribute to
124 -- do there exist any arguments that contribute to `arg` that `arg` doesn't contribute to
125+ isFunDepDetermined :: Int -> Bool
110 isFunDepDetermined arg = case fromKey arg of
126 isFunDepDetermined arg = case fromKey arg of
111− Nothing -> False -- not mentioned in fundeps
127+ Nothing -> internalError "Unknown argument index in makeTypeClassData"
112 Just v -> let contributesToVar = G.reachable (G.transposeG depGraph) v
128 Just v -> let contributesToVar = G.reachable (G.transposeG depGraph) v
113 varContributesTo = G.reachable depGraph v
129 varContributesTo = G.reachable depGraph v
114 in any (\r -> not (r `elem` varContributesTo)) contributesToVar
130 in any (\r -> not (r `elem` varContributesTo)) contributesToVar
115
131
116 -- find all the arguments that are determined
132 -- find all the arguments that are determined
133+ determinedArgs :: S.Set Int
117− determinedArgs = S.fromList $ filter isFunDepDetermined [0 .. length args - 1]
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)
118
153
119-- |
154-- |
120-- The visibility of a name in scope
155-- The visibility of a name in scope
@@ -209,6 +244,21 @@ instance A.FromJSON DataDeclType where
209primName :: Text -> Qualified (ProperName a)
244primName :: Text -> Qualified (ProperName a)
210primName = Qualified (Just $ ModuleName [ProperName C.prim]) . ProperName
245primName = Qualified (Just $ ModuleName [ProperName C.prim]) . ProperName
211
246
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+
212-- |
262-- |
213-- Construct a type in the Prim module
263-- Construct a type in the Prim module
214--
264--
@@ -285,6 +335,16 @@ isTypeOrApplied t1 t2 = t1 == t2
285function :: Type -> Type -> Type
335function :: Type -> Type -> Type
286function t1 = TypeApp (TypeApp tyFunction t1)
336function t1 = TypeApp (TypeApp tyFunction t1)
287
337
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+
288-- |
348-- |
289-- The primitive types in the external javascript environment with their
349-- The primitive types in the external javascript environment with their
290-- associated kinds. There are also pseudo `Fail` and `Partial` types
350-- associated kinds. There are also pseudo `Fail` and `Partial` types
@@ -293,18 +353,18 @@ function t1 = TypeApp (TypeApp tyFunction t1)
293primTypes :: M.Map (Qualified (ProperName 'TypeName)) (Kind, TypeKind)
353primTypes :: M.Map (Qualified (ProperName 'TypeName)) (Kind, TypeKind)
294primTypes =
354primTypes =
295 M.fromList
355 M.fromList
296− [ (primName "Function", (FunKind Star (FunKind Star Star), ExternData))
356+ [ (primName "Function", (FunKind kindType (FunKind kindType kindType), ExternData))
297− , (primName "Array", (FunKind Star Star, ExternData))
357+ , (primName "Array", (FunKind kindType kindType, ExternData))
298− , (primName "Record", (FunKind (Row Star) Star, ExternData))
358+ , (primName "Record", (FunKind (Row kindType) kindType, ExternData))
299− , (primName "String", (Star, ExternData))
359+ , (primName "String", (kindType, ExternData))
300− , (primName "Char", (Star, ExternData))
360+ , (primName "Char", (kindType, ExternData))
301− , (primName "Number", (Star, ExternData))
361+ , (primName "Number", (kindType, ExternData))
302− , (primName "Int", (Star, ExternData))
362+ , (primName "Int", (kindType, ExternData))
303− , (primName "Boolean", (Star, ExternData))
363+ , (primName "Boolean", (kindType, ExternData))
304− , (primName "Partial", (Star, ExternData))
364+ , (primName "Partial", (kindType, ExternData))
305− , (primName "Fail", (FunKind Symbol Star, ExternData))
365+ , (primName "Fail", (FunKind kindSymbol kindType, ExternData))
306− , (primName "TypeString", (FunKind Star Symbol, ExternData))
366+ , (primName "TypeString", (FunKind kindType kindSymbol, ExternData))
307− , (primName "TypeConcat", (FunKind Symbol (FunKind Symbol Symbol), ExternData))
367+ , (primName "TypeConcat", (FunKind kindSymbol (FunKind kindSymbol kindSymbol), ExternData))
308 ]
368 ]
309
369
310-- |
370-- |
@@ -316,7 +376,7 @@ primClasses :: M.Map (Qualified (ProperName 'ClassName)) TypeClassData
316primClasses =
376primClasses =
317 M.fromList
377 M.fromList
318 [ (primName "Partial", (makeTypeClassData [] [] [] []))
378 [ (primName "Partial", (makeTypeClassData [] [] [] []))
319− , (primName "Fail", (makeTypeClassData [("message", Just Symbol)] [] [] []))
379+ , (primName "Fail", (makeTypeClassData [("message", Just kindSymbol)] [] [] []))
320 ]
380 ]
321
381
322-- |
382-- |
src/Language/PureScript/Errors.hs+13−8
@@ -289,8 +289,8 @@ onTypesInErrorMessageM f (ErrorMessage hints simple) = ErrorMessage <$> traverse
289 gTypeSearch (TSBefore env) = pure (TSBefore env)
289 gTypeSearch (TSBefore env) = pure (TSBefore env)
290 gTypeSearch (TSAfter result) = TSAfter <$> traverse (traverse f) result
290 gTypeSearch (TSAfter result) = TSAfter <$> traverse (traverse f) result
291
291
292−wikiUri :: ErrorMessage -> Text
292+errorDocUri :: ErrorMessage -> Text
293−wikiUri e = "https://github.com/purescript/purescript/wiki/Error-Code-" <> errorCode e
293+errorDocUri e = "https://github.com/purescript/documentation/blob/master/errors/" <> errorCode e <> ".md"
294
294
295-- TODO Other possible suggestions:
295-- TODO Other possible suggestions:
296-- WildcardInferredType - source span not small enough
296-- WildcardInferredType - source span not small enough
@@ -373,7 +373,7 @@ data PPEOptions = PPEOptions
373 { ppeCodeColor :: Maybe (ANSI.ColorIntensity, ANSI.Color) -- ^ Color code with this color... or not
373 { ppeCodeColor :: Maybe (ANSI.ColorIntensity, ANSI.Color) -- ^ Color code with this color... or not
374 , ppeFull :: Bool -- ^ Should write a full error message?
374 , ppeFull :: Bool -- ^ Should write a full error message?
375 , ppeLevel :: Level -- ^ Should this report an error or a warning?
375 , 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?
377 }
377 }
378
378
379-- | Default options for PPEOptions
379-- | Default options for PPEOptions
@@ -382,7 +382,7 @@ defaultPPEOptions = PPEOptions
382 { ppeCodeColor = Just defaultCodeColor
382 { ppeCodeColor = Just defaultCodeColor
383 , ppeFull = False
383 , ppeFull = False
384 , ppeLevel = Error
384 , ppeLevel = Error
385− , ppeShowWiki = True
385+ , ppeShowDocs = True
386 }
386 }
387
387
388
388
@@ -390,7 +390,7 @@ defaultPPEOptions = PPEOptions
390-- Pretty print a single error, simplifying if necessary
390-- Pretty print a single error, simplifying if necessary
391--
391--
392prettyPrintSingleError :: PPEOptions -> ErrorMessage -> Box.Box
392prettyPrintSingleError :: 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
394 em <- onTypesInErrorMessageM replaceUnknowns (if full then e else simplifyErrorMessage e)
394 em <- onTypesInErrorMessageM replaceUnknowns (if full then e else simplifyErrorMessage e)
395 um <- get
395 um <- get
396 return (prettyPrintErrorMessage um em)
396 return (prettyPrintErrorMessage um em)
@@ -405,10 +405,10 @@ prettyPrintSingleError (PPEOptions codeColor full level showWiki) e = flip evalS
405 ] ++
405 ] ++
406 maybe [] (return . Box.moveDown 1) typeInformation ++
406 maybe [] (return . Box.moveDown 1) typeInformation ++
407 [ Box.moveDown 1 $ paras
407 [ Box.moveDown 1 $ paras
408− [ line $ "See " <> wikiUri e <> " for more information, "
408+ [ line $ "See " <> errorDocUri e <> " for more information, "
409 , line $ "or to contribute content related to this " <> levelText <> "."
409 , line $ "or to contribute content related to this " <> levelText <> "."
410 ]
410 ]
411− | showWiki
411+ | showDocs
412 ]
412 ]
413 where
413 where
414 typeInformation :: Maybe Box.Box
414 typeInformation :: Maybe Box.Box
@@ -716,7 +716,7 @@ prettyPrintSingleError (PPEOptions codeColor full level showWiki) e = flip evalS
716 , Box.vcat Box.left (map typeAtomAsBox ts)
716 , Box.vcat Box.left (map typeAtomAsBox ts)
717 ]
717 ]
718 , line "is an orphan instance."
718 , 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."
720 , line "Consider moving the instance, if possible, or using a newtype wrapper."
720 , line "Consider moving the instance, if possible, or using a newtype wrapper."
721 ]
721 ]
722 renderSimpleErrorMessage (InvalidNewtype name) =
722 renderSimpleErrorMessage (InvalidNewtype name) =
@@ -1030,6 +1030,7 @@ prettyPrintSingleError (PPEOptions codeColor full level showWiki) e = flip evalS
1030 nameType (DctorName _) = "data constructor"
1030 nameType (DctorName _) = "data constructor"
1031 nameType (TyClassName _) = "type class"
1031 nameType (TyClassName _) = "type class"
1032 nameType (ModName _) = "module"
1032 nameType (ModName _) = "module"
1033+ nameType (KiName _) = "kind"
1033
1034
1034 runName :: Qualified Name -> Text
1035 runName :: Qualified Name -> Text
1035 runName (Qualified mn (IdentName name)) =
1036 runName (Qualified mn (IdentName name)) =
@@ -1044,6 +1045,8 @@ prettyPrintSingleError (PPEOptions codeColor full level showWiki) e = flip evalS
1044 showQualified runProperName (Qualified mn name)
1045 showQualified runProperName (Qualified mn name)
1045 runName (Qualified mn (TyClassName name)) =
1046 runName (Qualified mn (TyClassName name)) =
1046 showQualified runProperName (Qualified mn name)
1047 showQualified runProperName (Qualified mn name)
1048+ runName (Qualified mn (KiName name)) =
1049+ showQualified runProperName (Qualified mn name)
1047 runName (Qualified Nothing (ModName name)) =
1050 runName (Qualified Nothing (ModName name)) =
1048 runModuleName name
1051 runModuleName name
1049 runName (Qualified _ ModName{}) =
1052 runName (Qualified _ ModName{}) =
@@ -1148,6 +1151,8 @@ prettyPrintRef (TypeInstanceRef ident) =
1148 Just $ showIdent ident
1151 Just $ showIdent ident
1149prettyPrintRef (ModuleRef name) =
1152prettyPrintRef (ModuleRef name) =
1150 Just $ "module " <> runModuleName name
1153 Just $ "module " <> runModuleName name
1154+prettyPrintRef (KindRef pn) =
1155+ Just $ "kind " <> runProperName pn
1151prettyPrintRef (ReExportRef _ _) =
1156prettyPrintRef (ReExportRef _ _) =
1152 Nothing
1157 Nothing
1153prettyPrintRef (PositionedDeclarationRef _ _ ref) =
1158prettyPrintRef (PositionedDeclarationRef _ _ ref) =
src/Language/PureScript/Errors/JSON.hs+1−1
@@ -52,7 +52,7 @@ toJSONError verbose level e =
52 JSONError (toErrorPosition <$> sspan)
52 JSONError (toErrorPosition <$> sspan)
53 (P.renderBox (P.prettyPrintSingleError (P.PPEOptions Nothing verbose level False) (P.stripModuleAndSpan e)))
53 (P.renderBox (P.prettyPrintSingleError (P.PPEOptions Nothing verbose level False) (P.stripModuleAndSpan e)))
54 (P.errorCode e)
54 (P.errorCode e)
55− (P.wikiUri e)
55+ (P.errorDocUri e)
56 (P.spanName <$> sspan)
56 (P.spanName <$> sspan)
57 (P.runModuleName <$> P.errorModule e)
57 (P.runModuleName <$> P.errorModule e)
58 (toSuggestion e)
58 (toSuggestion e)
src/Language/PureScript/Externs.hs+9
@@ -24,6 +24,7 @@ import Data.Text (Text)
24import qualified Data.Text as T
24import qualified Data.Text as T
25import Data.Version (showVersion)
25import Data.Version (showVersion)
26import qualified Data.Map as M
26import qualified Data.Map as M
27+import qualified Data.Set as S
27
28
28import Language.PureScript.AST
29import Language.PureScript.AST
29import Language.PureScript.Crash
30import Language.PureScript.Crash
@@ -133,6 +134,10 @@ data ExternsDeclaration =
133 , edInstanceTypes :: [Type]
134 , edInstanceTypes :: [Type]
134 , edInstanceConstraints :: Maybe [Constraint]
135 , edInstanceConstraints :: Maybe [Constraint]
135 }
136 }
137+ -- | A kind declaration
138+ | EDKind
139+ { edKindName :: ProperName 'KindName
140+ }
136 deriving Show
141 deriving Show
137
142
138-- | Convert an externs file back into a module
143-- | Convert an externs file back into a module
@@ -145,6 +150,7 @@ applyExternsFileToEnvironment ExternsFile{..} = flip (foldl' applyDecl) efDeclar
145 applyDecl env (EDDataConstructor pn dTy tNm ty nms) = env { dataConstructors = M.insert (qual pn) (dTy, tNm, ty, nms) (dataConstructors env) }
150 applyDecl env (EDDataConstructor pn dTy tNm ty nms) = env { dataConstructors = M.insert (qual pn) (dTy, tNm, ty, nms) (dataConstructors env) }
146 applyDecl env (EDValue ident ty) = env { names = M.insert (Qualified (Just efModuleName) ident) (ty, External, Defined) (names env) }
151 applyDecl env (EDValue ident ty) = env { names = M.insert (Qualified (Just efModuleName) ident) (ty, External, Defined) (names env) }
147 applyDecl env (EDClass pn args members cs deps) = env { typeClasses = M.insert (qual pn) (makeTypeClassData args members cs deps) (typeClasses env) }
152 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) }
148 applyDecl env (EDInstance className ident tys cs) = env { typeClassDictionaries = updateMap (updateMap (M.insert (qual ident) dict) className) (Just efModuleName) (typeClassDictionaries env) }
154 applyDecl env (EDInstance className ident tys cs) = env { typeClassDictionaries = updateMap (updateMap (M.insert (qual ident) dict) className) (Just efModuleName) (typeClassDictionaries env) }
149 where
155 where
150 dict :: NamedDict
156 dict :: NamedDict
@@ -220,6 +226,9 @@ moduleToExternsFile (Module _ _ mn ds (Just exps)) env = ExternsFile{..}
220 , m2 <- M.elems m1
226 , m2 <- M.elems m1
221 , TypeClassDictionaryInScope{..} <- maybeToList (M.lookup (Qualified (Just mn) ident) m2)
227 , TypeClassDictionaryInScope{..} <- maybeToList (M.lookup (Qualified (Just mn) ident) m2)
222 ]
228 ]
229+ toExternsDeclaration (KindRef pn)
230+ | Qualified (Just mn) pn `S.member` kinds env
231+ = [ EDKind pn ]
223 toExternsDeclaration _ = []
232 toExternsDeclaration _ = []
224
233
225$(deriveJSON (defaultOptions { sumEncoding = ObjectWithSingleField }) ''ExternsImport)
234$(deriveJSON (defaultOptions { sumEncoding = ObjectWithSingleField }) ''ExternsImport)
src/Language/PureScript/Ide/Externs.hs+7−3
@@ -94,6 +94,7 @@ convertDecl P.EDDataConstructor{..} = Just $ IdeDeclDataConstructor $
94convertDecl P.EDValue{..} = Just $ IdeDeclValue $
94convertDecl P.EDValue{..} = Just $ IdeDeclValue $
95 IdeValue edValueName edValueType
95 IdeValue edValueName edValueType
96convertDecl P.EDClass{..} = Just (IdeDeclTypeClass edClassName)
96convertDecl P.EDClass{..} = Just (IdeDeclTypeClass edClassName)
97+convertDecl P.EDKind{..} = Just (IdeDeclKind edKindName)
97convertDecl P.EDInstance{} = Nothing
98convertDecl P.EDInstance{} = Nothing
98
99
99convertOperator :: P.ExternsFixity -> IdeDeclaration
100convertOperator :: P.ExternsFixity -> IdeDeclaration
@@ -137,9 +138,12 @@ annotateModule (defs, types) (moduleName, decls) =
137 annotateValue (op ^. ideValueOpAlias & valueOperatorAliasT) (IdeDeclValueOperator op)
138 annotateValue (op ^. ideValueOpAlias & valueOperatorAliasT) (IdeDeclValueOperator op)
138 IdeDeclTypeOperator op ->
139 IdeDeclTypeOperator op ->
139 annotateType (op ^. ideTypeOpAlias & typeOperatorAliasT) (IdeDeclTypeOperator op)
140 annotateType (op ^. ideTypeOpAlias & typeOperatorAliasT) (IdeDeclTypeOperator op)
141+ IdeDeclKind i ->
142+ annotateKind (i ^. properNameT) (IdeDeclKind i)
140 where
143 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
142 , annTypeAnnotation = Map.lookup x types
145 , annTypeAnnotation = Map.lookup x types
143 })
146 })
144− annotateValue x = IdeDeclarationAnn (ann {annLocation = Map.lookup (Left x) defs})
147+ annotateValue x = IdeDeclarationAnn (ann {annLocation = Map.lookup (IdeNSValue x) defs})
145− annotateType x = IdeDeclarationAnn (ann {annLocation = Map.lookup (Right 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
92 -- ^ The surrounding span
92 -- ^ The surrounding span
93 -> P.Declaration
93 -> P.Declaration
94 -- ^ The declaration to extract spans from
94 -- ^ The declaration to extract spans from
95− -> [(Either Text Text, P.SourceSpan)]
95+ -> [(IdeDeclNamespace, P.SourceSpan)]
96− -- ^ A @Right@ corresponds to a type level declaration, and a @Left@ to a
96+ -- ^ Declarations and their source locations
97− -- value level one
98extractSpans ss d = case d of
97extractSpans ss d = case d of
99 P.PositionedDeclaration ss' _ d' ->
98 P.PositionedDeclaration ss' _ d' ->
100 extractSpans ss' d'
99 extractSpans ss' d'
101 P.ValueDeclaration i _ _ _ ->
100 P.ValueDeclaration i _ _ _ ->
102− [(Left (P.runIdent i), ss)]
101+ [(IdeNSValue (P.runIdent i), ss)]
103 P.TypeSynonymDeclaration name _ _ ->
102 P.TypeSynonymDeclaration name _ _ ->
104− [(Right (P.runProperName name), ss)]
103+ [(IdeNSType (P.runProperName name), ss)]
105 P.TypeClassDeclaration name _ _ _ members ->
104 P.TypeClassDeclaration name _ _ _ members ->
106− (Right (P.runProperName name), ss) : concatMap (extractSpans' ss) members
105+ (IdeNSType (P.runProperName name), ss) : concatMap (extractSpans' ss) members
107 P.DataDeclaration _ name _ ctors ->
106 P.DataDeclaration _ name _ ctors ->
108− (Right (P.runProperName name), ss)
107+ (IdeNSType (P.runProperName name), ss)
109− : map (\(cname, _) -> (Left (P.runProperName cname), ss)) ctors
108+ : map (\(cname, _) -> (IdeNSValue (P.runProperName cname), ss)) ctors
110 P.ExternDeclaration ident _ ->
109 P.ExternDeclaration ident _ ->
111− [(Left (P.runIdent ident), ss)]
110+ [(IdeNSValue (P.runIdent ident), ss)]
112 P.ExternDataDeclaration name _ ->
111 P.ExternDataDeclaration name _ ->
112+ [(IdeNSType (P.runProperName name), ss)]
113+ P.ExternKindDeclaration name ->
113− [(Right (P.runProperName name), ss)]
114+ [(IdeNSKind (P.runProperName name), ss)]
114 _ -> []
115 _ -> []
115 where
116 where
116 -- We need this special case to be able to also get the position info for
117 -- 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
121 P.PositionedDeclaration ssP' _ dP' ->
122 P.PositionedDeclaration ssP' _ dP' ->
122 extractSpans' ssP' dP'
123 extractSpans' ssP' dP'
123 P.TypeDeclaration ident _ ->
124 P.TypeDeclaration ident _ ->
124− [(Left (P.runIdent ident), ssP)]
125+ [(IdeNSValue (P.runIdent ident), ssP)]
125 _ -> []
126 _ -> []
src/Language/PureScript/Ide/Types.hs+12−1
@@ -36,6 +36,7 @@ data IdeDeclaration
36 | IdeDeclTypeClass (P.ProperName 'P.ClassName)
36 | IdeDeclTypeClass (P.ProperName 'P.ClassName)
37 | IdeDeclValueOperator IdeValueOperator
37 | IdeDeclValueOperator IdeValueOperator
38 | IdeDeclTypeOperator IdeTypeOperator
38 | IdeDeclTypeOperator IdeTypeOperator
39+ | IdeDeclKind (P.ProperName 'P.KindName)
39 deriving (Show, Eq, Ord)
40 deriving (Show, Eq, Ord)
40
41
41data IdeValue = IdeValue
42data IdeValue = IdeValue
@@ -102,7 +103,7 @@ emptyAnn = Annotation Nothing Nothing Nothing
102
103
103type Module = (P.ModuleName, [IdeDeclarationAnn])
104type Module = (P.ModuleName, [IdeDeclarationAnn])
104
105
105−type DefinitionSites a = Map (Either Text Text) a
106+type DefinitionSites a = Map IdeDeclNamespace a
106type TypeAnnotations = Map P.Ident P.Type
107type TypeAnnotations = Map P.Ident P.Type
107newtype AstData a = AstData (Map P.ModuleName (DefinitionSites a, TypeAnnotations))
108newtype AstData a = AstData (Map P.ModuleName (DefinitionSites a, TypeAnnotations))
108 -- ^ SourceSpans for the definition sites of Values and Types aswell as type
109 -- ^ SourceSpans for the definition sites of Values and Types aswell as type
@@ -214,6 +215,7 @@ identifierFromDeclarationRef :: P.DeclarationRef -> Text
214identifierFromDeclarationRef (P.TypeRef name _) = P.runProperName name
215identifierFromDeclarationRef (P.TypeRef name _) = P.runProperName name
215identifierFromDeclarationRef (P.ValueRef ident) = P.runIdent ident
216identifierFromDeclarationRef (P.ValueRef ident) = P.runIdent ident
216identifierFromDeclarationRef (P.TypeClassRef name) = P.runProperName name
217identifierFromDeclarationRef (P.TypeClassRef name) = P.runProperName name
218+identifierFromDeclarationRef (P.KindRef name) = P.runProperName name
217identifierFromDeclarationRef _ = ""
219identifierFromDeclarationRef _ = ""
218
220
219data Success =
221data Success =
@@ -293,3 +295,12 @@ instance ToJSON PursuitResponse where
293 , "package" .= package
295 , "package" .= package
294 , "text" .= text
296 , "text" .= text
295 ]
297 ]
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
49 IdeDeclTypeClass name -> P.runProperName name
49 IdeDeclTypeClass name -> P.runProperName name
50 IdeDeclValueOperator op -> op ^. ideValueOpName & P.runOpName
50 IdeDeclValueOperator op -> op ^. ideValueOpName & P.runOpName
51 IdeDeclTypeOperator op -> op ^. ideTypeOpName & P.runOpName
51 IdeDeclTypeOperator op -> op ^. ideTypeOpName & P.runOpName
52+ IdeDeclKind name -> P.runProperName name
52
53
53discardAnn :: IdeDeclarationAnn -> IdeDeclaration
54discardAnn :: IdeDeclarationAnn -> IdeDeclaration
54discardAnn (IdeDeclarationAnn _ d) = d
55discardAnn (IdeDeclarationAnn _ d) = d
@@ -73,6 +74,7 @@ completionFromMatch (Match (m, IdeDeclarationAnn ann decl)) =
73 (P.runOpName op, maybe (showFixity precedence associativity (valueOperatorAliasT ref) op) prettyTypeT typeP)
74 (P.runOpName op, maybe (showFixity precedence associativity (valueOperatorAliasT ref) op) prettyTypeT typeP)
74 IdeDeclTypeOperator (IdeTypeOperator op ref precedence associativity kind) ->
75 IdeDeclTypeOperator (IdeTypeOperator op ref precedence associativity kind) ->
75 (P.runOpName op, maybe (showFixity precedence associativity (typeOperatorAliasT ref) op) (toS . P.prettyPrintKind) kind)
76 (P.runOpName op, maybe (showFixity precedence associativity (typeOperatorAliasT ref) op) (toS . P.prettyPrintKind) kind)
77+ IdeDeclKind k -> (P.runProperName k, "kind")
76
78
77 complModule = P.runModuleName m
79 complModule = P.runModuleName m
78
80
src/Language/PureScript/Interactive.hs+2
@@ -200,6 +200,8 @@ handleShowImportedModules = do
200 Just $ N.runIdent ident
200 Just $ N.runIdent ident
201 showRef (P.ModuleRef name) =
201 showRef (P.ModuleRef name) =
202 Just $ "module " <> N.runModuleName name
202 Just $ "module " <> N.runModuleName name
203+ showRef (P.KindRef pn) =
204+ Just $ "kind " <> N.runProperName pn
203 showRef (P.ReExportRef _ _) =
205 showRef (P.ReExportRef _ _) =
204 Nothing
206 Nothing
205 showRef (P.PositionedDeclarationRef _ _ ref) =
207 showRef (P.PositionedDeclarationRef _ _ ref) =
src/Language/PureScript/Interactive/Message.hs+3−3
@@ -27,8 +27,8 @@ helpMessage = "The following commands are available:\n\n " ++
27 ]
27 ]
28
28
29 extraHelp =
29 extraHelp =
30− "Further information is available on the PureScript wiki:\n" ++
30+ "Further information is available on the PureScript documentation repository:\n" ++
31− " --> https://github.com/purescript/purescript/wiki/psci"
31+ " --> https://github.com/purescript/documentation/blob/master/PSCi.md"
32
32
33-- | The welcome prologue.
33-- | The welcome prologue.
34prologueMessage :: String
34prologueMessage :: String
@@ -48,7 +48,7 @@ supportModuleMessage = unlines
48 , ""
48 , ""
49 , " psc-package install psci-support"
49 , " psc-package install psci-support"
50 , ""
50 , ""
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"
52 ]
52 ]
53
53
54-- | The quit message.
54-- | The quit message.
src/Language/PureScript/Interactive/Parser.hs+1
@@ -114,6 +114,7 @@ acceptable P.ExternDeclaration{} = True
114acceptable P.ExternDataDeclaration{} = True
114acceptable P.ExternDataDeclaration{} = True
115acceptable P.TypeClassDeclaration{} = True
115acceptable P.TypeClassDeclaration{} = True
116acceptable P.TypeInstanceDeclaration{} = True
116acceptable P.TypeInstanceDeclaration{} = True
117+acceptable P.ExternKindDeclaration{} = True
117acceptable _ = False
118acceptable _ = False
118
119
119parseReplQuery' :: String -> Either String ReplQuery
120parseReplQuery' :: String -> Either String ReplQuery
src/Language/PureScript/Kinds.hs+4−6
@@ -6,20 +6,18 @@ import Prelude.Compat
6
6
7import qualified Data.Aeson.TH as A
7import qualified Data.Aeson.TH as A
8
8
9+import Language.PureScript.Names
10+
9-- | The data type of kinds
11-- | The data type of kinds
10data Kind
12data Kind
11 -- | Unification variable of type Kind
13 -- | Unification variable of type Kind
12 = KUnknown Int
14 = KUnknown Int
13− -- | The kind of types
14− | Star
15− -- | The kind of effects
16− | Bang
17 -- | Kinds for labelled, unordered rows without duplicates
15 -- | Kinds for labelled, unordered rows without duplicates
18 | Row Kind
16 | Row Kind
19 -- | Function kinds
17 -- | Function kinds
20 | FunKind Kind Kind
18 | FunKind Kind Kind
21− -- | Type-level strings
19+ -- | A named kind
22− | Symbol
20+ | NamedKind (Qualified (ProperName 'KindName))
23 deriving (Show, Eq, Ord)
21 deriving (Show, Eq, Ord)
24
22
25$(A.deriveJSON A.defaultOptions ''Kind)
23$(A.deriveJSON A.defaultOptions ''Kind)
src/Language/PureScript/Names.hs+7−1
@@ -24,6 +24,7 @@ data Name
24 | DctorName (ProperName 'ConstructorName)
24 | DctorName (ProperName 'ConstructorName)
25 | TyClassName (ProperName 'ClassName)
25 | TyClassName (ProperName 'ClassName)
26 | ModName ModuleName
26 | ModName ModuleName
27+ | KiName (ProperName 'KindName)
27 deriving (Eq, Show)
28 deriving (Eq, Show)
28
29
29getIdentName :: Name -> Maybe Ident
30getIdentName :: Name -> Maybe Ident
@@ -117,7 +118,12 @@ instance FromJSON (ProperName a) where
117-- |
118-- |
118-- The closed set of proper name types.
119-- The closed set of proper name types.
119--
120--
120−data ProperNameType = TypeName | ConstructorName | ClassName | Namespace
121+data ProperNameType
122+ = TypeName
123+ | ConstructorName
124+ | ClassName
125+ | KindName
126+ | Namespace
121
127
122-- |
128-- |
123-- Coerces a ProperName from one ProperNameType to another. This should be used
129-- 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
31typeName :: TokenParser (ProperName 'TypeName)
31typeName :: TokenParser (ProperName 'TypeName)
32typeName = ProperName <$> tyname
32typeName = ProperName <$> tyname
33
33
34+-- |
35+-- Parse a proper name for a kind.
36+--
37+kindName :: TokenParser (ProperName 'KindName)
38+kindName = ProperName <$> kiname
39+
34-- |
40-- |
35-- Parse a proper name for a data constructor.
41-- Parse a proper name for a data constructor.
36--
42--
src/Language/PureScript/Parser/Declarations.hs+12−7
@@ -109,12 +109,16 @@ parseValueDeclaration = do
109 return $ maybe value (`Let` value) whereClause
109 return $ maybe value (`Let` value) whereClause
110
110
111parseExternDeclaration :: TokenParser Declaration
111parseExternDeclaration :: TokenParser Declaration
112−parseExternDeclaration = reserved "foreign" *> indented *> reserved "import" *> indented *>
112+parseExternDeclaration = reserved "foreign" *> indented *> reserved "import" *> indented *> parseExternAlt where
113+ parseExternAlt = parseExternData <|> P.try parseExternKind <|> parseExternTerm
114+
113− (ExternDataDeclaration <$> (reserved "data" *> indented *> typeName)
115+ parseExternData = ExternDataDeclaration <$> (reserved "data" *> indented *> typeName)
114− <*> (indented *> doubleColon *> parseKind)
116+ <*> (indented *> doubleColon *> parseKind)
115− <|> (do ident <- parseIdent
117+
118+ parseExternKind = ExternKindDeclaration <$> (reserved "kind" *> indented *> kindName)
119+
120+ parseExternTerm = ExternDeclaration <$> parseIdent
116− ty <- indented *> doubleColon *> noWildcards parsePolyType
121+ <*> (indented *> doubleColon *> noWildcards parsePolyType)
117− return $ ExternDeclaration ident ty))
118
122
119parseAssociativity :: TokenParser Associativity
123parseAssociativity :: TokenParser Associativity
120parseAssociativity =
124parseAssociativity =
@@ -163,7 +167,8 @@ parseImportDeclaration' = do
163parseDeclarationRef :: TokenParser DeclarationRef
167parseDeclarationRef :: TokenParser DeclarationRef
164parseDeclarationRef =
168parseDeclarationRef =
165 withSourceSpan PositionedDeclarationRef
169 withSourceSpan PositionedDeclarationRef
170+ $ (KindRef <$> P.try (reserved "kind" *> kindName))
166− $ (ValueRef <$> parseIdent)
171+ <|> (ValueRef <$> parseIdent)
167 <|> (ValueOpRef <$> parens parseOperator)
172 <|> (ValueOpRef <$> parens parseOperator)
168 <|> parseTypeRef
173 <|> parseTypeRef
169 <|> (TypeClassRef <$> (reserved "class" *> properName))
174 <|> (TypeClassRef <$> (reserved "class" *> properName))
src/Language/PureScript/Parser/Kinds.hs+10−8
@@ -5,6 +5,7 @@ module Language.PureScript.Parser.Kinds (parseKind) where
5
5
6import Prelude.Compat
6import Prelude.Compat
7
7
8+import Language.PureScript.Environment
8import Language.PureScript.Kinds
9import Language.PureScript.Kinds
9import Language.PureScript.Parser.Common
10import Language.PureScript.Parser.Common
10import Language.PureScript.Parser.Lexer
11import Language.PureScript.Parser.Lexer
@@ -13,26 +14,27 @@ import qualified Text.Parsec as P
13import qualified Text.Parsec.Expr as P
14import qualified Text.Parsec.Expr as P
14
15
15parseStar :: TokenParser Kind
16parseStar :: TokenParser Kind
16−parseStar = const Star <$> symbol' "*"
17+parseStar = const kindType <$> symbol' "*"
17
18
18parseBang :: TokenParser Kind
19parseBang :: TokenParser Kind
19−parseBang = const Bang <$> symbol' "!"
20+parseBang = const kindEffect <$> symbol' "!"
20
21
21−parseSymbol :: TokenParser Kind
22+parseNamedKind :: TokenParser Kind
22−parseSymbol = const Symbol <$> uname' "Symbol"
23+parseNamedKind = NamedKind <$> parseQualified kindName
23
24
24−parseTypeAtom :: TokenParser Kind
25+parseKindAtom :: TokenParser Kind
25−parseTypeAtom = indented *> P.choice
26+parseKindAtom = indented *> P.choice
26 [ parseStar
27 [ parseStar
27 , parseBang
28 , parseBang
28− , parseSymbol
29+ , parseNamedKind
29 , parens parseKind
30 , parens parseKind
30 ]
31 ]
32+
31-- |
33-- |
32-- Parse a kind
34-- Parse a kind
33--
35--
34parseKind :: TokenParser Kind
36parseKind :: TokenParser Kind
35−parseKind = P.buildExpressionParser operators parseTypeAtom P.<?> "kind"
37+parseKind = P.buildExpressionParser operators parseKindAtom P.<?> "kind"
36 where
38 where
37 operators = [ [ P.Prefix (symbol' "#" >> return Row) ]
39 operators = [ [ P.Prefix (symbol' "#" >> return Row) ]
38 , [ P.Infix (rarrow >> return FunKind) P.AssocRight ] ]
40 , [ P.Infix (rarrow >> return FunKind) P.AssocRight ] ]
src/Language/PureScript/Parser/Lexer.hs+7
@@ -43,6 +43,7 @@ module Language.PureScript.Parser.Lexer
43 , lname'
43 , lname'
44 , qualifier
44 , qualifier
45 , tyname
45 , tyname
46+ , kiname
46 , dconsname
47 , dconsname
47 , uname
48 , uname
48 , uname'
49 , uname'
@@ -474,6 +475,12 @@ tyname = token go P.<?> "type name"
474 go (UName s) = Just s
475 go (UName s) = Just s
475 go _ = Nothing
476 go _ = Nothing
476
477
478+kiname :: TokenParser Text
479+kiname = token go P.<?> "kind name"
480+ where
481+ go (UName s) = Just s
482+ go _ = Nothing
483+
477dconsname :: TokenParser Text
484dconsname :: TokenParser Text
478dconsname = token go P.<?> "data constructor name"
485dconsname = token go P.<?> "data constructor name"
479 where
486 where
src/Language/PureScript/Pretty/Kinds.hs+2−3
@@ -16,15 +16,14 @@ import Data.Text (Text)
16
16
17import Language.PureScript.Crash
17import Language.PureScript.Crash
18import Language.PureScript.Kinds
18import Language.PureScript.Kinds
19+import Language.PureScript.Names
19import Language.PureScript.Pretty.Common
20import Language.PureScript.Pretty.Common
20
21
21typeLiterals :: Pattern () Kind String
22typeLiterals :: Pattern () Kind String
22typeLiterals = mkPattern match
23typeLiterals = mkPattern match
23 where
24 where
24− match Star = Just "*"
25− match Bang = Just "!"
26− match Symbol = Just "Symbol"
27 match (KUnknown u) = Just $ 'u' : show u
25 match (KUnknown u) = Just $ 'u' : show u
26+ match (NamedKind name) = Just $ T.unpack (showQualified runProperName name)
28 match _ = Nothing
27 match _ = Nothing
29
28
30matchRow :: Pattern () Kind ((), Kind)
29matchRow :: Pattern () Kind ((), Kind)
src/Language/PureScript/Pretty/Values.hs+4−4
@@ -54,15 +54,15 @@ prettyPrintValue d (IfThenElse cond th el) =
54 // moveRight 2 (vcat left [ text "then " <> prettyPrintValueAtom (d - 1) th
54 // moveRight 2 (vcat left [ text "then " <> prettyPrintValueAtom (d - 1) th
55 , text "else " <> prettyPrintValueAtom (d - 1) el
55 , text "else " <> prettyPrintValueAtom (d - 1) el
56 ])
56 ])
57−prettyPrintValue d (Accessor prop val) = prettyPrintValueAtom (d - 1) val <> textT ("." Monoid.<> prettyPrintObjectKey prop)
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 <> text " " <> list '{' '}' (\(key, val) -> textT (key Monoid.<> " = ") <> prettyPrintValue (d - 1) val) ps
58+prettyPrintValue d (ObjectUpdate o ps) = prettyPrintValueAtom (d - 1) o `beforeWithSpace` list '{' '}' (\(key, val) -> textT (key Monoid.<> " = ") <> prettyPrintValue (d - 1) val) ps
59prettyPrintValue d (App val arg) = prettyPrintValueAtom (d - 1) val `beforeWithSpace` prettyPrintValueAtom (d - 1) arg
59prettyPrintValue d (App val arg) = prettyPrintValueAtom (d - 1) val `beforeWithSpace` prettyPrintValueAtom (d - 1) arg
60prettyPrintValue d (Abs (Left arg) val) = text ('\\' : T.unpack (showIdent arg) ++ " -> ") // moveRight 2 (prettyPrintValue (d - 1) val)
60prettyPrintValue d (Abs (Left arg) val) = text ('\\' : T.unpack (showIdent arg) ++ " -> ") // moveRight 2 (prettyPrintValue (d - 1) val)
61prettyPrintValue d (Abs (Right arg) val) = text ('\\' : T.unpack (prettyPrintBinder arg) ++ " -> ") // moveRight 2 (prettyPrintValue (d - 1) val)
61prettyPrintValue d (Abs (Right arg) val) = text ('\\' : T.unpack (prettyPrintBinder arg) ++ " -> ") // moveRight 2 (prettyPrintValue (d - 1) val)
62prettyPrintValue d (TypeClassDictionaryConstructorApp className ps) =
62prettyPrintValue d (TypeClassDictionaryConstructorApp className ps) =
63 text (T.unpack (runProperName (disqualify className)) ++ " ") <> prettyPrintValueAtom (d - 1) ps
63 text (T.unpack (runProperName (disqualify className)) ++ " ") <> prettyPrintValueAtom (d - 1) ps
64prettyPrintValue d (Case values binders) =
64prettyPrintValue 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)) //
66 moveRight 2 (vcat left (map (prettyPrintCaseAlternative (d - 1)) binders))
66 moveRight 2 (vcat left (map (prettyPrintCaseAlternative (d - 1)) binders))
67prettyPrintValue d (Let ds val) =
67prettyPrintValue d (Let ds val) =
68 text "let" //
68 text "let" //
@@ -96,7 +96,7 @@ prettyPrintValueAtom d (BinaryNoParens op lhs rhs) =
96 prettyPrintValue (d - 1) lhs `beforeWithSpace` printOp op `beforeWithSpace` prettyPrintValue (d - 1) rhs
96 prettyPrintValue (d - 1) lhs `beforeWithSpace` printOp op `beforeWithSpace` prettyPrintValue (d - 1) rhs
97 where
97 where
98 printOp (Op (Qualified _ name)) = text $ T.unpack $ runOpName name
98 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 "`"
100prettyPrintValueAtom d (TypedValue _ val _) = prettyPrintValueAtom d val
100prettyPrintValueAtom d (TypedValue _ val _) = prettyPrintValueAtom d val
101prettyPrintValueAtom d (PositionedValue _ _ val) = prettyPrintValueAtom d val
101prettyPrintValueAtom d (PositionedValue _ _ val) = prettyPrintValueAtom d val
102prettyPrintValueAtom d (Parens expr) = (text "(" <> prettyPrintValue d expr) `before` text ")"
102prettyPrintValueAtom d (Parens expr) = (text "(" <> prettyPrintValue d expr) `before` text ")"
src/Language/PureScript/Publish.hs+27−26
@@ -23,7 +23,7 @@ module Language.PureScript.Publish
23import Prelude ()
23import Prelude ()
24import Prelude.Compat hiding (userError)
24import Prelude.Compat hiding (userError)
25
25
26−import Control.Arrow ((***))
26+import Control.Arrow ((***), first)
27import Control.Category ((>>>))
27import Control.Category ((>>>))
28import Control.Exception (catch, try)
28import Control.Exception (catch, try)
29import Control.Monad.Error.Class (MonadError(..))
29import Control.Monad.Error.Class (MonadError(..))
@@ -35,12 +35,13 @@ import Data.Aeson.BetterErrors
35import Data.Char (isSpace)
35import Data.Char (isSpace)
36import Data.Foldable (traverse_)
36import Data.Foldable (traverse_)
37import Data.Function (on)
37import Data.Function (on)
38−import Data.List (stripPrefix, isSuffixOf, (\\), nubBy)
38+import Data.List (stripPrefix, (\\), nubBy)
39import Data.List.NonEmpty (NonEmpty(..))
39import Data.List.NonEmpty (NonEmpty(..))
40import Data.List.Split (splitOn)
40import Data.List.Split (splitOn)
41import Data.Maybe
41import Data.Maybe
42import Data.Version
42import Data.Version
43import qualified Data.SPDX as SPDX
43import qualified Data.SPDX as SPDX
44+import Data.Text (Text)
44import qualified Data.Text as T
45import qualified Data.Text as T
45import qualified Data.Text.Lazy as TL
46import qualified Data.Text.Lazy as TL
46import qualified Data.Text.Lazy.Encoding as TL
47import qualified Data.Text.Lazy.Encoding as TL
@@ -65,7 +66,7 @@ import qualified Language.PureScript.Docs as D
65data PublishOptions = PublishOptions
66data PublishOptions = PublishOptions
66 { -- | How to obtain the version tag and version that the data being
67 { -- | How to obtain the version tag and version that the data being
67 -- generated will refer to.
68 -- generated will refer to.
68− publishGetVersion :: PrepareM (String, Version)
69+ publishGetVersion :: PrepareM (Text, Version)
69 , -- | What to do when the working tree is dirty
70 , -- | What to do when the working tree is dirty
70 publishWorkingTreeDirty :: PrepareM ()
71 publishWorkingTreeDirty :: PrepareM ()
71 }
72 }
@@ -184,21 +185,20 @@ checkCleanWorkingTree opts = do
184 unless (status == Clean) $
185 unless (status == Clean) $
185 publishWorkingTreeDirty opts
186 publishWorkingTreeDirty opts
186
187
187−getVersionFromGitTag :: PrepareM (String, Version)
188+getVersionFromGitTag :: PrepareM (Text, Version)
188getVersionFromGitTag = do
189getVersionFromGitTag = do
189 out <- readProcess' "git" ["tag", "--list", "--points-at", "HEAD"] ""
190 out <- readProcess' "git" ["tag", "--list", "--points-at", "HEAD"] ""
190 let vs = map trimWhitespace (lines out)
191 let vs = map trimWhitespace (lines out)
191 case mapMaybe parseMay vs of
192 case mapMaybe parseMay vs of
192 [] -> userError TagMustBeCheckedOut
193 [] -> userError TagMustBeCheckedOut
193− [x] -> return x
194+ [x] -> return (first T.pack x)
194 xs -> userError (AmbiguousVersions (map snd xs))
195 xs -> userError (AmbiguousVersions (map snd xs))
195 where
196 where
196 trimWhitespace =
197 trimWhitespace =
197 dropWhile isSpace >>> reverse >>> dropWhile isSpace >>> reverse
198 dropWhile isSpace >>> reverse >>> dropWhile isSpace >>> reverse
198− parseMay str =
199+ parseMay str = do
200+ digits <- stripPrefix "v" str
199− (str,) <$> D.parseVersion' (dropPrefix "v" str)
201+ (str,) <$> D.parseVersion' digits
200− dropPrefix prefix str =
201− fromMaybe str (stripPrefix prefix str)
202
202
203getBowerRepositoryInfo :: PackageMeta -> PrepareM (D.GithubUser, D.GithubRepo)
203getBowerRepositoryInfo :: PackageMeta -> PrepareM (D.GithubUser, D.GithubRepo)
204getBowerRepositoryInfo = either (userError . BadRepositoryField) return . tryExtract
204getBowerRepositoryInfo = either (userError . BadRepositoryField) return . tryExtract
@@ -209,7 +209,7 @@ getBowerRepositoryInfo = either (userError . BadRepositoryField) return . tryExt
209 Just Repository{..} -> do
209 Just Repository{..} -> do
210 unless (repositoryType == "git")
210 unless (repositoryType == "git")
211 (Left (BadRepositoryType repositoryType))
211 (Left (BadRepositoryType repositoryType))
212− maybe (Left NotOnGithub) Right (extractGithub repositoryUrl)
212+ maybe (Left NotOnGithub) Right (extractGithub (T.pack repositoryUrl))
213
213
214checkLicense :: PackageMeta -> PrepareM ()
214checkLicense :: PackageMeta -> PrepareM ()
215checkLicense pkgMeta =
215checkLicense pkgMeta =
@@ -226,9 +226,9 @@ checkLicense pkgMeta =
226isValidSPDX :: String -> Bool
226isValidSPDX :: String -> Bool
227isValidSPDX = (== 1) . length . SPDX.parseExpression
227isValidSPDX = (== 1) . length . SPDX.parseExpression
228
228
229−extractGithub :: String -> Maybe (D.GithubUser, D.GithubRepo)
229+extractGithub :: Text -> Maybe (D.GithubUser, D.GithubRepo)
230extractGithub = stripGitHubPrefixes
230extractGithub = stripGitHubPrefixes
231− >>> fmap (splitOn "/")
231+ >>> fmap (T.splitOn "/")
232 >=> takeTwo
232 >=> takeTwo
233 >>> fmap (D.GithubUser *** (D.GithubRepo . dropDotGit))
233 >>> fmap (D.GithubUser *** (D.GithubRepo . dropDotGit))
234
234
@@ -237,18 +237,18 @@ extractGithub = stripGitHubPrefixes
237 takeTwo [x, y] = Just (x, y)
237 takeTwo [x, y] = Just (x, y)
238 takeTwo _ = Nothing
238 takeTwo _ = Nothing
239
239
240− stripGitHubPrefixes :: String -> Maybe String
240+ stripGitHubPrefixes :: Text -> Maybe Text
241 stripGitHubPrefixes = stripPrefixes [ "git://github.com/"
241 stripGitHubPrefixes = stripPrefixes [ "git://github.com/"
242 , "https://github.com/"
242 , "https://github.com/"
243 , "git@github.com:"
243 , "git@github.com:"
244 ]
244 ]
245
245
246− stripPrefixes :: [String] -> String -> Maybe String
246+ stripPrefixes :: [Text] -> Text -> Maybe Text
247− stripPrefixes prefixes str = msum $ (`stripPrefix` str) <$> prefixes
247+ stripPrefixes prefixes str = msum $ (`T.stripPrefix` str) <$> prefixes
248
248
249− dropDotGit :: String -> String
249+ dropDotGit :: Text -> Text
250 dropDotGit str
250 dropDotGit str
251− | ".git" `isSuffixOf` str = take (length str - 4) str
251+ | ".git" `T.isSuffixOf` str = T.take (T.length str - 4) str
252 | otherwise = str
252 | otherwise = str
253
253
254readProcess' :: String -> [String] -> String -> PrepareM String
254readProcess' :: String -> [String] -> String -> PrepareM String
@@ -265,12 +265,12 @@ data DependencyStatus
265 -- _resolution key. This can be caused by adding the dependency using
265 -- _resolution key. This can be caused by adding the dependency using
266 -- `bower link`, or simply copying it into bower_components instead of
266 -- `bower link`, or simply copying it into bower_components instead of
267 -- installing it normally.
267 -- installing it normally.
268− | ResolvedOther String
268+ | ResolvedOther Text
269− -- ^ Resolved, but to something other than a version. The String argument
269+ -- ^ Resolved, but to something other than a version. The Text argument
270 -- is the resolution type. The values it can take that I'm aware of are
270 -- is the resolution type. The values it can take that I'm aware of are
271 -- "commit" and "branch".
271 -- "commit" and "branch".
272− | ResolvedVersion String
272+ | ResolvedVersion Text
273− -- ^ Resolved to a version. The String argument is the resolution tag (eg,
273+ -- ^ Resolved to a version. The Text argument is the resolution tag (eg,
274 -- "v0.1.0").
274 -- "v0.1.0").
275 deriving (Show, Eq)
275 deriving (Show, Eq)
276
276
@@ -341,9 +341,9 @@ asDependencyStatus = do
341 else
341 else
342 key "pkgMeta" $
342 key "pkgMeta" $
343 keyOrDefault "_resolution" NoResolution $ do
343 keyOrDefault "_resolution" NoResolution $ do
344− type_ <- key "type" asString
344+ type_ <- key "type" asText
345 case type_ of
345 case type_ of
346− "version" -> ResolvedVersion <$> key "tag" asString
346+ "version" -> ResolvedVersion <$> key "tag" asText
347 other -> return (ResolvedOther other)
347 other -> return (ResolvedOther other)
348
348
349warnUndeclared :: [PackageName] -> [PackageName] -> PrepareM ()
349warnUndeclared :: [PackageName] -> [PackageName] -> PrepareM ()
@@ -374,15 +374,16 @@ handleDeps deps = do
374 bowerDir pkgName = "bower_components/" ++ runPackageName pkgName
374 bowerDir pkgName = "bower_components/" ++ runPackageName pkgName
375
375
376 -- Try to extract a version, and warn if unsuccessful.
376 -- Try to extract a version, and warn if unsuccessful.
377+ tryExtractVersion' :: (PackageName, Text) -> PrepareM (Maybe (PackageName, Version))
377 tryExtractVersion' pair =
378 tryExtractVersion' pair =
378 maybe (warn (UnacceptableVersion pair) >> return Nothing)
379 maybe (warn (UnacceptableVersion pair) >> return Nothing)
379 (return . Just)
380 (return . Just)
380 (tryExtractVersion pair)
381 (tryExtractVersion pair)
381
382
382−tryExtractVersion :: (PackageName, String) -> Maybe (PackageName, Version)
383+tryExtractVersion :: (PackageName, Text) -> Maybe (PackageName, Version)
383tryExtractVersion (pkgName, tag) =
384tryExtractVersion (pkgName, tag) =
384− let tag' = fromMaybe tag (stripPrefix "v" tag)
385+ let tag' = fromMaybe tag (T.stripPrefix "v" tag)
385− in (pkgName,) <$> D.parseVersion' tag'
386+ in (pkgName,) <$> D.parseVersion' (T.unpack tag')
386
387
387-- | Returns whether it looks like there is a purescript package checked out
388-- | Returns whether it looks like there is a purescript package checked out
388-- in the given directory.
389-- in the given directory.
src/Language/PureScript/Publish/ErrorsWarnings.hs+7−7
@@ -24,6 +24,7 @@ import Data.Maybe
24import Data.Monoid
24import Data.Monoid
25import Data.Version
25import Data.Version
26import qualified Data.List.NonEmpty as NonEmpty
26import qualified Data.List.NonEmpty as NonEmpty
27+import Data.Text (Text)
27import qualified Data.Text as T
28import qualified Data.Text as T
28
29
29import Language.PureScript.Publish.BoxesHelpers
30import Language.PureScript.Publish.BoxesHelpers
@@ -43,7 +44,7 @@ data PackageError
43data PackageWarning
44data PackageWarning
44 = NoResolvedVersion PackageName
45 = NoResolvedVersion PackageName
45 | UndeclaredDependency PackageName
46 | UndeclaredDependency PackageName
46− | UnacceptableVersion (PackageName, String)
47+ | UnacceptableVersion (PackageName, Text)
47 | DirtyWorkingTree_Warn
48 | DirtyWorkingTree_Warn
48 deriving (Show)
49 deriving (Show)
49
50
@@ -147,9 +148,8 @@ displayUserError e = case e of
147 , "version."
148 , "version."
148 ])
149 ])
149 , spacer
150 , spacer
150− , para "Note: tagged versions must be in one of the following forms:"
151+ , para "Note: tagged versions must be in the form"
151− , indented (para "* v{MAJOR}.{MINOR}.{PATCH} (example: \"v1.6.2\")")
152+ , indented (para "v{MAJOR}.{MINOR}.{PATCH} (example: \"v1.6.2\")")
152− , indented (para "* {MAJOR}.{MINOR}.{PATCH} (example: \"1.6.2\")")
153 , spacer
153 , spacer
154 , para (concat
154 , para (concat
155 [ "If the version you are publishing is not yet tagged, you might "
155 [ "If the version you are publishing is not yet tagged, you might "
@@ -311,7 +311,7 @@ displayOtherError e = case e of
311data CollectedWarnings = CollectedWarnings
311data CollectedWarnings = CollectedWarnings
312 { noResolvedVersions :: [PackageName]
312 { noResolvedVersions :: [PackageName]
313 , undeclaredDependencies :: [PackageName]
313 , undeclaredDependencies :: [PackageName]
314− , unacceptableVersions :: [(PackageName, String)]
314+ , unacceptableVersions :: [(PackageName, Text)]
315 , dirtyWorkingTree :: Any
315 , dirtyWorkingTree :: Any
316 }
316 }
317 deriving (Show, Eq, Ord)
317 deriving (Show, Eq, Ord)
@@ -387,7 +387,7 @@ warnUndeclaredDependencies pkgNames =
387 ])
387 ])
388 : bulletedList runPackageName (NonEmpty.toList pkgNames)
388 : bulletedList runPackageName (NonEmpty.toList pkgNames)
389
389
390−warnUnacceptableVersions :: NonEmpty (PackageName, String) -> Box
390+warnUnacceptableVersions :: NonEmpty (PackageName, Text) -> Box
391warnUnacceptableVersions pkgs =
391warnUnacceptableVersions pkgs =
392 let singular = NonEmpty.length pkgs == 1
392 let singular = NonEmpty.length pkgs == 1
393 pl a b = if singular then b else a
393 pl a b = if singular then b else a
@@ -414,7 +414,7 @@ warnUnacceptableVersions pkgs =
414 ])
414 ])
415 ]
415 ]
416 where
416 where
417− showTuple (pkgName, tag) = runPackageName pkgName ++ "#" ++ tag
417+ showTuple (pkgName, tag) = runPackageName pkgName ++ "#" ++ T.unpack tag
418
418
419warnDirtyWorkingTree :: Box
419warnDirtyWorkingTree :: Box
420warnDirtyWorkingTree =
420warnDirtyWorkingTree =
src/Language/PureScript/Sugar.hs+1−1
@@ -62,6 +62,6 @@ desugar externs =
62 >=> desugarImports externs
62 >=> desugarImports externs
63 >=> rebracket externs
63 >=> rebracket externs
64 >=> traverse checkFixityExports
64 >=> traverse checkFixityExports
65− >=> traverse deriveInstances
65+ >=> traverse (deriveInstances externs)
66 >=> desugarTypeClasses externs
66 >=> desugarTypeClasses externs
67 >=> traverse createBindingGroupsModule
67 >=> traverse createBindingGroupsModule
src/Language/PureScript/Sugar/BindingGroups.hs+1
@@ -73,6 +73,7 @@ createBindingGroups moduleName = mapM f <=< handleDecls
73 valueVerts = map (\d -> (d, declIdent d, usedIdents moduleName d `intersect` allIdents)) values
73 valueVerts = map (\d -> (d, declIdent d, usedIdents moduleName d `intersect` allIdents)) values
74 bindingGroupDecls <- parU (stronglyConnComp valueVerts) (toBindingGroup moduleName)
74 bindingGroupDecls <- parU (stronglyConnComp valueVerts) (toBindingGroup moduleName)
75 return $ filter isImportDecl ds ++
75 return $ filter isImportDecl ds ++
76+ filter isExternKindDecl ds ++
76 filter isExternDataDecl ds ++
77 filter isExternDataDecl ds ++
77 dataBindingGroupDecls ++
78 dataBindingGroupDecls ++
78 filter isTypeClassDeclaration ds ++
79 filter isTypeClassDeclaration ds ++
src/Language/PureScript/Sugar/Names.hs+39−7
@@ -25,6 +25,7 @@ import Language.PureScript.AST
25import Language.PureScript.Crash
25import Language.PureScript.Crash
26import Language.PureScript.Errors
26import Language.PureScript.Errors
27import Language.PureScript.Externs
27import Language.PureScript.Externs
28+import Language.PureScript.Kinds
28import Language.PureScript.Linter.Imports
29import Language.PureScript.Linter.Imports
29import Language.PureScript.Names
30import Language.PureScript.Names
30import Language.PureScript.Sugar.Names.Env
31import Language.PureScript.Sugar.Names.Env
@@ -98,6 +99,9 @@ desugarImportsWithEnv externs modules = do
98 exportedRefs :: Ord a => (DeclarationRef -> Maybe a) -> M.Map a ModuleName
99 exportedRefs :: Ord a => (DeclarationRef -> Maybe a) -> M.Map a ModuleName
99 exportedRefs f = M.fromList $ (, efModuleName) <$> mapMaybe f efExports
100 exportedRefs f = M.fromList $ (, efModuleName) <$> mapMaybe f efExports
100
101
102+ exportedKinds :: M.Map (ProperName 'KindName) ModuleName
103+ exportedKinds = exportedRefs getKindRef
104+
101 updateEnv :: ([Module], Env) -> Module -> m ([Module], Env)
105 updateEnv :: ([Module], Env) -> Module -> m ([Module], Env)
102 updateEnv (ms, env) m@(Module ss _ mn _ refs) = do
106 updateEnv (ms, env) m@(Module ss _ mn _ refs) = do
103 members <- findExportable m
107 members <- findExportable m
@@ -128,6 +132,7 @@ elaborateExports exps (Module ss coms mn decls refs) =
128 ++ go TypeClassRef exportedTypeClasses
132 ++ go TypeClassRef exportedTypeClasses
129 ++ go ValueRef exportedValues
133 ++ go ValueRef exportedValues
130 ++ go ValueOpRef exportedValueOps
134 ++ go ValueOpRef exportedValueOps
135+ ++ go KindRef exportedKinds
131 ++ maybe [] (filter isModuleRef) refs
136 ++ maybe [] (filter isModuleRef) refs
132 where
137 where
133
138
@@ -165,17 +170,24 @@ renameInModule imports (Module ss coms mn decls exps) =
165 updateDecl (_, bound) d@(PositionedDeclaration pos _ _) =
170 updateDecl (_, bound) d@(PositionedDeclaration pos _ _) =
166 return ((Just pos, bound), d)
171 return ((Just pos, bound), d)
167 updateDecl (pos, bound) (DataDeclaration dtype name args dctors) =
172 updateDecl (pos, bound) (DataDeclaration dtype name args dctors) =
173+ (,) (pos, bound) <$> (DataDeclaration dtype name <$> updateTypeArguments pos args
168− (,) (pos, bound) <$> (DataDeclaration dtype name args <$> traverse (sndM (traverse (updateTypesEverywhere pos))) dctors)
174+ <*> traverse (sndM (traverse (updateTypesEverywhere pos))) dctors)
169 updateDecl (pos, bound) (TypeSynonymDeclaration name ps ty) =
175 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)
171 updateDecl (pos, bound) (TypeClassDeclaration className args implies deps ds) =
178 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)
173 updateDecl (pos, bound) (TypeInstanceDeclaration name cs cn ts ds) =
183 updateDecl (pos, bound) (TypeInstanceDeclaration name cs cn ts ds) =
174 (,) (pos, bound) <$> (TypeInstanceDeclaration name <$> updateConstraints pos cs <*> updateClassName cn pos <*> traverse (updateTypesEverywhere pos) ts <*> pure ds)
184 (,) (pos, bound) <$> (TypeInstanceDeclaration name <$> updateConstraints pos cs <*> updateClassName cn pos <*> traverse (updateTypesEverywhere pos) ts <*> pure ds)
175 updateDecl (pos, bound) (TypeDeclaration name ty) =
185 updateDecl (pos, bound) (TypeDeclaration name ty) =
176 (,) (pos, bound) <$> (TypeDeclaration name <$> updateTypesEverywhere pos ty)
186 (,) (pos, bound) <$> (TypeDeclaration name <$> updateTypesEverywhere pos ty)
177 updateDecl (pos, bound) (ExternDeclaration name ty) =
187 updateDecl (pos, bound) (ExternDeclaration name ty) =
178 (,) (pos, name : bound) <$> (ExternDeclaration name <$> updateTypesEverywhere pos ty)
188 (,) (pos, name : bound) <$> (ExternDeclaration name <$> updateTypesEverywhere pos ty)
189+ updateDecl (pos, bound) (ExternDataDeclaration name ki) =
190+ (,) (pos, bound) <$> (ExternDataDeclaration name <$> updateKindsEverywhere pos ki)
179 updateDecl (pos, bound) (TypeFixityDeclaration fixity alias op) =
191 updateDecl (pos, bound) (TypeFixityDeclaration fixity alias op) =
180 (,) (pos, bound) <$> (TypeFixityDeclaration fixity <$> updateTypeName alias pos <*> pure op)
192 (,) (pos, bound) <$> (TypeFixityDeclaration fixity <$> updateTypeName alias pos <*> pure op)
181 updateDecl (pos, bound) (ValueFixityDeclaration fixity (Qualified mn' (Left alias)) op) =
193 updateDecl (pos, bound) (ValueFixityDeclaration fixity (Qualified mn' (Left alias)) op) =
@@ -238,6 +250,19 @@ renameInModule imports (Module ss coms mn decls exps) =
238 letBoundVariable (PositionedDeclaration _ _ d) = letBoundVariable d
250 letBoundVariable (PositionedDeclaration _ _ d) = letBoundVariable d
239 letBoundVariable _ = Nothing
251 letBoundVariable _ = Nothing
240
252
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+
241 updateTypesEverywhere :: Maybe SourceSpan -> Type -> m Type
266 updateTypesEverywhere :: Maybe SourceSpan -> Type -> m Type
242 updateTypesEverywhere pos = everywhereOnTypesM updateType
267 updateTypesEverywhere pos = everywhereOnTypesM updateType
243 where
268 where
@@ -245,16 +270,17 @@ renameInModule imports (Module ss coms mn decls exps) =
245 updateType (TypeOp name) = TypeOp <$> updateTypeOpName name pos
270 updateType (TypeOp name) = TypeOp <$> updateTypeOpName name pos
246 updateType (TypeConstructor name) = TypeConstructor <$> updateTypeName name pos
271 updateType (TypeConstructor name) = TypeConstructor <$> updateTypeName name pos
247 updateType (ConstrainedType cs t) = ConstrainedType <$> traverse updateInConstraint cs <*> pure t
272 updateType (ConstrainedType cs t) = ConstrainedType <$> traverse updateInConstraint cs <*> pure t
273+ updateType (KindedType t k) = KindedType t <$> updateKindsEverywhere pos k
248 updateType t = return t
274 updateType t = return t
249 updateInConstraint :: Constraint -> m Constraint
275 updateInConstraint :: Constraint -> m Constraint
250 updateInConstraint (Constraint name ts info) =
276 updateInConstraint (Constraint name ts info) =
251 Constraint <$> updateClassName name pos <*> pure ts <*> pure info
277 Constraint <$> updateClassName name pos <*> pure ts <*> pure info
252
278
253 updateConstraints :: Maybe SourceSpan -> [Constraint] -> m [Constraint]
279 updateConstraints :: Maybe SourceSpan -> [Constraint] -> m [Constraint]
254− updateConstraints pos = traverse $ \(Constraint name ts info) ->
280+ updateConstraints pos = traverse $ \(Constraint name ts info) ->
255− Constraint
281+ Constraint
256− <$> updateClassName name pos
282+ <$> updateClassName name pos
257− <*> traverse (updateTypesEverywhere pos) ts
283+ <*> traverse (updateTypesEverywhere pos) ts
258 <*> pure info
284 <*> pure info
259
285
260 updateTypeName
286 updateTypeName
@@ -290,6 +316,12 @@ renameInModule imports (Module ss coms mn decls exps) =
290 -> m (Qualified (OpName 'ValueOpName))
316 -> m (Qualified (OpName 'ValueOpName))
291 updateValueOpName = update (importedValueOps imports) ValOpName
317 updateValueOpName = update (importedValueOps imports) ValOpName
292
318
319+ updateKindName
320+ :: Qualified (ProperName 'KindName)
321+ -> Maybe SourceSpan
322+ -> m (Qualified (ProperName 'KindName))
323+ updateKindName = update (importedKinds imports) KiName
324+
293 -- Update names so unqualified references become qualified, and locally
325 -- Update names so unqualified references become qualified, and locally
294 -- qualified references are replaced with their canoncial qualified names
326 -- qualified references are replaced with their canoncial qualified names
295 -- (e.g. M.Map -> Data.Map.Map).
327 -- (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
16 , exportTypeClass
16 , exportTypeClass
17 , exportValue
17 , exportValue
18 , exportValueOp
18 , exportValueOp
19+ , exportKind
19 , getExports
20 , getExports
20 , checkImportConflicts
21 , checkImportConflicts
21 ) where
22 ) where
@@ -71,27 +72,27 @@ type ImportMap a = M.Map (Qualified a) [ImportRecord a]
71data Imports = Imports
72data Imports = Imports
72 {
73 {
73 -- |
74 -- |
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
75 --
76 --
76 importedTypes :: ImportMap (ProperName 'TypeName)
77 importedTypes :: ImportMap (ProperName 'TypeName)
77 -- |
78 -- |
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
79 --
80 --
80 , importedTypeOps :: ImportMap (OpName 'TypeOpName)
81 , importedTypeOps :: ImportMap (OpName 'TypeOpName)
81 -- |
82 -- |
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
83 --
84 --
84 , importedDataConstructors :: ImportMap (ProperName 'ConstructorName)
85 , importedDataConstructors :: ImportMap (ProperName 'ConstructorName)
85 -- |
86 -- |
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
87 --
88 --
88 , importedTypeClasses :: ImportMap (ProperName 'ClassName)
89 , importedTypeClasses :: ImportMap (ProperName 'ClassName)
89 -- |
90 -- |
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
91 --
92 --
92 , importedValues :: ImportMap Ident
93 , importedValues :: ImportMap Ident
93 -- |
94 -- |
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
95 --
96 --
96 , importedValueOps :: ImportMap (OpName 'ValueOpName)
97 , importedValueOps :: ImportMap (OpName 'ValueOpName)
97 -- |
98 -- |
@@ -104,10 +105,14 @@ data Imports = Imports
104 -- The "as" names of modules that have been imported qualified.
105 -- The "as" names of modules that have been imported qualified.
105 --
106 --
106 , importedQualModules :: S.Set ModuleName
107 , importedQualModules :: S.Set ModuleName
108+ -- |
109+ -- Local names for kinds within a module mapped to their qualified names
110+ --
111+ , importedKinds :: ImportMap (ProperName 'KindName)
107 } deriving (Show)
112 } deriving (Show)
108
113
109nullImports :: Imports
114nullImports :: 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
111
116
112-- |
117-- |
113-- An 'Imports' value with imports for the `Prim` module.
118-- An 'Imports' value with imports for the `Prim` module.
@@ -117,6 +122,7 @@ primImports =
117 nullImports
122 nullImports
118 { importedTypes = M.fromList $ mkEntries `concatMap` M.keys primTypes
123 { importedTypes = M.fromList $ mkEntries `concatMap` M.keys primTypes
119 , importedTypeClasses = M.fromList $ mkEntries `concatMap` M.keys primClasses
124 , importedTypeClasses = M.fromList $ mkEntries `concatMap` M.keys primClasses
125+ , importedKinds = M.fromList $ mkEntries `concatMap` S.toList primKinds
120 }
126 }
121 where
127 where
122 mkEntries :: Qualified a -> [(Qualified a, [ImportRecord a])]
128 mkEntries :: Qualified a -> [(Qualified a, [ImportRecord a])]
@@ -155,13 +161,17 @@ data Exports = Exports
155 -- from.
161 -- from.
156 --
162 --
157 , exportedValueOps :: M.Map (OpName 'ValueOpName) ModuleName
163 , 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
158 } deriving (Show)
168 } deriving (Show)
159
169
160-- |
170-- |
161-- An empty 'Exports' value.
171-- An empty 'Exports' value.
162--
172--
163nullExports :: Exports
173nullExports :: 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
165
175
166-- |
176-- |
167-- The imports and exports for a collection of modules. The 'SourceSpan' is used
177-- The imports and exports for a collection of modules. The 'SourceSpan' is used
@@ -196,10 +206,12 @@ primExports =
196 nullExports
206 nullExports
197 { exportedTypes = M.fromList $ mkTypeEntry `map` M.keys primTypes
207 { exportedTypes = M.fromList $ mkTypeEntry `map` M.keys primTypes
198 , exportedTypeClasses = M.fromList $ mkClassEntry `map` M.keys primClasses
208 , exportedTypeClasses = M.fromList $ mkClassEntry `map` M.keys primClasses
209+ , exportedKinds = M.fromList $ mkKindEntry `map` S.toList primKinds
199 }
210 }
200 where
211 where
201 mkTypeEntry (Qualified mn name) = (name, ([], fromJust mn))
212 mkTypeEntry (Qualified mn name) = (name, ([], fromJust mn))
202 mkClassEntry (Qualified mn name) = (name, fromJust mn)
213 mkClassEntry (Qualified mn name) = (name, fromJust mn)
214+ mkKindEntry (Qualified mn name) = (name, fromJust mn)
203
215
204-- | Environment which only contains the Prim module.
216-- | Environment which only contains the Prim module.
205primEnv :: Env
217primEnv :: Env
@@ -316,6 +328,19 @@ exportValueOp exps op mn = do
316 valueOps <- addExport ValOpName op mn (exportedValueOps exps)
328 valueOps <- addExport ValOpName op mn (exportedValueOps exps)
317 return $ exps { exportedValueOps = valueOps }
329 return $ exps { exportedValueOps = valueOps }
318
330
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+
319-- |
344-- |
320-- Adds an entry to a list of exports unless it is already present, in which
345-- Adds an entry to a list of exports unless it is already present, in which
321-- case an error is returned.
346-- case an error is returned.
src/Language/PureScript/Sugar/Names/Exports.hs+28−11
@@ -19,7 +19,7 @@ import Language.PureScript.AST
19import Language.PureScript.Crash
19import Language.PureScript.Crash
20import Language.PureScript.Errors
20import Language.PureScript.Errors
21import Language.PureScript.Names
21import Language.PureScript.Names
22−import Language.PureScript.Sugar.Names.Env
22+import Language.PureScript.Sugar.Names.Env
23import Language.PureScript.Sugar.Names.Common (warnDuplicateRefs)
23import Language.PureScript.Sugar.Names.Common (warnDuplicateRefs)
24
24
25-- |
25-- |
@@ -51,6 +51,8 @@ findExportable (Module _ _ mn ds _) =
51 exportTypeOp exps op mn
51 exportTypeOp exps op mn
52 updateExports exps (ExternDeclaration name _) =
52 updateExports exps (ExternDeclaration name _) =
53 exportValue exps name mn
53 exportValue exps name mn
54+ updateExports exps (ExternKindDeclaration pn) =
55+ exportKind exps pn mn
54 updateExports exps (PositionedDeclaration pos _ d) =
56 updateExports exps (PositionedDeclaration pos _ d) =
55 rethrowWithPosition pos $ updateExports exps d
57 rethrowWithPosition pos $ updateExports exps d
56 updateExports exps _ = return exps
58 updateExports exps _ = return exps
@@ -61,21 +63,21 @@ findExportable (Module _ _ mn ds _) =
61--
63--
62resolveExports
64resolveExports
63 :: forall m
65 :: forall m
64− . (MonadError MultipleErrors m, MonadWriter MultipleErrors m)
66+ . (MonadError MultipleErrors m, MonadWriter MultipleErrors m)
65− => Env
67+ => Env
66− -> SourceSpan
68+ -> SourceSpan
67 -> ModuleName
69 -> ModuleName
68 -> Imports
70 -> Imports
69 -> Exports
71 -> Exports
70 -> [DeclarationRef]
72 -> [DeclarationRef]
71 -> m Exports
73 -> m Exports
72−resolveExports env ss mn imps exps refs =
74+resolveExports env ss mn imps exps refs =
73− warnAndRethrow (addHint (ErrorInModule mn)) $ do
75+ warnAndRethrow (addHint (ErrorInModule mn)) $ do
74 filtered <- filterModule mn exps refs
76 filtered <- filterModule mn exps refs
75− exps' <- foldM elaborateModuleExports filtered refs
77+ exps' <- foldM elaborateModuleExports filtered refs
76− warnDuplicateRefs ss DuplicateExportRef refs
78+ warnDuplicateRefs ss DuplicateExportRef refs
77− return exps'
79+ return exps'
78−
80+
79 where
81 where
80
82
81 -- Takes the current module's imports, the accumulated list of exports, and a
83 -- Takes the current module's imports, the accumulated list of exports, and a
@@ -83,19 +85,21 @@ resolveExports env ss mn imps exps refs =
83 -- module, export anything from the imports that matches for that module.
85 -- module, export anything from the imports that matches for that module.
84 elaborateModuleExports :: Exports -> DeclarationRef -> m Exports
86 elaborateModuleExports :: Exports -> DeclarationRef -> m Exports
85 elaborateModuleExports result (PositionedDeclarationRef pos _ r) =
87 elaborateModuleExports result (PositionedDeclarationRef pos _ r) =
86− warnAndRethrowWithPosition pos $ elaborateModuleExports result r
88+ warnAndRethrowWithPosition pos $ elaborateModuleExports result r
87 elaborateModuleExports result (ModuleRef name) | name == mn = do
89 elaborateModuleExports result (ModuleRef name) | name == mn = do
88 let types' = exportedTypes result `M.union` exportedTypes exps
90 let types' = exportedTypes result `M.union` exportedTypes exps
89 let typeOps' = exportedTypeOps result `M.union` exportedTypeOps exps
91 let typeOps' = exportedTypeOps result `M.union` exportedTypeOps exps
90 let classes' = exportedTypeClasses result `M.union` exportedTypeClasses exps
92 let classes' = exportedTypeClasses result `M.union` exportedTypeClasses exps
91 let values' = exportedValues result `M.union` exportedValues exps
93 let values' = exportedValues result `M.union` exportedValues exps
92 let valueOps' = exportedValueOps result `M.union` exportedValueOps exps
94 let valueOps' = exportedValueOps result `M.union` exportedValueOps exps
95+ let kinds' = exportedKinds result `M.union` exportedKinds exps
93 return result
96 return result
94 { exportedTypes = types'
97 { exportedTypes = types'
95 , exportedTypeOps = typeOps'
98 , exportedTypeOps = typeOps'
96 , exportedTypeClasses = classes'
99 , exportedTypeClasses = classes'
97 , exportedValues = values'
100 , exportedValues = values'
98 , exportedValueOps = valueOps'
101 , exportedValueOps = valueOps'
102+ , exportedKinds = kinds'
99 }
103 }
100 elaborateModuleExports result (ModuleRef name) = do
104 elaborateModuleExports result (ModuleRef name) = do
101 let isPseudo = isPseudoModule name
105 let isPseudo = isPseudoModule name
@@ -107,11 +111,13 @@ resolveExports env ss mn imps exps refs =
107 reClasses <- extract isPseudo name TyClassName (importedTypeClasses imps)
111 reClasses <- extract isPseudo name TyClassName (importedTypeClasses imps)
108 reValues <- extract isPseudo name IdentName (importedValues imps)
112 reValues <- extract isPseudo name IdentName (importedValues imps)
109 reValueOps <- extract isPseudo name ValOpName (importedValueOps imps)
113 reValueOps <- extract isPseudo name ValOpName (importedValueOps imps)
114+ reKinds <- extract isPseudo name KiName (importedKinds imps)
110 foldM (\exps' ((tctor, dctors), mn') -> exportType ReExport exps' tctor dctors mn') result (resolveTypeExports reTypes reDctors)
115 foldM (\exps' ((tctor, dctors), mn') -> exportType ReExport exps' tctor dctors mn') result (resolveTypeExports reTypes reDctors)
111 >>= flip (foldM (uncurry . exportTypeOp)) (map resolveTypeOp reTypeOps)
116 >>= flip (foldM (uncurry . exportTypeOp)) (map resolveTypeOp reTypeOps)
112 >>= flip (foldM (uncurry . exportTypeClass ReExport)) (map resolveClass reClasses)
117 >>= flip (foldM (uncurry . exportTypeClass ReExport)) (map resolveClass reClasses)
113 >>= flip (foldM (uncurry . exportValue)) (map resolveValue reValues)
118 >>= flip (foldM (uncurry . exportValue)) (map resolveValue reValues)
114 >>= flip (foldM (uncurry . exportValueOp)) (map resolveValueOp reValueOps)
119 >>= flip (foldM (uncurry . exportValueOp)) (map resolveValueOp reValueOps)
120+ >>= flip (foldM (uncurry . exportKind)) (map resolveKind reKinds)
115 elaborateModuleExports result _ = return result
121 elaborateModuleExports result _ = return result
116
122
117 -- Extracts a list of values for a module based on a lookup table. If the
123 -- 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 =
146 || any (isQualifiedWith mn') (f (importedTypeClasses imps))
152 || any (isQualifiedWith mn') (f (importedTypeClasses imps))
147 || any (isQualifiedWith mn') (f (importedValues imps))
153 || any (isQualifiedWith mn') (f (importedValues imps))
148 || any (isQualifiedWith mn') (f (importedValueOps imps))
154 || any (isQualifiedWith mn') (f (importedValueOps imps))
155+ || any (isQualifiedWith mn') (f (importedKinds imps))
149
156
150 -- Check whether a module name refers to a module that has been imported
157 -- Check whether a module name refers to a module that has been imported
151 -- without qualification into an import scope.
158 -- without qualification into an import scope.
@@ -203,6 +210,14 @@ resolveExports env ss mn imps exps refs =
203 . fromMaybe (internalError "Missing value in resolveValueOp")
210 . fromMaybe (internalError "Missing value in resolveValueOp")
204 $ resolve exportedValueOps op
211 $ resolve exportedValueOps op
205
212
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+
206 resolve
221 resolve
207 :: Ord a
222 :: Ord a
208 => (Exports -> M.Map a ModuleName)
223 => (Exports -> M.Map a ModuleName)
@@ -237,12 +252,14 @@ filterModule mn exps refs = do
237 classes <- foldM (filterExport TyClassName getTypeClassRef exportedTypeClasses) M.empty refs
252 classes <- foldM (filterExport TyClassName getTypeClassRef exportedTypeClasses) M.empty refs
238 values <- foldM (filterExport IdentName getValueRef exportedValues) M.empty refs
253 values <- foldM (filterExport IdentName getValueRef exportedValues) M.empty refs
239 valueOps <- foldM (filterExport ValOpName getValueOpRef exportedValueOps) M.empty refs
254 valueOps <- foldM (filterExport ValOpName getValueOpRef exportedValueOps) M.empty refs
255+ kinds <- foldM (filterExport KiName getKindRef exportedKinds) M.empty refs
240 return Exports
256 return Exports
241 { exportedTypes = types
257 { exportedTypes = types
242 , exportedTypeOps = typeOps
258 , exportedTypeOps = typeOps
243 , exportedTypeClasses = classes
259 , exportedTypeClasses = classes
244 , exportedValues = values
260 , exportedValues = values
245 , exportedValueOps = valueOps
261 , exportedValueOps = valueOps
262+ , exportedKinds = kinds
246 }
263 }
247
264
248 where
265 where
src/Language/PureScript/Sugar/Names/Imports.hs+6
@@ -130,6 +130,8 @@ resolveImport importModule exps imps impQual = resolveByType
130 checkImportExists TyClassName (exportedTypeClasses exps) name
130 checkImportExists TyClassName (exportedTypeClasses exps) name
131 check (ModuleRef name) | isHiding =
131 check (ModuleRef name) | isHiding =
132 throwError . errorMessage $ ImportHidingModule name
132 throwError . errorMessage $ ImportHidingModule name
133+ check (KindRef name) = do
134+ checkImportExists KiName (exportedKinds exps) name
133 check r = internalError $ "Invalid argument to checkRefs: " ++ show r
135 check r = internalError $ "Invalid argument to checkRefs: " ++ show r
134
136
135 -- Check that an explicitly imported item exists in the module it is being imported from
137 -- 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
181 >>= flip (foldM (\m (name, _) -> importer m (ValueRef name))) (M.toList (exportedValues exps))
183 >>= flip (foldM (\m (name, _) -> importer m (ValueRef name))) (M.toList (exportedValues exps))
182 >>= flip (foldM (\m (name, _) -> importer m (ValueOpRef name))) (M.toList (exportedValueOps exps))
184 >>= flip (foldM (\m (name, _) -> importer m (ValueOpRef name))) (M.toList (exportedValueOps exps))
183 >>= flip (foldM (\m (name, _) -> importer m (TypeClassRef name))) (M.toList (exportedTypeClasses exps))
185 >>= 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))
184
187
185 importRef :: ImportProvenance -> Imports -> DeclarationRef -> m Imports
188 importRef :: ImportProvenance -> Imports -> DeclarationRef -> m Imports
186 importRef prov imp (PositionedDeclarationRef pos _ r) =
189 importRef prov imp (PositionedDeclarationRef pos _ r) =
@@ -205,6 +208,9 @@ resolveImport importModule exps imps impQual = resolveByType
205 importRef prov imp (TypeClassRef name) = do
208 importRef prov imp (TypeClassRef name) = do
206 let typeClasses' = updateImports (importedTypeClasses imp) (exportedTypeClasses exps) id name prov
209 let typeClasses' = updateImports (importedTypeClasses imp) (exportedTypeClasses exps) id name prov
207 return $ imp { importedTypeClasses = typeClasses' }
210 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' }
208 importRef _ _ TypeInstanceRef{} = internalError "TypeInstanceRef in importRef"
214 importRef _ _ TypeInstanceRef{} = internalError "TypeInstanceRef in importRef"
209 importRef _ _ ModuleRef{} = internalError "ModuleRef in importRef"
215 importRef _ _ ModuleRef{} = internalError "ModuleRef in importRef"
210 importRef _ _ ReExportRef{} = internalError "ReExportRef in importRef"
216 importRef _ _ ReExportRef{} = internalError "ReExportRef in importRef"
src/Language/PureScript/Sugar/TypeClasses/Deriving.hs+161−55
@@ -3,77 +3,102 @@
3--
3--
4module Language.PureScript.Sugar.TypeClasses.Deriving (deriveInstances) where
4module Language.PureScript.Sugar.TypeClasses.Deriving (deriveInstances) where
5
5
6−import Prelude.Compat
6+import Prelude.Compat
7−
7+
8−import Control.Arrow (second)
8+import Control.Arrow (second)
9−import Control.Monad (replicateM)
9+import Control.Monad (replicateM, zipWithM)
10−import Control.Monad.Error.Class (MonadError(..))
10+import Control.Monad.Error.Class (MonadError(..))
11−import Control.Monad.Supply.Class (MonadSupply)
11+import Control.Monad.Supply.Class (MonadSupply)
12−
13−import Data.List (foldl', find, sortBy, unzip5)
12+import Data.List (foldl', find, sortBy, unzip5)
13+import qualified Data.Map as M
14−import Data.Maybe (fromMaybe)
14+import Data.Maybe (fromMaybe, mapMaybe)
15−import Data.Ord (comparing)
15+import Data.Ord (comparing)
16−import Data.Text (Text)
16+import Data.Text (Text)
17−
18−import Language.PureScript.AST
17+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)
25import qualified Language.PureScript.Constants as C
18import 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)
26
28
27-- | Elaborates deriving instance declarations by code generation.
29-- | Elaborates deriving instance declarations by code generation.
28deriveInstances
30deriveInstances
31+ :: forall m
29− :: (MonadError MultipleErrors m, MonadSupply m)
32+ . (MonadError MultipleErrors m, MonadSupply m)
33+ => [ExternsFile]
30− => Module
34+ -> Module
31 -> m Module
35 -> m Module
36+deriveInstances externs (Module ss coms mn ds exts) =
32−deriveInstances (Module ss coms mn ds exts) = Module ss coms mn <$> mapM (deriveInstance mn ds) ds <*> pure 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
33
53
34-- | Takes a declaration, and if the declaration is a deriving TypeInstanceDeclaration,
54-- | Takes a declaration, and if the declaration is a deriving TypeInstanceDeclaration,
35-- elaborates that into an instance declaration via code generation.
55-- elaborates that into an instance declaration via code generation.
36deriveInstance
56deriveInstance
37 :: (MonadError MultipleErrors m, MonadSupply m)
57 :: (MonadError MultipleErrors m, MonadSupply m)
38 => ModuleName
58 => ModuleName
59+ -> SynonymMap
39 -> [Declaration]
60 -> [Declaration]
40 -> Declaration
61 -> Declaration
41 -> m Declaration
62 -> 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)
43 | className == Qualified (Just dataGeneric) (ProperName C.generic)
64 | className == Qualified (Just dataGeneric) (ProperName C.generic)
44 , Just (Qualified mn' tyCon, args) <- unwrapTypeConstructor ty
65 , Just (Qualified mn' tyCon, args) <- unwrapTypeConstructor ty
45 , mn == fromMaybe mn mn'
66 , 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
47 | className == Qualified (Just dataEq) (ProperName "Eq")
68 | className == Qualified (Just dataEq) (ProperName "Eq")
48 , Just (Qualified mn' tyCon, _) <- unwrapTypeConstructor ty
69 , Just (Qualified mn' tyCon, _) <- unwrapTypeConstructor ty
49 , mn == fromMaybe mn mn'
70 , 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
51 | className == Qualified (Just dataOrd) (ProperName "Ord")
72 | className == Qualified (Just dataOrd) (ProperName "Ord")
52 , Just (Qualified mn' tyCon, _) <- unwrapTypeConstructor ty
73 , Just (Qualified mn' tyCon, _) <- unwrapTypeConstructor ty
53 , mn == fromMaybe mn mn'
74 , mn == fromMaybe mn mn'
54− = TypeInstanceDeclaration nm deps className tys . ExplicitInstance <$> deriveOrd mn ds tyCon
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
55−deriveInstance mn ds (TypeInstanceDeclaration nm deps className [wrappedTy, unwrappedTy] DerivedInstance)
80+deriveInstance mn syns ds (TypeInstanceDeclaration nm deps className [wrappedTy, unwrappedTy] DerivedInstance)
56 | className == Qualified (Just dataNewtype) (ProperName "Newtype")
81 | className == Qualified (Just dataNewtype) (ProperName "Newtype")
57 , Just (Qualified mn' tyCon, args) <- unwrapTypeConstructor wrappedTy
82 , Just (Qualified mn' tyCon, args) <- unwrapTypeConstructor wrappedTy
58 , mn == fromMaybe mn mn'
83 , 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
60 return $ TypeInstanceDeclaration nm deps className [wrappedTy, actualUnwrappedTy] (ExplicitInstance inst)
85 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)
62 | className == Qualified (Just dataGenericRep) (ProperName C.generic)
87 | className == Qualified (Just dataGenericRep) (ProperName C.generic)
63 , Just (Qualified mn' tyCon, args) <- unwrapTypeConstructor actualTy
88 , Just (Qualified mn' tyCon, args) <- unwrapTypeConstructor actualTy
64 , mn == fromMaybe mn mn'
89 , 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
66 return $ TypeInstanceDeclaration nm deps className [actualTy, inferredRepTy] (ExplicitInstance inst)
91 return $ TypeInstanceDeclaration nm deps className [actualTy, inferredRepTy] (ExplicitInstance inst)
67−deriveInstance _ _ (TypeInstanceDeclaration _ _ className tys DerivedInstance)
92+deriveInstance _ _ _ (TypeInstanceDeclaration _ _ className tys DerivedInstance)
68 = throwError . errorMessage $ CannotDerive className tys
93 = 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)
70 | Just (Qualified mn' tyCon, args) <- unwrapTypeConstructor (last tys)
95 | Just (Qualified mn' tyCon, args) <- unwrapTypeConstructor (last tys)
71 , mn == fromMaybe mn mn'
96 , mn == fromMaybe mn mn'
72− = TypeInstanceDeclaration nm deps className tys . NewtypeInstanceWithDictionary <$> deriveNewtypeInstance className ds tys tyCon args
97+ = TypeInstanceDeclaration nm deps className tys . NewtypeInstanceWithDictionary <$> deriveNewtypeInstance syns className ds tys tyCon args
73−deriveInstance _ _ (TypeInstanceDeclaration _ _ className tys NewtypeInstance)
98+deriveInstance _ _ _ (TypeInstanceDeclaration _ _ className tys NewtypeInstance)
74 = throwError . errorMessage $ InvalidNewtypeInstance className tys
99 = throwError . errorMessage $ InvalidNewtypeInstance className tys
75−deriveInstance mn ds (PositionedDeclaration pos com d) = PositionedDeclaration pos com <$> deriveInstance mn ds d
100+deriveInstance mn syns ds (PositionedDeclaration pos com d) = PositionedDeclaration pos com <$> deriveInstance mn syns ds d
76−deriveInstance _ _ e = return e
101+deriveInstance _ _ _ e = return e
77
102
78unwrapTypeConstructor :: Type -> Maybe (Qualified (ProperName 'TypeName), [Type])
103unwrapTypeConstructor :: Type -> Maybe (Qualified (ProperName 'TypeName), [Type])
79unwrapTypeConstructor = fmap (second reverse) . go
104unwrapTypeConstructor = fmap (second reverse) . go
@@ -87,13 +112,14 @@ unwrapTypeConstructor = fmap (second reverse) . go
87deriveNewtypeInstance
112deriveNewtypeInstance
88 :: forall m
113 :: forall m
89 . MonadError MultipleErrors m
114 . MonadError MultipleErrors m
115+ => SynonymMap
90− => Qualified (ProperName 'ClassName)
116+ -> Qualified (ProperName 'ClassName)
91 -> [Declaration]
117 -> [Declaration]
92 -> [Type]
118 -> [Type]
93 -> ProperName 'TypeName
119 -> ProperName 'TypeName
94 -> [Type]
120 -> [Type]
95 -> m Expr
121 -> m Expr
96−deriveNewtypeInstance className ds tys tyConNm dargs = do
122+deriveNewtypeInstance syns className ds tys tyConNm dargs = do
97 tyCon <- findTypeDecl tyConNm ds
123 tyCon <- findTypeDecl tyConNm ds
98 go tyCon
124 go tyCon
99 where
125 where
@@ -109,7 +135,8 @@ deriveNewtypeInstance className ds tys tyConNm dargs = do
109 -- type argument
135 -- type argument
110 | Just wrapped' <- stripRight (takeReverse (length tyArgNames - length dargs) tyArgNames) wrapped =
136 | Just wrapped' <- stripRight (takeReverse (length tyArgNames - length dargs) tyArgNames) wrapped =
111 do let subst = zipWith (\(name, _) t -> (name, t)) tyArgNames dargs
137 do let subst = zipWith (\(name, _) t -> (name, t)) tyArgNames dargs
138+ wrapped'' <- replaceAllTypeSynonymsM syns wrapped'
112− return (DeferredDictionary className (init tys ++ [replaceAllTypeVars subst wrapped']))
139+ return (DeferredDictionary className (init tys ++ [replaceAllTypeVars subst wrapped'']))
113 go (PositionedDeclaration _ _ d) = go d
140 go (PositionedDeclaration _ _ d) = go d
114 go _ = throwError . errorMessage $ InvalidNewtypeInstance className tys
141 go _ = throwError . errorMessage $ InvalidNewtypeInstance className tys
115
142
@@ -143,14 +170,18 @@ dataOrd = ModuleName [ ProperName "Data", ProperName "Ord" ]
143dataNewtype :: ModuleName
170dataNewtype :: ModuleName
144dataNewtype = ModuleName [ ProperName "Data", ProperName "Newtype" ]
171dataNewtype = ModuleName [ ProperName "Data", ProperName "Newtype" ]
145
172
173+dataFunctor :: ModuleName
174+dataFunctor = ModuleName [ ProperName "Data", ProperName "Functor" ]
175+
146deriveGeneric
176deriveGeneric
147 :: forall m. (MonadError MultipleErrors m, MonadSupply m)
177 :: forall m. (MonadError MultipleErrors m, MonadSupply m)
148 => ModuleName
178 => ModuleName
179+ -> SynonymMap
149 -> [Declaration]
180 -> [Declaration]
150 -> ProperName 'TypeName
181 -> ProperName 'TypeName
151 -> [Type]
182 -> [Type]
152 -> m [Declaration]
183 -> m [Declaration]
153−deriveGeneric mn ds tyConNm dargs = do
184+deriveGeneric mn syns ds tyConNm dargs = do
154 tyCon <- findTypeDecl tyConNm ds
185 tyCon <- findTypeDecl tyConNm ds
155 toSpine <- mkSpineFunction tyCon
186 toSpine <- mkSpineFunction tyCon
156 fromSpine <- mkFromSpineFunction tyCon
187 fromSpine <- mkFromSpineFunction tyCon
@@ -174,12 +205,12 @@ deriveGeneric mn ds tyConNm dargs = do
174 mkCtorClause :: (ProperName 'ConstructorName, [Type]) -> m CaseAlternative
205 mkCtorClause :: (ProperName 'ConstructorName, [Type]) -> m CaseAlternative
175 mkCtorClause (ctorName, tys) = do
206 mkCtorClause (ctorName, tys) = do
176 idents <- replicateM (length tys) freshIdent'
207 idents <- replicateM (length tys) freshIdent'
177− return $ CaseAlternative [ConstructorBinder (Qualified (Just mn) ctorName) (map VarBinder idents)] (Right (caseResult idents))
208+ tys' <- mapM (replaceAllTypeSynonymsM syns) tys
178− where
209+ let caseResult =
179− caseResult idents =
180− App (prodConstructor (Literal . StringLiteral . showQualified runProperName $ Qualified (Just mn) ctorName))
210+ App (prodConstructor (Literal . StringLiteral . showQualified runProperName $ Qualified (Just mn) ctorName))
181− . Literal . ArrayLiteral
211+ . Literal . ArrayLiteral
182− $ zipWith toSpineFun (map (Var . Qualified Nothing) idents) tys
212+ $ zipWith toSpineFun (map (Var . Qualified Nothing) idents) tys'
213+ return $ CaseAlternative [ConstructorBinder (Qualified (Just mn) ctorName) (map VarBinder idents)] (Right caseResult)
183
214
184 toSpineFun :: Expr -> Type -> Expr
215 toSpineFun :: Expr -> Type -> Expr
185 toSpineFun i r | Just rec <- objectType r =
216 toSpineFun i r | Just rec <- objectType r =
@@ -314,12 +345,13 @@ deriveGenericRep
314 :: forall m
345 :: forall m
315 . (MonadError MultipleErrors m, MonadSupply m)
346 . (MonadError MultipleErrors m, MonadSupply m)
316 => ModuleName
347 => ModuleName
348+ -> SynonymMap
317 -> [Declaration]
349 -> [Declaration]
318 -> ProperName 'TypeName
350 -> ProperName 'TypeName
319 -> [Type]
351 -> [Type]
320 -> Type
352 -> Type
321 -> m ([Declaration], Type)
353 -> m ([Declaration], Type)
322−deriveGenericRep mn ds tyConNm tyConArgs repTy = do
354+deriveGenericRep mn syns ds tyConNm tyConArgs repTy = do
323 checkIsWildcard tyConNm repTy
355 checkIsWildcard tyConNm repTy
324 go =<< findTypeDecl tyConNm ds
356 go =<< findTypeDecl tyConNm ds
325 where
357 where
@@ -370,7 +402,8 @@ deriveGenericRep mn ds tyConNm tyConArgs repTy = do
370 :: (ProperName 'ConstructorName, [Type])
402 :: (ProperName 'ConstructorName, [Type])
371 -> m (Type, CaseAlternative, CaseAlternative)
403 -> m (Type, CaseAlternative, CaseAlternative)
372 makeInst (ctorName, args) = do
404 makeInst (ctorName, args) = do
405+ args' <- mapM (replaceAllTypeSynonymsM syns) args
373− (ctorTy, matchProduct, ctorArgs, matchCtor, mkProduct) <- makeProduct args
406+ (ctorTy, matchProduct, ctorArgs, matchCtor, mkProduct) <- makeProduct args'
374 return ( TypeApp (TypeApp (TypeConstructor constructor)
407 return ( TypeApp (TypeApp (TypeConstructor constructor)
375 (TypeLevelString (runProperName ctorName)))
408 (TypeLevelString (runProperName ctorName)))
376 ctorTy
409 ctorTy
@@ -494,10 +527,11 @@ checkIsWildcard tyConNm _ =
494deriveEq ::
527deriveEq ::
495 forall m. (MonadError MultipleErrors m, MonadSupply m)
528 forall m. (MonadError MultipleErrors m, MonadSupply m)
496 => ModuleName
529 => ModuleName
530+ -> SynonymMap
497 -> [Declaration]
531 -> [Declaration]
498 -> ProperName 'TypeName
532 -> ProperName 'TypeName
499 -> m [Declaration]
533 -> m [Declaration]
500−deriveEq mn ds tyConNm = do
534+deriveEq mn syns ds tyConNm = do
501 tyCon <- findTypeDecl tyConNm ds
535 tyCon <- findTypeDecl tyConNm ds
502 eqFun <- mkEqFunction tyCon
536 eqFun <- mkEqFunction tyCon
503 return [ ValueDeclaration (Ident C.eq) Public [] (Right eqFun) ]
537 return [ ValueDeclaration (Ident C.eq) Public [] (Right eqFun) ]
@@ -527,7 +561,8 @@ deriveEq mn ds tyConNm = do
527 mkCtorClause (ctorName, tys) = do
561 mkCtorClause (ctorName, tys) = do
528 identsL <- replicateM (length tys) (freshIdent "l")
562 identsL <- replicateM (length tys) (freshIdent "l")
529 identsR <- replicateM (length tys) (freshIdent "r")
563 identsR <- replicateM (length tys) (freshIdent "r")
564+ tys' <- mapM (replaceAllTypeSynonymsM syns) tys
530− let tests = zipWith3 toEqTest (map (Var . Qualified Nothing) identsL) (map (Var . Qualified Nothing) identsR) tys
565+ let tests = zipWith3 toEqTest (map (Var . Qualified Nothing) identsL) (map (Var . Qualified Nothing) identsR) tys'
531 return $ CaseAlternative [caseBinder identsL, caseBinder identsR] (Right (conjAll tests))
566 return $ CaseAlternative [caseBinder identsL, caseBinder identsR] (Right (conjAll tests))
532 where
567 where
533 caseBinder idents = ConstructorBinder (Qualified (Just mn) ctorName) (map VarBinder idents)
568 caseBinder idents = ConstructorBinder (Qualified (Just mn) ctorName) (map VarBinder idents)
@@ -546,10 +581,11 @@ deriveEq mn ds tyConNm = do
546deriveOrd ::
581deriveOrd ::
547 forall m. (MonadError MultipleErrors m, MonadSupply m)
582 forall m. (MonadError MultipleErrors m, MonadSupply m)
548 => ModuleName
583 => ModuleName
584+ -> SynonymMap
549 -> [Declaration]
585 -> [Declaration]
550 -> ProperName 'TypeName
586 -> ProperName 'TypeName
551 -> m [Declaration]
587 -> m [Declaration]
552−deriveOrd mn ds tyConNm = do
588+deriveOrd mn syns ds tyConNm = do
553 tyCon <- findTypeDecl tyConNm ds
589 tyCon <- findTypeDecl tyConNm ds
554 compareFun <- mkCompareFunction tyCon
590 compareFun <- mkCompareFunction tyCon
555 return [ ValueDeclaration (Ident C.compare) Public [] (Right compareFun) ]
591 return [ ValueDeclaration (Ident C.compare) Public [] (Right compareFun) ]
@@ -590,7 +626,8 @@ deriveOrd mn ds tyConNm = do
590 mkCtorClauses ((ctorName, tys), isLast) = do
626 mkCtorClauses ((ctorName, tys), isLast) = do
591 identsL <- replicateM (length tys) (freshIdent "l")
627 identsL <- replicateM (length tys) (freshIdent "l")
592 identsR <- replicateM (length tys) (freshIdent "r")
628 identsR <- replicateM (length tys) (freshIdent "r")
629+ tys' <- mapM (replaceAllTypeSynonymsM syns) tys
593− let tests = zipWith3 toOrdering (map (Var . Qualified Nothing) identsL) (map (Var . Qualified Nothing) identsR) tys
630+ let tests = zipWith3 toOrdering (map (Var . Qualified Nothing) identsL) (map (Var . Qualified Nothing) identsR) tys'
594 extras | not isLast = [ CaseAlternative [ ConstructorBinder (Qualified (Just mn) ctorName) (replicate (length tys) NullBinder)
631 extras | not isLast = [ CaseAlternative [ ConstructorBinder (Qualified (Just mn) ctorName) (replicate (length tys) NullBinder)
595 , NullBinder
632 , NullBinder
596 ]
633 ]
@@ -632,12 +669,13 @@ deriveNewtype
632 :: forall m
669 :: forall m
633 . (MonadError MultipleErrors m, MonadSupply m)
670 . (MonadError MultipleErrors m, MonadSupply m)
634 => ModuleName
671 => ModuleName
672+ -> SynonymMap
635 -> [Declaration]
673 -> [Declaration]
636 -> ProperName 'TypeName
674 -> ProperName 'TypeName
637 -> [Type]
675 -> [Type]
638 -> Type
676 -> Type
639 -> m ([Declaration], Type)
677 -> m ([Declaration], Type)
640−deriveNewtype mn ds tyConNm tyConArgs unwrappedTy = do
678+deriveNewtype mn syns ds tyConNm tyConArgs unwrappedTy = do
641 checkIsWildcard tyConNm unwrappedTy
679 checkIsWildcard tyConNm unwrappedTy
642 go =<< findTypeDecl tyConNm ds
680 go =<< findTypeDecl tyConNm ds
643 where
681 where
@@ -649,7 +687,8 @@ deriveNewtype mn ds tyConNm tyConArgs unwrappedTy = do
649 wrappedIdent <- freshIdent "n"
687 wrappedIdent <- freshIdent "n"
650 unwrappedIdent <- freshIdent "a"
688 unwrappedIdent <- freshIdent "a"
651 let (ctorName, [ty]) = head dctors
689 let (ctorName, [ty]) = head dctors
690+ ty' <- replaceAllTypeSynonymsM syns ty
652− inst =
691+ let inst =
653 [ ValueDeclaration (Ident "wrap") Public [] $ Right $
692 [ ValueDeclaration (Ident "wrap") Public [] $ Right $
654 Constructor (Qualified (Just mn) ctorName)
693 Constructor (Qualified (Just mn) ctorName)
655 , ValueDeclaration (Ident "unwrap") Public [] $ Right $
694 , ValueDeclaration (Ident "unwrap") Public [] $ Right $
@@ -660,7 +699,7 @@ deriveNewtype mn ds tyConNm tyConArgs unwrappedTy = do
660 ]
699 ]
661 ]
700 ]
662 subst = zipWith ((,) . fst) args tyConArgs
701 subst = zipWith ((,) . fst) args tyConArgs
663− return (inst, replaceAllTypeVars subst ty)
702+ return (inst, replaceAllTypeVars subst ty')
664 go (PositionedDeclaration _ _ d) = go d
703 go (PositionedDeclaration _ _ d) = go d
665 go _ = internalError "deriveNewtype go: expected DataDeclaration"
704 go _ = internalError "deriveNewtype go: expected DataDeclaration"
666
705
@@ -702,3 +741,70 @@ decomposeRec :: Type -> [(Text, Type)]
702decomposeRec = sortBy (comparing fst) . go
741decomposeRec = sortBy (comparing fst) . go
703 where go (RCons str typ typs) = (str, typ) : decomposeRec typs
742 where go (RCons str typ typs) = (str, typ) : decomposeRec typs
704 go _ = []
743 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)
18import Control.Monad.Writer.Class (MonadWriter(..))
18import Control.Monad.Writer.Class (MonadWriter(..))
19import Control.Lens ((^..), _1, _2)
19import Control.Lens ((^..), _1, _2)
20
20
21−import Data.Foldable (for_, traverse_)
21+import Data.Foldable (for_, traverse_, toList)
22import Data.List (nub, nubBy, (\\), sort, group)
22import Data.List (nub, nubBy, (\\), sort, group)
23import Data.Maybe
23import Data.Maybe
24import qualified Data.Map as M
24import qualified Data.Map as M
@@ -274,11 +274,15 @@ typeCheckAll moduleName _ = traverse go
274 env <- getEnv
274 env <- getEnv
275 putEnv $ env { types = M.insert (Qualified (Just moduleName) name) (kind, ExternData) (types env) }
275 putEnv $ env { types = M.insert (Qualified (Just moduleName) name) (kind, ExternData) (types env) }
276 return d
276 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
277 go (d@(ExternDeclaration name ty)) = do
281 go (d@(ExternDeclaration name ty)) = do
278 warnAndRethrow (addHint (ErrorInForeignImport name)) $ do
282 warnAndRethrow (addHint (ErrorInForeignImport name)) $ do
279 env <- getEnv
283 env <- getEnv
280 kind <- kindOf ty
284 kind <- kindOf ty
281− guardWith (errorMessage (ExpectedType ty kind)) $ kind == Star
285+ guardWith (errorMessage (ExpectedType ty kind)) $ kind == kindType
282 case M.lookup (Qualified (Just moduleName) name) (names env) of
286 case M.lookup (Qualified (Just moduleName) name) (names env) of
283 Just _ -> throwError . errorMessage $ RedefinedIdent name
287 Just _ -> throwError . errorMessage $ RedefinedIdent name
284 Nothing -> putEnv (env { names = M.insert (Qualified (Just moduleName) name) (ty, External, Defined) (names env) })
288 Nothing -> putEnv (env { names = M.insert (Qualified (Just moduleName) name) (ty, External, Defined) (names env) })
@@ -294,7 +298,7 @@ typeCheckAll moduleName _ = traverse go
294 Nothing -> internalError "typeCheckAll: Encountered unknown type class in instance declaration"
298 Nothing -> internalError "typeCheckAll: Encountered unknown type class in instance declaration"
295 Just typeClass -> do
299 Just typeClass -> do
296 sequence_ (zipWith (checkTypeClassInstance typeClass) [0..] tys)
300 sequence_ (zipWith (checkTypeClassInstance typeClass) [0..] tys)
297− checkOrphanInstance dictName className tys
301+ checkOrphanInstance dictName className typeClass tys
298 _ <- traverseTypeInstanceBody checkInstanceMembers body
302 _ <- traverseTypeInstanceBody checkInstanceMembers body
299 let dict = TypeClassDictionaryInScope (Qualified (Just moduleName) dictName) [] className tys (Just deps)
303 let dict = TypeClassDictionaryInScope (Qualified (Just moduleName) dictName) [] className tys (Just deps)
300 addTypeClassDictionaries (Just moduleName) . M.singleton className $ M.singleton (tcdValue dict) dict
304 addTypeClassDictionaries (Just moduleName) . M.singleton className $ M.singleton (tcdValue dict) dict
@@ -320,19 +324,35 @@ typeCheckAll moduleName _ = traverse go
320 | otherwise = firstDuplicate xs
324 | otherwise = firstDuplicate xs
321 firstDuplicate _ = Nothing
325 firstDuplicate _ = Nothing
322
326
323− checkOrphanInstance :: Ident -> Qualified (ProperName 'ClassName) -> [Type] -> m ()
327+ checkOrphanInstance :: Ident -> Qualified (ProperName 'ClassName) -> TypeClassData -> [Type] -> m ()
324− checkOrphanInstance dictName className@(Qualified (Just mn') _) tys'
328+ checkOrphanInstance dictName className@(Qualified (Just mn') _) typeClass tys'
325− | moduleName == mn' || any checkType tys' = return ()
329+ | moduleName == mn' || moduleName `S.member` nonOrphanModules = return ()
326 | otherwise = throwError . errorMessage $ OrphanInstance dictName className tys'
330 | otherwise = throwError . errorMessage $ OrphanInstance dictName className tys'
327 where
331 where
328− checkType :: Type -> Bool
332+ typeModule :: Type -> Maybe ModuleName
329− checkType (TypeVar _) = False
333+ typeModule (TypeVar _) = Nothing
330− checkType (TypeLevelString _) = False
334+ typeModule (TypeLevelString _) = Nothing
331− checkType (TypeConstructor (Qualified (Just mn'') _)) = moduleName == mn''
335+ typeModule (TypeConstructor (Qualified (Just mn'') _)) = Just mn''
332− checkType (TypeConstructor (Qualified Nothing _)) = internalError "Unqualified type name in checkOrphanInstance"
336+ typeModule (TypeConstructor (Qualified Nothing _)) = internalError "Unqualified type name in checkOrphanInstance"
333− checkType (TypeApp t1 _) = checkType t1
337+ typeModule (TypeApp t1 _) = typeModule t1
334− checkType _ = internalError "Invalid type in instance in checkOrphanInstance"
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+
335− checkOrphanInstance _ _ _ = internalError "Unqualified class name in checkOrphanInstance"
355+ checkOrphanInstance _ _ _ _ = internalError "Unqualified class name in checkOrphanInstance"
336
356
337 -- |
357 -- |
338 -- This function adds the argument kinds for a type constructor so that they may appear in the externs file,
358 -- 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
45 -- ^ An existing named instance
45 -- ^ An existing named instance
46 | IsSymbolInstance Text
46 | IsSymbolInstance Text
47 -- ^ Computed instance of the IsSymbol type class for a given Symbol literal
47 -- ^ 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
48 deriving (Eq)
52 deriving (Eq)
49
53
50-- | Extract the identifier of a named instance
54-- | Extract the identifier of a named instance
@@ -138,7 +142,18 @@ entails SolverOptions{..} constraint context hints =
138 solve constraint
142 solve constraint
139 where
143 where
140 forClassName :: InstanceContext -> Qualified (ProperName 'ClassName) -> [Type] -> [TypeClassDict]
144 forClassName :: InstanceContext -> Qualified (ProperName 'ClassName) -> [Type] -> [TypeClassDict]
145+ forClassName _ C.IsSymbol [TypeLevelString sym] =
141− forClassName _ C.IsSymbol [TypeLevelString sym] = [TypeClassDictionaryInScope (IsSymbolInstance sym) [] C.IsSymbol [TypeLevelString sym] Nothing]
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]
142 forClassName ctx cn@(Qualified (Just mn) _) tys = concatMap (findDicts ctx cn) (nub (Nothing : Just mn : map Just (mapMaybe ctorModules tys)))
157 forClassName ctx cn@(Qualified (Just mn) _) tys = concatMap (findDicts ctx cn) (nub (Nothing : Just mn : map Just (mapMaybe ctorModules tys)))
143 forClassName _ _ _ = internalError "forClassName: expected qualified class name"
158 forClassName _ _ _ = internalError "forClassName: expected qualified class name"
144
159
@@ -146,6 +161,7 @@ entails SolverOptions{..} constraint context hints =
146 ctorModules (TypeConstructor (Qualified (Just mn) _)) = Just mn
161 ctorModules (TypeConstructor (Qualified (Just mn) _)) = Just mn
147 ctorModules (TypeConstructor (Qualified Nothing _)) = internalError "ctorModules: unqualified type name"
162 ctorModules (TypeConstructor (Qualified Nothing _)) = internalError "ctorModules: unqualified type name"
148 ctorModules (TypeApp ty _) = ctorModules ty
163 ctorModules (TypeApp ty _) = ctorModules ty
164+ ctorModules (KindedType ty _) = ctorModules ty
149 ctorModules _ = Nothing
165 ctorModules _ = Nothing
150
166
151 findDicts :: InstanceContext -> Qualified (ProperName 'ClassName) -> Maybe ModuleName -> [TypeClassDict]
167 findDicts :: InstanceContext -> Qualified (ProperName 'ClassName) -> Maybe ModuleName -> [TypeClassDict]
@@ -266,6 +282,7 @@ entails SolverOptions{..} constraint context hints =
266
282
267 canBeGeneralized :: Type -> Bool
283 canBeGeneralized :: Type -> Bool
268 canBeGeneralized TUnknown{} = True
284 canBeGeneralized TUnknown{} = True
285+ canBeGeneralized (KindedType t _) = canBeGeneralized t
269 canBeGeneralized _ = False
286 canBeGeneralized _ = False
270
287
271 -- |
288 -- |
@@ -291,9 +308,13 @@ entails SolverOptions{..} constraint context hints =
291 -- Make a dictionary from subgoal dictionaries by applying the correct function
308 -- Make a dictionary from subgoal dictionaries by applying the correct function
292 mkDictionary :: Evidence -> Maybe [Expr] -> Expr
309 mkDictionary :: Evidence -> Maybe [Expr] -> Expr
293 mkDictionary (NamedInstance n) args = foldl App (Var n) (fold args)
310 mkDictionary (NamedInstance n) args = foldl App (Var n) (fold args)
294− mkDictionary (IsSymbolInstance sym) _ = TypeClassDictionaryConstructorApp C.IsSymbol (Literal (ObjectLiteral fields)) where
311+ mkDictionary (IsSymbolInstance sym) _ =
295− fields = [ ("reflectSymbol", Abs (Left (Ident C.__unused)) (Literal (StringLiteral sym)))
312+ let fields = [ ("reflectSymbol", Abs (Left (Ident C.__unused)) (Literal (StringLiteral sym))) ] in
296− ]
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 []))
297
318
298 -- Turn a DictionaryValue into a Expr
319 -- Turn a DictionaryValue into a Expr
299 subclassDictionaryValue :: Expr -> Qualified (ProperName a) -> Integer -> Expr
320 subclassDictionaryValue :: Expr -> Qualified (ProperName a) -> Integer -> Expr
@@ -346,6 +367,8 @@ matches deps TypeClassDictionaryInScope{..} tys = do
346 -- and return a substitution from type variables to types which makes the type heads unify.
367 -- and return a substitution from type variables to types which makes the type heads unify.
347 --
368 --
348 typeHeadsAreEqual :: Type -> Type -> (Bool, Matching [Type])
369 typeHeadsAreEqual :: Type -> Type -> (Bool, Matching [Type])
370+ typeHeadsAreEqual (KindedType t1 _) t2 = typeHeadsAreEqual t1 t2
371+ typeHeadsAreEqual t1 (KindedType t2 _) = typeHeadsAreEqual t1 t2
349 typeHeadsAreEqual (TUnknown u1) (TUnknown u2) | u1 == u2 = (True, M.empty)
372 typeHeadsAreEqual (TUnknown u1) (TUnknown u2) | u1 == u2 = (True, M.empty)
350 typeHeadsAreEqual (Skolem _ s1 _ _) (Skolem _ s2 _ _) | s1 == s2 = (True, M.empty)
373 typeHeadsAreEqual (Skolem _ s1 _ _) (Skolem _ s2 _ _) | s1 == s2 = (True, M.empty)
351 typeHeadsAreEqual t (TypeVar v) = (True, M.singleton v [t])
374 typeHeadsAreEqual t (TypeVar v) = (True, M.singleton v [t])
@@ -365,6 +388,8 @@ matches deps TypeClassDictionaryInScope{..} tys = do
365 sd2 = [ (name, t2) | (name, t2) <- s2, name `notElem` map fst s1 ]
388 sd2 = [ (name, t2) | (name, t2) <- s2, name `notElem` map fst s1 ]
366
389
367 go :: [(Text, Type)] -> Type -> [(Text, Type)] -> Type -> (Bool, Matching [Type])
390 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
368 go [] REmpty [] REmpty = (True, M.empty)
393 go [] REmpty [] REmpty = (True, M.empty)
369 go [] (TUnknown u1) [] (TUnknown u2) | u1 == u2 = (True, M.empty)
394 go [] (TUnknown u1) [] (TUnknown u2) | u1 == u2 = (True, M.empty)
370 go [] (TypeVar v1) [] (TypeVar v2) | v1 == v2 = (True, M.empty)
395 go [] (TypeVar v1) [] (TypeVar v2) | v1 == v2 = (True, M.empty)
@@ -386,6 +411,8 @@ matches deps TypeClassDictionaryInScope{..} tys = do
386 -- which was _not_ solved, i.e. one which was inferred by a functional
411 -- which was _not_ solved, i.e. one which was inferred by a functional
387 -- dependency.
412 -- dependency.
388 typesAreEqual :: Type -> Type -> Bool
413 typesAreEqual :: Type -> Type -> Bool
414+ typesAreEqual (KindedType t1 _) t2 = typesAreEqual t1 t2
415+ typesAreEqual t1 (KindedType t2 _) = typesAreEqual t1 t2
389 typesAreEqual (TUnknown u1) (TUnknown u2) | u1 == u2 = True
416 typesAreEqual (TUnknown u1) (TUnknown u2) | u1 == u2 = True
390 typesAreEqual (Skolem _ s1 _ _) (Skolem _ s2 _ _) = s1 == s2
417 typesAreEqual (Skolem _ s1 _ _) (Skolem _ s2 _ _) = s1 == s2
391 typesAreEqual (TypeVar v1) (TypeVar v2) = v1 == v2
418 typesAreEqual (TypeVar v1) (TypeVar v2) = v1 == v2
@@ -403,6 +430,8 @@ matches deps TypeClassDictionaryInScope{..} tys = do
403 in all (uncurry typesAreEqual) int && go sd1 r1' sd2 r2'
430 in all (uncurry typesAreEqual) int && go sd1 r1' sd2 r2'
404 where
431 where
405 go :: [(Text, Type)] -> Type -> [(Text, Type)] -> Type -> Bool
432 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
406 go [] (TUnknown u1) [] (TUnknown u2) | u1 == u2 = True
435 go [] (TUnknown u1) [] (TUnknown u2) | u1 == u2 = True
407 go [] (Skolem _ s1 _ _) [] (Skolem _ s2 _ _) = s1 == s2
436 go [] (Skolem _ s1 _ _) [] (Skolem _ s2 _ _) = s1 == s2
408 go [] REmpty [] REmpty = True
437 go [] REmpty [] REmpty = True
src/Language/PureScript/TypeChecker/Kinds.hs+13−15
@@ -85,9 +85,7 @@ unifyKinds k1 k2 = do
85 go (KUnknown u1) (KUnknown u2) | u1 == u2 = return ()
85 go (KUnknown u1) (KUnknown u2) | u1 == u2 = return ()
86 go (KUnknown u) k = solveKind u k
86 go (KUnknown u) k = solveKind u k
87 go k (KUnknown u) = solveKind u k
87 go k (KUnknown u) = solveKind u k
88− go Star Star = return ()
88+ go (NamedKind k1') (NamedKind k2') | k1' == k2' = return ()
89− go Bang Bang = return ()
90− go Symbol Symbol = return ()
91 go (Row k1') (Row k2') = go k1' k2'
89 go (Row k1') (Row k2') = go k1' k2'
92 go (FunKind k1' k2') (FunKind k3 k4) = do
90 go (FunKind k1' k2') (FunKind k3 k4) = do
93 go k1' k3
91 go k1' k3
@@ -182,15 +180,15 @@ solveTypes
182solveTypes isData ts kargs tyCon = do
180solveTypes isData ts kargs tyCon = do
183 ks <- traverse (fmap fst . infer) ts
181 ks <- traverse (fmap fst . infer) ts
184 when isData $ do
182 when isData $ do
185− unifyKinds tyCon (foldr FunKind Star kargs)
183+ unifyKinds tyCon (foldr FunKind kindType kargs)
186− forM_ ks $ \k -> unifyKinds k Star
184+ forM_ ks $ \k -> unifyKinds k kindType
187 unless isData $
185 unless isData $
188 unifyKinds tyCon (foldr FunKind (head ks) kargs)
186 unifyKinds tyCon (foldr FunKind (head ks) kargs)
189 return tyCon
187 return tyCon
190
188
191−-- | Default all unknown kinds to the Star kind of types
189+-- | Default all unknown kinds to the kindType kind of types
192starIfUnknown :: Kind -> Kind
190starIfUnknown :: Kind -> Kind
193−starIfUnknown (KUnknown _) = Star
191+starIfUnknown (KUnknown _) = kindType
194starIfUnknown (Row k) = Row (starIfUnknown k)
192starIfUnknown (Row k) = Row (starIfUnknown k)
195starIfUnknown (FunKind k1 k2) = FunKind (starIfUnknown k1) (starIfUnknown k2)
193starIfUnknown (FunKind k1 k2) = FunKind (starIfUnknown k1) (starIfUnknown k2)
196starIfUnknown k = k
194starIfUnknown k = k
@@ -211,8 +209,8 @@ infer' (ForAll ident ty _) = do
211 k1 <- freshKind
209 k1 <- freshKind
212 Just moduleName <- checkCurrentModule <$> get
210 Just moduleName <- checkCurrentModule <$> get
213 (k2, args) <- bindLocalTypeVariables moduleName [(ProperName ident, k1)] $ infer ty
211 (k2, args) <- bindLocalTypeVariables moduleName [(ProperName ident, k1)] $ infer ty
214− unifyKinds k2 Star
212+ unifyKinds k2 kindType
215− return (Star, (ident, k1) : args)
213+ return (kindType, (ident, k1) : args)
216infer' (KindedType ty k) = do
214infer' (KindedType ty k) = do
217 (k', args) <- infer ty
215 (k', args) <- infer ty
218 unifyKinds k k'
216 unifyKinds k k'
@@ -224,14 +222,14 @@ infer' other = (, []) <$> go other
224 k1 <- freshKind
222 k1 <- freshKind
225 Just moduleName <- checkCurrentModule <$> get
223 Just moduleName <- checkCurrentModule <$> get
226 k2 <- bindLocalTypeVariables moduleName [(ProperName ident, k1)] $ go ty
224 k2 <- bindLocalTypeVariables moduleName [(ProperName ident, k1)] $ go ty
227− unifyKinds k2 Star
225+ unifyKinds k2 kindType
228− return Star
226+ return kindType
229 go (KindedType ty k) = do
227 go (KindedType ty k) = do
230 k' <- go ty
228 k' <- go ty
231 unifyKinds k k'
229 unifyKinds k k'
232 return k'
230 return k'
233 go TypeWildcard{} = freshKind
231 go TypeWildcard{} = freshKind
234− go (TypeLevelString _) = return Symbol
232+ go (TypeLevelString _) = return kindSymbol
235 go (TypeVar v) = do
233 go (TypeVar v) = do
236 Just moduleName <- checkCurrentModule <$> get
234 Just moduleName <- checkCurrentModule <$> get
237 lookupTypeVariable moduleName (Qualified Nothing (ProperName v))
235 lookupTypeVariable moduleName (Qualified Nothing (ProperName v))
@@ -260,8 +258,8 @@ infer' other = (, []) <$> go other
260 go (ConstrainedType deps ty) = do
258 go (ConstrainedType deps ty) = do
261 forM_ deps $ \(Constraint className tys _) -> do
259 forM_ deps $ \(Constraint className tys _) -> do
262 k <- go $ foldl TypeApp (TypeConstructor (fmap coerceProperName className)) tys
260 k <- go $ foldl TypeApp (TypeConstructor (fmap coerceProperName className)) tys
263− unifyKinds k Star
261+ unifyKinds k kindType
264 k <- go ty
262 k <- go ty
265− unifyKinds k Star
263+ unifyKinds k kindType
266− return Star
264+ return kindType
267 go ty = internalError $ "Invalid argument to infer: " ++ show ty
265 go ty = internalError $ "Invalid argument to infer: " ++ show ty
src/Language/PureScript/TypeChecker/Synonyms.hs+35−20
@@ -4,44 +4,59 @@
4-- Functions for replacing fully applied type synonyms
4-- Functions for replacing fully applied type synonyms
5--
5--
6module Language.PureScript.TypeChecker.Synonyms
6module Language.PureScript.TypeChecker.Synonyms
7+ ( SynonymMap
7− ( replaceAllTypeSynonyms
8+ , replaceAllTypeSynonyms
9+ , replaceAllTypeSynonymsM
8 ) where
10 ) where
9
11
10−import Prelude.Compat
12+import Prelude.Compat
11
13
12−import Control.Monad.Error.Class (MonadError(..))
14+import Control.Monad.Error.Class (MonadError(..))
13−import Control.Monad.State
15+import Control.Monad.State
14−
15−import Data.Maybe (fromMaybe)
16+import Data.Maybe (fromMaybe)
16import qualified Data.Map as M
17import qualified Data.Map as M
17−
18+import Data.Text (Text)
18−import Language.PureScript.Environment
19+import Language.PureScript.Environment
19−import Language.PureScript.Errors
20+import Language.PureScript.Errors
21+import Language.PureScript.Kinds
22+import Language.PureScript.Names
20−import Language.PureScript.TypeChecker.Monad
23+import Language.PureScript.TypeChecker.Monad
21−import Language.PureScript.Types
24+import Language.PureScript.Types
22−
25+
23−-- |
26+-- | Type synonym information (arguments with kinds, aliased type), indexed by name
24−-- Replace fully applied type synonyms.
27+type SynonymMap = M.Map (Qualified (ProperName 'TypeName)) ([(Text, Maybe Kind)], Type)
25−--
28+
29+replaceAllTypeSynonyms'
30+ :: SynonymMap
31+ -> Type
26−replaceAllTypeSynonyms' :: Environment -> Type -> Either MultipleErrors Type
32+ -> Either MultipleErrors Type
27−replaceAllTypeSynonyms' env = everywhereOnTypesTopDownM try
33+replaceAllTypeSynonyms' syns = everywhereOnTypesTopDownM try
28 where
34 where
29 try :: Type -> Either MultipleErrors Type
35 try :: Type -> Either MultipleErrors Type
30 try t = fromMaybe t <$> go 0 [] t
36 try t = fromMaybe t <$> go 0 [] t
31
37
32 go :: Int -> [Type] -> Type -> Either MultipleErrors (Maybe Type)
38 go :: Int -> [Type] -> Type -> Either MultipleErrors (Maybe Type)
33 go c args (TypeConstructor ctor)
39 go c args (TypeConstructor ctor)
34− | Just (synArgs, body) <- M.lookup ctor (typeSynonyms env)
40+ | Just (synArgs, body) <- M.lookup ctor syns
35 , c == length synArgs
41 , c == length synArgs
36 = let repl = replaceAllTypeVars (zip (map fst synArgs) args) body
42 = let repl = replaceAllTypeVars (zip (map fst synArgs) args) body
37 in Just <$> try repl
43 in Just <$> try repl
38− | Just (synArgs, _) <- M.lookup ctor (typeSynonyms env)
44+ | Just (synArgs, _) <- M.lookup ctor syns
39 , length synArgs > c
45 , length synArgs > c
40 = throwError . errorMessage $ PartiallyAppliedSynonym ctor
46 = throwError . errorMessage $ PartiallyAppliedSynonym ctor
41 go c args (TypeApp f arg) = go (c + 1) (arg : args) f
47 go c args (TypeApp f arg) = go (c + 1) (arg : args) f
42 go _ _ _ = return Nothing
48 go _ _ _ = return Nothing
43
49
50+-- | Replace fully applied type synonyms
44replaceAllTypeSynonyms :: (e ~ MultipleErrors, MonadState CheckState m, MonadError e m) => Type -> m Type
51replaceAllTypeSynonyms :: (e ~ MultipleErrors, MonadState CheckState m, MonadError e m) => Type -> m Type
45replaceAllTypeSynonyms d = do
52replaceAllTypeSynonyms d = do
46 env <- getEnv
53 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 ::
240 Type ->
240 Type ->
241 Kind ->
241 Kind ->
242 m ()
242 m ()
243−checkTypeKind ty kind = guardWith (errorMessage (ExpectedType ty kind)) $ kind == Star
243+checkTypeKind ty kind = guardWith (errorMessage (ExpectedType ty kind)) $ kind == kindType
244
244
245-- | Remove any ForAlls and ConstrainedType constructors in a type by introducing new unknowns
245-- | Remove any ForAlls and ConstrainedType constructors in a type by introducing new unknowns
246-- or TypeClassDictionary values.
246-- or TypeClassDictionary values.
tests/Language/PureScript/Ide/Imports/IntegrationSpec.hs+1−1
@@ -28,7 +28,7 @@ outputFileShouldBe :: [Text] -> IO ()
28outputFileShouldBe expectation = do
28outputFileShouldBe expectation = do
29 outFp <- (</> "src" </> "ImportsSpecOut.tmp") <$> Integration.projectDirectory
29 outFp <- (</> "src" </> "ImportsSpecOut.tmp") <$> Integration.projectDirectory
30 outRes <- readUTF8FileT outFp
30 outRes <- readUTF8FileT outFp
31− shouldBe (T.lines outRes) expectation
31+ shouldBe (T.strip <$> T.lines outRes) expectation
32
32
33spec :: Spec
33spec :: Spec
34spec = beforeAll_ setup . describe "Adding imports" $ do
34spec = beforeAll_ setup . describe "Adding imports" $ do
tests/Language/PureScript/Ide/ImportsSpec.hs+2−2
@@ -74,7 +74,7 @@ spec = do
74 addDtorImport i t mn is =
74 addDtorImport i t mn is =
75 prettyPrintImportSection (addExplicitImport' (IdeDeclDataConstructor (IdeDataConstructor (P.ProperName i) t wildcard)) mn is)
75 prettyPrintImportSection (addExplicitImport' (IdeDeclDataConstructor (IdeDataConstructor (P.ProperName i) t wildcard)) mn is)
76 addTypeImport i mn is =
76 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)
78 it "adds an implicit unqualified import" $
78 it "adds an implicit unqualified import" $
79 shouldBe
79 shouldBe
80 (addImplicitImport' simpleFileImports (P.moduleNameFromString "Data.Map"))
80 (addImplicitImport' simpleFileImports (P.moduleNameFromString "Data.Map"))
@@ -143,7 +143,7 @@ spec = do
143 moduleName = (P.moduleNameFromString "Control.Monad")
143 moduleName = (P.moduleNameFromString "Control.Monad")
144 addImport imports import' = addExplicitImport' import' moduleName imports
144 addImport imports import' = addExplicitImport' import' moduleName imports
145 valueImport ident = (IdeDeclValue (IdeValue (P.Ident ident) wildcard))
145 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))
147 classImport name = (IdeDeclTypeClass (P.ProperName name))
147 classImport name = (IdeDeclTypeClass (P.ProperName name))
148 dtorImport name typeName = (IdeDeclDataConstructor (IdeDataConstructor (P.ProperName name) (P.ProperName typeName) wildcard))
148 dtorImport name typeName = (IdeDeclDataConstructor (IdeDataConstructor (P.ProperName name) (P.ProperName typeName) wildcard))
149 -- expect any list of provided identifiers, when imported, to come out as specified
149 -- 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
18
18
19valueA, typeA, classA, dtorA1, dtorA2 :: IdeDeclarationAnn
19valueA, typeA, classA, dtorA1, dtorA2 :: IdeDeclarationAnn
20valueA = d (IdeDeclValue (IdeValue (P.Ident "valueA") P.REmpty))
20valueA = 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))
22classA = d (IdeDeclTypeClass (P.ProperName "ClassA"))
22classA = d (IdeDeclTypeClass (P.ProperName "ClassA"))
23dtorA1 = d (IdeDeclDataConstructor (IdeDataConstructor (P.ProperName "DtorA1") (P.ProperName "TypeA") P.REmpty))
23dtorA1 = d (IdeDeclDataConstructor (IdeDataConstructor (P.ProperName "DtorA1") (P.ProperName "TypeA") P.REmpty))
24dtorA2 = d (IdeDeclDataConstructor (IdeDataConstructor (P.ProperName "DtorA2") (P.ProperName "TypeA") P.REmpty))
24dtorA2 = 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
6
6
7import qualified Language.PureScript as P
7import qualified Language.PureScript as P
8import Language.PureScript.Ide.SourceFile
8import Language.PureScript.Ide.SourceFile
9+import Language.PureScript.Ide.Types
9import Test.Hspec
10import Test.Hspec
10
11
11span0, span1, span2 :: P.SourceSpan
12span0, span1, span2 :: P.SourceSpan
@@ -13,7 +14,7 @@ span0 = P.SourceSpan "ModuleLevel" (P.SourcePos 0 0) (P.SourcePos 1 1)
13span1 = P.SourceSpan "" (P.SourcePos 1 1) (P.SourcePos 2 2)
14span1 = P.SourceSpan "" (P.SourcePos 1 1) (P.SourcePos 2 2)
14span2 = P.SourceSpan "" (P.SourcePos 2 2) (P.SourcePos 3 3)
15span2 = P.SourceSpan "" (P.SourcePos 2 2) (P.SourcePos 3 3)
15
16
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
17typeAnnotation1 = P.TypeDeclaration (P.Ident "value1") P.REmpty
18typeAnnotation1 = P.TypeDeclaration (P.Ident "value1") P.REmpty
18value1 = P.ValueDeclaration (P.Ident "value1") P.Public [] (Left [])
19value1 = P.ValueDeclaration (P.Ident "value1") P.Public [] (Left [])
19synonym1 = P.TypeSynonymDeclaration (P.ProperName "Synonym1") [] P.REmpty
20synonym1 = P.TypeSynonymDeclaration (P.ProperName "Synonym1") [] P.REmpty
@@ -23,28 +24,31 @@ class2 = P.TypeClassDeclaration (P.ProperName "Class2") [] [] []
23data1 = P.DataDeclaration P.Newtype (P.ProperName "Data1") [] []
24data1 = P.DataDeclaration P.Newtype (P.ProperName "Data1") [] []
24data2 = P.DataDeclaration P.Data (P.ProperName "Data2") [] [(P.ProperName "Cons1", [])]
25data2 = P.DataDeclaration P.Data (P.ProperName "Data2") [] [(P.ProperName "Cons1", [])]
25foreign1 = P.ExternDeclaration (P.Ident "foreign1") P.REmpty
26foreign1 = 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")
27member1 = P.TypeDeclaration (P.Ident "member1") P.REmpty
29member1 = P.TypeDeclaration (P.Ident "member1") P.REmpty
28
30
29spec :: Spec
31spec :: Spec
30spec = do
32spec = do
31 describe "Extracting Spans" $ do
33 describe "Extracting Spans" $ do
32 it "extracts a span for a value declaration" $
34 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)]
34 it "extracts a span for a type synonym declaration" $
36 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)]
36 it "extracts a span for a typeclass declaration" $
38 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)]
38 it "extracts spans for a typeclass declaration and its members" $
40 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)]
40 it "extracts a span for a data declaration" $
42 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)]
42 it "extracts spans for a data declaration and its constructors" $
44 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)]
44 it "extracts a span for a foreign declaration" $
46 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)]
46 it "extracts a span for a data foreign declaration" $
48 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)]
48 describe "Type annotations" $ do
52 describe "Type annotations" $ do
49 it "extracts a type annotation" $
53 it "extracts a type annotation" $
50 extractTypeAnnotations [typeAnnotation1] `shouldBe` [(P.Ident "value1", P.REmpty)]
54 extractTypeAnnotations [typeAnnotation1] `shouldBe` [(P.Ident "value1", P.REmpty)]
tests/Language/PureScript/Ide/StateSpec.hs+2−2
@@ -24,7 +24,7 @@ typeOperator =
24testModule :: Module
24testModule :: Module
25testModule = (mn "Test", [ d (IdeDeclValue (IdeValue (P.Ident "function") P.REmpty))
25testModule = (mn "Test", [ d (IdeDeclValue (IdeValue (P.Ident "function") P.REmpty))
26 , d (IdeDeclDataConstructor (IdeDataConstructor (P.ProperName "Cons") (P.ProperName "List") (P.REmpty)))
26 , 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))
28 , valueOperator Nothing
28 , valueOperator Nothing
29 , ctorOperator Nothing
29 , ctorOperator Nothing
30 , typeOperator Nothing
30 , typeOperator Nothing
@@ -48,4 +48,4 @@ spec = describe "resolving operators" $ do
48 it "resolves the type for a constructor operator" $
48 it "resolves the type for a constructor operator" $
49 resolveOperatorsForModule testState (snd testModule) `shouldSatisfy` elem (ctorOperator (Just P.REmpty))
49 resolveOperatorsForModule testState (snd testModule) `shouldSatisfy` elem (ctorOperator (Just P.REmpty))
50 it "resolves the kind for a type operator" $
50 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
13import qualified TestPsci
13import qualified TestPsci
14import qualified TestPscIde
14import qualified TestPscIde
15import qualified TestPscPublish
15import qualified TestPscPublish
16+import qualified TestPrimDocs
16import qualified TestUtils
17import qualified TestUtils
17
18
18import System.IO (hSetEncoding, stdout, stderr, utf8)
19import System.IO (hSetEncoding, stdout, stderr, utf8)
@@ -28,6 +29,7 @@ main = do
28 TestCompiler.main
29 TestCompiler.main
29 heading "Documentation test suite"
30 heading "Documentation test suite"
30 TestDocs.main
31 TestDocs.main
32+ TestPrimDocs.main
31 heading "psc-publish test suite"
33 heading "psc-publish test suite"
32 TestPscPublish.main
34 TestPscPublish.main
33 heading "psci test suite"
35 heading "psci test suite"
tests/TestCompiler.hs+22−17
@@ -61,13 +61,13 @@ main = hspec spec
61spec :: Spec
61spec :: Spec
62spec = do
62spec = do
63
63
64− (supportExterns, passingTestCases, warningTestCases, failingTestCases) <- runIO $ do
64+ (supportExterns, supportForeigns, passingTestCases, warningTestCases, failingTestCases) <- runIO $ do
65 cwd <- getCurrentDirectory
65 cwd <- getCurrentDirectory
66 let passing = cwd </> "examples" </> "passing"
66 let passing = cwd </> "examples" </> "passing"
67 let warning = cwd </> "examples" </> "warning"
67 let warning = cwd </> "examples" </> "warning"
68 let failing = cwd </> "examples" </> "failing"
68 let failing = cwd </> "examples" </> "failing"
69 let supportDir = cwd </> "tests" </> "support" </> "bower_components"
69 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
71 passingFiles <- getTestFiles passing <$> testGlob passing
71 passingFiles <- getTestFiles passing <$> testGlob passing
72 warningFiles <- getTestFiles warning <$> testGlob warning
72 warningFiles <- getTestFiles warning <$> testGlob warning
73 failingFiles <- getTestFiles failing <$> testGlob failing
73 failingFiles <- getTestFiles failing <$> testGlob failing
@@ -77,10 +77,10 @@ spec = do
77 modules <- ExceptT . return $ P.parseModulesFromFiles id supportPursFiles
77 modules <- ExceptT . return $ P.parseModulesFromFiles id supportPursFiles
78 foreigns <- inferForeignModules modules
78 foreigns <- inferForeignModules modules
79 externs <- ExceptT . fmap fst . runTest $ P.make (makeActions foreigns) (map snd modules)
79 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)
81 case supportExterns of
81 case supportExterns of
82 Left errs -> fail (P.prettyPrintMultipleErrors P.defaultPPEOptions errs)
82 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)
84
84
85 outputFile <- runIO $ do
85 outputFile <- runIO $ do
86 tmp <- getTemporaryDirectory
86 tmp <- getTemporaryDirectory
@@ -90,21 +90,21 @@ spec = do
90 context "Passing examples" $
90 context "Passing examples" $
91 forM_ passingTestCases $ \testPurs ->
91 forM_ passingTestCases $ \testPurs ->
92 it ("'" <> takeFileName (getTestMain testPurs) <> "' should compile and run without error") $
92 it ("'" <> takeFileName (getTestMain testPurs) <> "' should compile and run without error") $
93− assertCompiles supportExterns testPurs outputFile
93+ assertCompiles supportExterns supportForeigns testPurs outputFile
94
94
95 context "Warning examples" $
95 context "Warning examples" $
96 forM_ warningTestCases $ \testPurs -> do
96 forM_ warningTestCases $ \testPurs -> do
97 let mainPath = getTestMain testPurs
97 let mainPath = getTestMain testPurs
98 expectedWarnings <- runIO $ getShouldWarnWith mainPath
98 expectedWarnings <- runIO $ getShouldWarnWith mainPath
99 it ("'" <> takeFileName mainPath <> "' should compile with warning(s) '" <> intercalate "', '" expectedWarnings <> "'") $
99 it ("'" <> takeFileName mainPath <> "' should compile with warning(s) '" <> intercalate "', '" expectedWarnings <> "'") $
100− assertCompilesWithWarnings supportExterns testPurs expectedWarnings
100+ assertCompilesWithWarnings supportExterns supportForeigns testPurs expectedWarnings
101
101
102 context "Failing examples" $
102 context "Failing examples" $
103 forM_ failingTestCases $ \testPurs -> do
103 forM_ failingTestCases $ \testPurs -> do
104 let mainPath = getTestMain testPurs
104 let mainPath = getTestMain testPurs
105 expectedFailures <- runIO $ getShouldFailWith mainPath
105 expectedFailures <- runIO $ getShouldFailWith mainPath
106 it ("'" <> takeFileName mainPath <> "' should fail with '" <> intercalate "', '" expectedFailures <> "'") $
106 it ("'" <> takeFileName mainPath <> "' should fail with '" <> intercalate "', '" expectedFailures <> "'") $
107− assertDoesNotCompile supportExterns testPurs expectedFailures
107+ assertDoesNotCompile supportExterns supportForeigns testPurs expectedFailures
108
108
109 where
109 where
110
110
@@ -197,27 +197,29 @@ runTest = P.runMake P.defaultOptions
197
197
198compile
198compile
199 :: [(P.Module, P.ExternsFile)]
199 :: [(P.Module, P.ExternsFile)]
200+ -> M.Map P.ModuleName FilePath
200 -> [FilePath]
201 -> [FilePath]
201 -> ([P.Module] -> IO ())
202 -> ([P.Module] -> IO ())
202 -> IO (Either P.MultipleErrors [P.ExternsFile], P.MultipleErrors)
203 -> 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
204 fs <- liftIO $ readInput inputFiles
205 fs <- liftIO $ readInput inputFiles
205 ms <- P.parseModulesFromFiles id fs
206 ms <- P.parseModulesFromFiles id fs
206 foreigns <- inferForeignModules ms
207 foreigns <- inferForeignModules ms
207 liftIO (check (map snd ms))
208 liftIO (check (map snd ms))
208− let actions = makeActions foreigns
209+ let actions = makeActions (foreigns `M.union` supportForeigns)
209 case ms of
210 case ms of
210 [singleModule] -> pure <$> P.rebuildModule actions (map snd supportExterns) (snd singleModule)
211 [singleModule] -> pure <$> P.rebuildModule actions (map snd supportExterns) (snd singleModule)
211 _ -> P.make actions (map fst supportExterns ++ map snd ms)
212 _ -> P.make actions (map fst supportExterns ++ map snd ms)
212
213
213assert
214assert
214 :: [(P.Module, P.ExternsFile)]
215 :: [(P.Module, P.ExternsFile)]
216+ -> M.Map P.ModuleName FilePath
215 -> [FilePath]
217 -> [FilePath]
216 -> ([P.Module] -> IO ())
218 -> ([P.Module] -> IO ())
217 -> (Either P.MultipleErrors P.MultipleErrors -> IO (Maybe String))
219 -> (Either P.MultipleErrors P.MultipleErrors -> IO (Maybe String))
218 -> Expectation
220 -> Expectation
219−assert supportExterns inputFiles check f = do
221+assert supportExterns supportForeigns inputFiles check f = do
220− (e, w) <- compile supportExterns inputFiles check
222+ (e, w) <- compile supportExterns supportForeigns inputFiles check
221 maybeErr <- f (const w <$> e)
223 maybeErr <- f (const w <$> e)
222 maybe (return ()) expectationFailure maybeErr
224 maybe (return ()) expectationFailure maybeErr
223
225
@@ -235,11 +237,12 @@ checkShouldFailWith expected errs =
235
237
236assertCompiles
238assertCompiles
237 :: [(P.Module, P.ExternsFile)]
239 :: [(P.Module, P.ExternsFile)]
240+ -> M.Map P.ModuleName FilePath
238 -> [FilePath]
241 -> [FilePath]
239 -> Handle
242 -> Handle
240 -> Expectation
243 -> Expectation
241−assertCompiles supportExterns inputFiles outputFile =
244+assertCompiles supportExterns supportForeigns inputFiles outputFile =
242− assert supportExterns inputFiles checkMain $ \e ->
245+ assert supportExterns supportForeigns inputFiles checkMain $ \e ->
243 case e of
246 case e of
244 Left errs -> return . Just . P.prettyPrintMultipleErrors P.defaultPPEOptions $ errs
247 Left errs -> return . Just . P.prettyPrintMultipleErrors P.defaultPPEOptions $ errs
245 Right _ -> do
248 Right _ -> do
@@ -260,11 +263,12 @@ assertCompiles supportExterns inputFiles outputFile =
260
263
261assertCompilesWithWarnings
264assertCompilesWithWarnings
262 :: [(P.Module, P.ExternsFile)]
265 :: [(P.Module, P.ExternsFile)]
266+ -> M.Map P.ModuleName FilePath
263 -> [FilePath]
267 -> [FilePath]
264 -> [String]
268 -> [String]
265 -> Expectation
269 -> Expectation
266−assertCompilesWithWarnings supportExterns inputFiles shouldWarnWith =
270+assertCompilesWithWarnings supportExterns supportForeigns inputFiles shouldWarnWith =
267− assert supportExterns inputFiles checkMain $ \e ->
271+ assert supportExterns supportForeigns inputFiles checkMain $ \e ->
268 case e of
272 case e of
269 Left errs ->
273 Left errs ->
270 return . Just . P.prettyPrintMultipleErrors P.defaultPPEOptions $ errs
274 return . Just . P.prettyPrintMultipleErrors P.defaultPPEOptions $ errs
@@ -279,11 +283,12 @@ assertCompilesWithWarnings supportExterns inputFiles shouldWarnWith =
279
283
280assertDoesNotCompile
284assertDoesNotCompile
281 :: [(P.Module, P.ExternsFile)]
285 :: [(P.Module, P.ExternsFile)]
286+ -> M.Map P.ModuleName FilePath
282 -> [FilePath]
287 -> [FilePath]
283 -> [String]
288 -> [String]
284 -> Expectation
289 -> Expectation
285−assertDoesNotCompile supportExterns inputFiles shouldFailWith =
290+assertDoesNotCompile supportExterns supportForeigns inputFiles shouldFailWith =
286− assert supportExterns inputFiles noPreCheck $ \e ->
291+ assert supportExterns supportForeigns inputFiles noPreCheck $ \e ->
287 case e of
292 case e of
288 Left errs ->
293 Left errs ->
289 return $ if null shouldFailWith
294 return $ if null shouldFailWith
tests/TestDocs.hs+108−72
@@ -1,18 +1,21 @@
1{-# LANGUAGE RecordWildCards #-}
1{-# LANGUAGE RecordWildCards #-}
2{-# LANGUAGE ViewPatterns #-}
2{-# LANGUAGE ViewPatterns #-}
3{-# LANGUAGE DataKinds #-}
3{-# LANGUAGE DataKinds #-}
4+{-# LANGUAGE OverloadedStrings #-}
4
5
5module TestDocs where
6module TestDocs where
6
7
7import Prelude ()
8import Prelude ()
8import Prelude.Compat
9import Prelude.Compat
9
10
10−import Data.Version (Version(..))
11+import Control.Arrow (first)
11
12
13+import Data.Version (Version(..))
12import Data.Monoid
14import Data.Monoid
13import Data.Maybe (fromMaybe)
15import Data.Maybe (fromMaybe)
14import Data.List ((\\))
16import Data.List ((\\))
15import Data.Foldable
17import Data.Foldable
18+import Data.Text (Text)
16import qualified Data.Text as T
19import qualified Data.Text as T
17import System.Exit
20import System.Exit
18
21
@@ -22,6 +25,8 @@ import Language.PureScript.Docs.AsMarkdown (codeToString)
22import qualified Language.PureScript.Publish as Publish
25import qualified Language.PureScript.Publish as Publish
23import qualified Language.PureScript.Publish.ErrorsWarnings as Publish
26import qualified Language.PureScript.Publish.ErrorsWarnings as Publish
24
27
28+import Web.Bower.PackageMeta (parsePackageName)
29+
25import TestUtils
30import TestUtils
26
31
27publishOpts :: Publish.PublishOptions
32publishOpts :: Publish.PublishOptions
@@ -37,7 +42,7 @@ main = pushd "examples/docs" $ do
37 case res of
42 case res of
38 Left e -> Publish.printErrorToStdout e >> exitFailure
43 Left e -> Publish.printErrorToStdout e >> exitFailure
39 Right Docs.Package{..} ->
44 Right Docs.Package{..} ->
40− forM_ testCases $ \(P.moduleNameFromString . T.pack -> mn, pragmas) ->
45+ forM_ testCases $ \(P.moduleNameFromString -> mn, pragmas) ->
41 let mdl = takeJust ("module not found in docs: " ++ T.unpack (P.runModuleName mn))
46 let mdl = takeJust ("module not found in docs: " ++ T.unpack (P.runModuleName mn))
42 (find ((==) mn . Docs.modName) pkgModules)
47 (find ((==) mn . Docs.modName) pkgModules)
43 in forM_ pragmas (`runAssertionIO` mdl)
48 in forM_ pragmas (`runAssertionIO` mdl)
@@ -49,25 +54,31 @@ takeJust msg = fromMaybe (error msg)
49data Assertion
54data Assertion
50 -- | Assert that a particular declaration is documented with the given
55 -- | Assert that a particular declaration is documented with the given
51 -- children
56 -- children
52− = ShouldBeDocumented P.ModuleName String [String]
57+ = ShouldBeDocumented P.ModuleName Text [Text]
53 -- | Assert that a particular declaration is not documented
58 -- | Assert that a particular declaration is not documented
54− | ShouldNotBeDocumented P.ModuleName String
59+ | ShouldNotBeDocumented P.ModuleName Text
55 -- | Assert that a particular declaration exists, but without a particular
60 -- | Assert that a particular declaration exists, but without a particular
56 -- child.
61 -- child.
57− | ChildShouldNotBeDocumented P.ModuleName String String
62+ | ChildShouldNotBeDocumented P.ModuleName Text Text
58 -- | Assert that a particular declaration has a particular type class
63 -- | Assert that a particular declaration has a particular type class
59 -- constraint.
64 -- constraint.
60− | ShouldBeConstrained P.ModuleName String String
65+ | ShouldBeConstrained P.ModuleName Text Text
61 -- | Assert that a particular typeclass declaration has a functional
66 -- | Assert that a particular typeclass declaration has a functional
62 -- dependency list.
67 -- dependency list.
63− | ShouldHaveFunDeps P.ModuleName String [([String],[String])]
68+ | ShouldHaveFunDeps P.ModuleName Text [([Text],[Text])]
64 -- | Assert that a particular value declaration exists, and its type
69 -- | Assert that a particular value declaration exists, and its type
65 -- satisfies the given predicate.
70 -- satisfies the given predicate.
66− | ValueShouldHaveTypeSignature P.ModuleName String (ShowFn (P.Type -> Bool))
71+ | ValueShouldHaveTypeSignature P.ModuleName Text (ShowFn (P.Type -> Bool))
67 -- | Assert that a particular type alias exists, and its corresponding
72 -- | Assert that a particular type alias exists, and its corresponding
68 -- type, when rendered, matches a given string exactly
73 -- type, when rendered, matches a given string exactly
69 -- fields: module, type synonym name, expected type
74 -- 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)
71 deriving (Show)
82 deriving (Show)
72
83
73newtype ShowFn a = ShowFn a
84newtype ShowFn a = ShowFn a
@@ -77,28 +88,34 @@ instance Show (ShowFn a) where
77
88
78data AssertionFailure
89data AssertionFailure
79 -- | A declaration was not documented, but should have been
90 -- | A declaration was not documented, but should have been
80− = NotDocumented P.ModuleName String
91+ = NotDocumented P.ModuleName Text
81 -- | A child declaration was not documented, but should have been
92 -- | A child declaration was not documented, but should have been
82− | ChildrenNotDocumented P.ModuleName String [String]
93+ | ChildrenNotDocumented P.ModuleName Text [Text]
83 -- | A declaration was documented, but should not have been
94 -- | A declaration was documented, but should not have been
84− | Documented P.ModuleName String
95+ | Documented P.ModuleName Text
85 -- | A child declaration was documented, but should not have been
96 -- | A child declaration was documented, but should not have been
86− | ChildDocumented P.ModuleName String String
97+ | ChildDocumented P.ModuleName Text Text
87 -- | A constraint was missing.
98 -- | A constraint was missing.
88− | ConstraintMissing P.ModuleName String String
99+ | ConstraintMissing P.ModuleName Text Text
89 -- | A functional dependency was missing.
100 -- | A functional dependency was missing.
90− | FunDepMissing P.ModuleName String [([String], [String])]
101+ | FunDepMissing P.ModuleName Text [([Text], [Text])]
91 -- | A declaration had the wrong "type" (ie, value, type, type class)
102 -- | A declaration had the wrong "type" (ie, value, type, type class)
92 -- Fields: declaration title, expected "type", actual "type".
103 -- Fields: declaration title, expected "type", actual "type".
93− | WrongDeclarationType P.ModuleName String String String
104+ | WrongDeclarationType P.ModuleName Text Text Text
94 -- | A value declaration had the wrong type (in the sense of "type
105 -- | A value declaration had the wrong type (in the sense of "type
95 -- checking"), eg, because the inferred type was used when the explicit type
106 -- checking"), eg, because the inferred type was used when the explicit type
96 -- should have been.
107 -- should have been.
97 -- Fields: module name, declaration name, actual type.
108 -- Fields: module name, declaration name, actual type.
98− | ValueDeclarationWrongType P.ModuleName String P.Type
109+ | ValueDeclarationWrongType P.ModuleName Text P.Type
99 -- | A Type synonym has been rendered in an unexpected format
110 -- | A Type synonym has been rendered in an unexpected format
100 -- Fields: module name, declaration name, expected rendering, actual rendering
111 -- 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]
102 deriving (Show)
119 deriving (Show)
103
120
104data AssertionResult
121data AssertionResult
@@ -135,75 +152,84 @@ runAssertion assertion Docs.Module{..} =
135 Fail (NotDocumented mn decl)
152 Fail (NotDocumented mn decl)
136
153
137 ShouldBeConstrained mn decl tyClass ->
154 ShouldBeConstrained mn decl tyClass ->
138− case find ((==) decl . Docs.declTitle) (declarationsFor mn) of
139− Nothing ->
140− Fail (NotDocumented mn decl)
141− Just Docs.Declaration{..} ->
155+ findDecl mn decl $ \Docs.Declaration{..} ->
142− case declInfo of
156+ case declInfo of
143− Docs.ValueDeclaration ty ->
157+ Docs.ValueDeclaration ty ->
144− if checkConstrained ty tyClass
158+ if checkConstrained ty tyClass
145− then Pass
159+ then Pass
146− else Fail (ConstraintMissing mn decl tyClass)
160+ else Fail (ConstraintMissing mn decl tyClass)
147− _ ->
161+ _ ->
148− Fail (WrongDeclarationType mn decl "value"
162+ Fail (WrongDeclarationType mn decl "value"
149− (Docs.declInfoToString declInfo))
163+ (Docs.declInfoToString declInfo))
150
164
151 ShouldHaveFunDeps mn decl fds ->
165 ShouldHaveFunDeps mn decl fds ->
152− case find ((==) decl . Docs.declTitle) (declarationsFor mn) of
153− Nothing ->
154− Fail (NotDocumented mn decl)
155− Just Docs.Declaration{..} ->
166+ findDecl mn decl $ \Docs.Declaration{..} ->
156− case declInfo of
167+ case declInfo of
157− Docs.TypeClassDeclaration _ _ fundeps ->
168+ Docs.TypeClassDeclaration _ _ fundeps ->
158− if fundeps == fds
169+ if fundeps == fds
159− then Pass
170+ then Pass
160− else Fail (FunDepMissing mn decl fds)
171+ else Fail (FunDepMissing mn decl fds)
161− _ ->
172+ _ ->
162− Fail (WrongDeclarationType mn decl "value"
173+ Fail (WrongDeclarationType mn decl "value"
163− (Docs.declInfoToString declInfo))
174+ (Docs.declInfoToString declInfo))
164
175
165 ValueShouldHaveTypeSignature mn decl (ShowFn tyPredicate) ->
176 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{..} ->
177+ findDecl mn decl $ \Docs.Declaration{..} ->
170− case declInfo of
178+ case declInfo of
171− Docs.ValueDeclaration ty ->
179+ Docs.ValueDeclaration ty ->
172− if tyPredicate ty
180+ if tyPredicate ty
173− then Pass
181+ then Pass
174− else Fail
182+ else Fail
175− (ValueDeclarationWrongType mn decl ty)
183+ (ValueDeclarationWrongType mn decl ty)
176− _ ->
184+ _ ->
177− Fail (WrongDeclarationType mn decl "value"
185+ Fail (WrongDeclarationType mn decl "value"
178− (Docs.declInfoToString declInfo))
186+ (Docs.declInfoToString declInfo))
179
187
180 TypeSynonymShouldRenderAs mn decl expected ->
188 TypeSynonymShouldRenderAs mn decl expected ->
181− case find ((==) decl . Docs.declTitle) (declarationsFor mn) of
182− Nothing ->
183− Fail (NotDocumented mn decl)
184− Just Docs.Declaration{..} ->
189+ findDecl mn decl $ \Docs.Declaration{..} ->
185− case declInfo of
190+ case declInfo of
186− Docs.TypeSynonymDeclaration [] ty ->
191+ Docs.TypeSynonymDeclaration [] ty ->
187− let actual = codeToString (Docs.renderType ty) in
192+ let actual = codeToString (Docs.renderType ty) in
188− if actual == expected
193+ if actual == expected
189− then Pass
194+ then Pass
190− else Fail (TypeSynonymMismatch mn decl expected actual)
195+ else Fail (TypeSynonymMismatch mn decl expected actual)
191− _ ->
196+ _ ->
192− Fail (WrongDeclarationType mn decl "synonym"
197+ Fail (WrongDeclarationType mn decl "synonym"
193− (Docs.declInfoToString declInfo))
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)
194
213
195 where
214 where
196 declarationsFor mn =
215 declarationsFor mn =
197 if mn == modName
216 if mn == modName
198 then modDeclarations
217 then modDeclarations
199− else fromMaybe [] (lookup mn modReExports)
218+ else fromMaybe [] (lookup mn (map (first Docs.ignorePackage) modReExports))
200
219
201 findChildren title =
220 findChildren title =
202 fmap childrenTitles . find ((==) title . Docs.declTitle)
221 fmap childrenTitles . find ((==) title . Docs.declTitle)
203
222
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+
204 childrenTitles = map Docs.cdeclTitle . Docs.declChildren
230 childrenTitles = map Docs.cdeclTitle . Docs.declChildren
205
231
206−checkConstrained :: P.Type -> String -> Bool
232+checkConstrained :: P.Type -> Text -> Bool
207checkConstrained ty tyClass =
233checkConstrained ty tyClass =
208 -- Note that we don't recurse on ConstrainedType if none of the constraints
234 -- Note that we don't recurse on ConstrainedType if none of the constraints
209 -- match; this is by design, as constraints should be moved to the front
235 -- match; this is by design, as constraints should be moved to the front
@@ -217,7 +243,7 @@ checkConstrained ty tyClass =
217 False
243 False
218 where
244 where
219 matches className =
245 matches className =
220− (==) className . T.unpack . P.runProperName . P.disqualify . P.constraintClass
246+ (==) className . P.runProperName . P.disqualify . P.constraintClass
221
247
222runAssertionIO :: Assertion -> Docs.Module -> IO ()
248runAssertionIO :: Assertion -> Docs.Module -> IO ()
223runAssertionIO assertion mdl = do
249runAssertionIO assertion mdl = do
@@ -228,7 +254,7 @@ runAssertionIO assertion mdl = do
228 putStrLn ("Failed: " <> show reason)
254 putStrLn ("Failed: " <> show reason)
229 exitFailure
255 exitFailure
230
256
231−testCases :: [(String, [Assertion])]
257+testCases :: [(Text, [Assertion])]
232testCases =
258testCases =
233 [ ("Example",
259 [ ("Example",
234 [ -- From dependencies
260 [ -- From dependencies
@@ -238,7 +264,12 @@ testCases =
238 -- From local files
264 -- From local files
239 , ShouldBeDocumented (n "Example2") "one" []
265 , ShouldBeDocumented (n "Example2") "one" []
240 , ShouldNotBeDocumented (n "Example2") "two"
266 , ShouldNotBeDocumented (n "Example2") "two"
267+
268+ -- Re-exports
269+ , ShouldHaveReExport (Docs.FromDep (pkg "purescript-prelude") (n "Prelude"))
270+ , ShouldHaveReExport (Docs.Local (n "Example2"))
241 ])
271 ])
272+
242 , ("Example2",
273 , ("Example2",
243 [ ShouldBeDocumented (n "Example2") "one" []
274 [ ShouldBeDocumented (n "Example2") "one" []
244 , ShouldBeDocumented (n "Example2") "two" []
275 , ShouldBeDocumented (n "Example2") "two" []
@@ -319,10 +350,15 @@ testCases =
319 , ValueShouldHaveTypeSignature (n "TypeOpAliases") "test4" (renderedType "forall a b c d. ((a ~> b) ~> c) ~> d")
350 , ValueShouldHaveTypeSignature (n "TypeOpAliases") "test4" (renderedType "forall a b c d. ((a ~> b) ~> c) ~> d")
320 , ValueShouldHaveTypeSignature (n "TypeOpAliases") "third" (renderedType "forall a b c. a × b × c -> c")
351 , ValueShouldHaveTypeSignature (n "TypeOpAliases") "third" (renderedType "forall a b c. a × b × c -> c")
321 ])
352 ])
353+
354+ , ("DocComments",
355+ [ ShouldHaveDocComment (n "DocComments") "example" " example == 0"
356+ ])
322 ]
357 ]
323
358
324 where
359 where
325 n = P.moduleNameFromString . T.pack
360 n = P.moduleNameFromString . T.pack
361+ pkg str = let Right p = parsePackageName str in p
326
362
327 hasTypeVar varName =
363 hasTypeVar varName =
328 getAny . P.everythingOnTypes (<>) (Any . isVar varName)
364 getAny . P.everythingOnTypes (<>) (Any . isVar varName)
tests/TestPrimDocs.hsnew file+30
@@ -0,0 +1,30 @@
1+module TestPrimDocs where
2+
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 @@
1{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
1{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
2−{-# OPTIONS_GHC -fno-warn-unused-imports #-}
3{-# LANGUAGE ScopedTypeVariables #-}
2{-# LANGUAGE ScopedTypeVariables #-}
3+{-# LANGUAGE OverloadedStrings #-}
4
4
5module TestPscPublish where
5module TestPscPublish where
6
6
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
7+import System.Exit (exitFailure)
14−import qualified Data.ByteString.Lazy as BL
15import Data.ByteString.Lazy (ByteString)
8import Data.ByteString.Lazy (ByteString)
16import qualified Data.Aeson as A
9import qualified Data.Aeson as A
17−import Data.Aeson.BetterErrors
18import Data.Version
10import Data.Version
19
11
20import Language.PureScript.Docs
12import Language.PureScript.Docs
tests/TestUtils.hs+25−2
@@ -57,6 +57,8 @@ supportModules =
57 , "Control.Alternative"
57 , "Control.Alternative"
58 , "Control.Applicative"
58 , "Control.Applicative"
59 , "Control.Apply"
59 , "Control.Apply"
60+ , "Control.Biapplicative"
61+ , "Control.Biapply"
60 , "Control.Bind"
62 , "Control.Bind"
61 , "Control.Category"
63 , "Control.Category"
62 , "Control.Comonad"
64 , "Control.Comonad"
@@ -72,6 +74,15 @@ supportModules =
72 , "Control.MonadZero"
74 , "Control.MonadZero"
73 , "Control.Plus"
75 , "Control.Plus"
74 , "Control.Semigroupoid"
76 , "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"
75 , "Data.Boolean"
86 , "Data.Boolean"
76 , "Data.BooleanAlgebra"
87 , "Data.BooleanAlgebra"
77 , "Data.Bounded"
88 , "Data.Bounded"
@@ -79,18 +90,24 @@ supportModules =
79 , "Data.Eq"
90 , "Data.Eq"
80 , "Data.EuclideanRing"
91 , "Data.EuclideanRing"
81 , "Data.Field"
92 , "Data.Field"
93+ , "Data.Foldable"
82 , "Data.Function"
94 , "Data.Function"
83 , "Data.Function.Uncurried"
95 , "Data.Function.Uncurried"
84 , "Data.Functor"
96 , "Data.Functor"
85 , "Data.Functor.Invariant"
97 , "Data.Functor.Invariant"
86 , "Data.Generic.Rep"
98 , "Data.Generic.Rep"
87− , "Data.Generic.Rep.Monoid"
88 , "Data.Generic.Rep.Eq"
99 , "Data.Generic.Rep.Eq"
100+ , "Data.Generic.Rep.Monoid"
89 , "Data.Generic.Rep.Ord"
101 , "Data.Generic.Rep.Ord"
90 , "Data.Generic.Rep.Semigroup"
102 , "Data.Generic.Rep.Semigroup"
103+ , "Data.Generic.Rep.Show"
91 , "Data.HeytingAlgebra"
104 , "Data.HeytingAlgebra"
105+ , "Data.Maybe"
106+ , "Data.Maybe.First"
107+ , "Data.Maybe.Last"
92 , "Data.Monoid"
108 , "Data.Monoid"
93 , "Data.Monoid.Additive"
109 , "Data.Monoid.Additive"
110+ , "Data.Monoid.Alternate"
94 , "Data.Monoid.Conj"
111 , "Data.Monoid.Conj"
95 , "Data.Monoid.Disj"
112 , "Data.Monoid.Disj"
96 , "Data.Monoid.Dual"
113 , "Data.Monoid.Dual"
@@ -104,8 +121,9 @@ supportModules =
104 , "Data.Ring"
121 , "Data.Ring"
105 , "Data.Semigroup"
122 , "Data.Semigroup"
106 , "Data.Semiring"
123 , "Data.Semiring"
107− , "Data.Symbol"
108 , "Data.Show"
124 , "Data.Show"
125+ , "Data.Symbol"
126+ , "Data.Traversable"
109 , "Data.Unit"
127 , "Data.Unit"
110 , "Data.Void"
128 , "Data.Void"
111 , "Partial"
129 , "Partial"
@@ -113,6 +131,11 @@ supportModules =
113 , "Prelude"
131 , "Prelude"
114 , "Test.Assert"
132 , "Test.Assert"
115 , "Test.Main"
133 , "Test.Main"
134+ , "Type.Data.Ordering"
135+ , "Type.Data.Symbol"
136+ , "Type.Equality"
137+ , "Type.Prelude"
138+ , "Type.Proxy"
116 , "Unsafe.Coerce"
139 , "Unsafe.Coerce"
117 ]
140 ]
118
141
tests/support/bower.json+11−10
@@ -1,16 +1,17 @@
1{
1{
2 "name": "purescript-test-suite-support",
2 "name": "purescript-test-suite-support",
3 "dependencies": {
3 "dependencies": {
4− "purescript-assert": "1.0.0-rc.1",
4+ "purescript-assert": "2.0.0",
5− "purescript-console": "1.0.0-rc.1",
5+ "purescript-console": "2.0.0",
6− "purescript-eff": "1.0.0-rc.1",
6+ "purescript-eff": "2.0.0",
7− "purescript-functions": "1.0.0-rc.1",
7+ "purescript-functions": "2.0.0",
8− "purescript-prelude": "1.1.0",
8+ "purescript-prelude": "2.1.0",
9− "purescript-st": "1.0.0-rc.1",
9+ "purescript-st": "2.0.0",
10 "purescript-partial": "1.1.2",
10 "purescript-partial": "1.1.2",
11− "purescript-newtype": "0.1.0",
11+ "purescript-newtype": "1.1.0",
12− "purescript-generics-rep": "2.0.0",
12+ "purescript-generics-rep": "4.0.0",
13− "purescript-symbols": "^1.0.1",
13+ "purescript-symbols": "^2.0.0",
14+ "purescript-typelevel-prelude": "https://github.com/purescript/purescript-typelevel-prelude.git#29a7123a0c29c85d4b923fcf4a7df8e45ebf9bac",
14− "purescript-unsafe-coerce": "^1.0.0"
15+ "purescript-unsafe-coerce": "^2.0.0"
15 }
16 }
16}
17}